VPF::Глючит система при работе программы

Attack

Дата 16.9.2012, 17:29 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 45
Регистрация: 20.7.2006

Репутация: нет
Всего: нет

Извините за невнятное названия топика, но ничего лучше не придумал.

Итак к делу.
Набросал программку в 1 функцию(Delphi XE):

Код


type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    Function CompareScreenAndImage(Const ScreenX: Integer; Const ScreenY: Integer; Const img: TBitmap): Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Stop: Boolean = False;
  X: Integer = 0;

implementation

{$R *.dfm}

Function TForm1.CompareScreenAndImage(Const ScreenX: Integer; Const ScreenY: Integer; Const img: TBitmap): Boolean;
Var
  BMP: TBitmap;
  I, N: Integer;
  Flag: Boolean;
begin
  Result := False;

  BMP := TBitmap.Create;
  Try
    BMP.Canvas.Lock;
    Try
      BMP.Width := img.Width;
      BMP.Height := img.Height;
      BitBlt(BMP.Canvas.Handle, 0, 0, img.Width, img.Height, GetDC(0), ScreenX, ScreenY, SRCCOPY);

      Flag := False;

      img.Canvas.Lock;
      Try
        for I := 0 to img.Height - 1 do
        Begin
          if Flag = true then
            Break;

          for N := 0 to img.Width - 1 do
          Begin
            if BMP.Canvas.Pixels[N, I] <> img.Canvas.Pixels[N, I] then
            Begin
              Result := true;
              Flag := true;
              // Break; // Бряк закомментирован часто в исследовательской цели, сути он не меняет.
            End;
          End;
        End;
      Finally
        img.Canvas.Unlock;
      End;
    Finally
      BMP.Canvas.Unlock;
    End;
  Finally
    BMP.Free;
  End;

  Result := not Result;
end;

procedure TForm1.Button1Click(Sender: TObject);
Var
  Bitmap: TBitmap;
begin
  Button1.Enabled := False;
  Button2.Enabled := true;
  Bitmap := TBitmap.Create;
  Try
    Bitmap.LoadFromFile('C:\<картинка>.bmp'); // В моём случае это 24битная BMP'шка 200x50 пикселей 
    while not Stop do
    Begin
      inc(X);
      CompareScreenAndImage(100, 100, Bitmap);
      Button2.Caption := IntToStr(X);
      Application.ProcessMessages;
    End;
  Finally
    Bitmap.Free;
  End;
  Stop := False;
  Button1.Enabled := True;
  Button2.Enabled := False;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Stop := True;
  X := 0;
end;

Думаю разъяснять тут нечего, код простой, программа просто сверяет кусочек экрана с имеющимся изображением.

Так вот, при длительной работе программы, скажем 10000 циклов вся операционная система(Win7) начинает подлагивать, в частности очень медленно начинают прорисовываться окна других программ, также появляется замедленная реакция на клик мышки и прочее.
Эти симптомы не пропадают даже если остановить цикл(Button2). И только закрытие программы приводит ОС в норму.

Вопрос: из-за чего это происходит? И как этого избежать?

Это сообщение отредактировал(а) Attack - 16.9.2012, 17:29

MetalFan

Дата 16.9.2012, 17:47 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 22
Всего: 128

Цитата(Attack @ 16.9.2012, 17:29

)

GetDC(0)

А где ReleaseDC?

Посмотри в ProcessExlporer (от SysInternals, который теперь пренадлежит MS), вкладку Perfomance раздел Handles, уверен, увидишь постоянно увеличивающееся кол-во "занятых" хэндлов GDI.

Кстати, более оптимально сравнивать не по пикселям, а по строкам... CompareMem на scanline. Но при условии, что PixelFormat совпадает.

Это сообщение отредактировал(а) MetalFan - 16.9.2012, 17:54

--------------------

There are always someone smarter than you...

Attack

Дата 16.9.2012, 18:04 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 45
Регистрация: 20.7.2006

Репутация: нет
Всего: нет

MetalFan, большое спасибо, всё как вы сказали. Количество GDI Handles равнялось числу отработанных циклов.
Исправил код, теперь всё работает как нужно:

Код


Var
  DC: hDC;
...
Begin
...
DC := GetDC(0);
BitBlt(BMP.Canvas.Handle, 0, 0, img.Width, img.Height, DC, ScreenX, ScreenY, SRCCOPY);
ReleaseDC(0, DC);
...

Также спасибо за подсказку про сравнение по строкам, обязательно посмотрю.

Это сообщение отредактировал(а) Attack - 16.9.2012, 18:05

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »