Ест и не давится

[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]

Страница 1 из 1 1
Модератор форума: xXxSh@dowxXx, Anton93, Волк-1024

delfcode » Delphi » Вопросы по Delphi » Ест и не давится (Прога растёт в оперативке)

Ест и не давится

tatsu

Дата: Вторник, 13.11.2012, 12:25 | Сообщение # 1

Частый гость

Зарегистрирован: 17.05.2009

Группа: Пользователи

Сообщений: 27

Статус: Offline

Здрасте всем, вот этот код при старте весит в оперативке примерно 1450 кб. Во-первых: примерно каждые 2 секунды увеличивается на 4 Кб, а во вторых прога не хочет коректно закрываться. При долгой работе вообще машина виснет. Подскажите что нетак.

Code

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
TForm1 = class(TForm)
img1: TImage;
btn1: TButton;
tmr1: TTimer;
btn2: TButton;
img2: TImage;
lbl1: TLabel;
trckbr1: TTrackBar;
procedure tmr1Timer(Sender: TObject);
procedure btn2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
bmp:TBitmap;
a:Integer;

implementation

{$R *.dfm}

procedure pause(p:byte); // процедура пауза без зависания программы
var pa1:ttime;
begin
pa1:=encodetime(0,0,p,0)+time;
repeat
application.processmessages;
sleep(10);
until time>=pa1;
end;

procedure TForm1.tmr1Timer(Sender: TObject);
var
i, j, j1, i1:Integer;
wnd:hwnd;
begin

a:=0; //обнуляем счётчик, делаем скрин, чистим переменную скрина, грузим его в Timage(img1)

bmp := TBitmap.Create;
bmp.Width := Screen.Width;
bmp.Height := Screen.Height;
BitBlt(bmp.Canvas.Handle, 0,0, Screen.Width, Screen.Height,
GetDC(0), 0,0,SRCCOPY);

Img1.Width := Screen.Width;
img1.Height := Screen.Height;
Img1.Picture.Assign(bmp);
bmp.Free;

for i:=450 to 665 do //в img2 выдёргиваем фрагмент картинки из img1
for j:=8 to 18 do img2.Canvas.Pixels[i-450,j-8]:=img1.Canvas.Pixels[i,j];
for i1:=0 to 225 do
for j1:=0 to 10 do
if img2.Canvas.Pixels[i1,j1]=RGB(247,150,133) then a:=a+1; // считаем количество пикселей нужного цвета, сумируем их
lbl1.Caption:=IntToStr(a);
if GetAsyncKeyState(88)<>0 then // если была нажата клачиша Х и если есть окно с заголовки ччччч, и если счётчик <0
begin // то в это окно посылаем tab, если счётчик >0 то f1
wnd:= FindWindow(nil, PChar('ччччч'));
while wnd>0 do
begin

if a<1 then
begin
SendMessage(wnd,WM_KEYDOWN,VK_tab,0);
SendMessage(wnd,WM_KEYup,VK_tab,0);
pause(3);
end
else
begin
pause(4);

SendMessage(wnd,WM_KEYDOWN,VK_f1,0);

SendMessage(wnd,WM_KEYup,VK_f1,0);
end;
end;
end;

end;

procedure TForm1.btn2Click(Sender: TObject);

begin

//img1.Picture.SaveToFile('C:\1.bmp');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
img1.Hide;
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
tmr1.Interval:=0;
end;

end.