Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 02.07.2019, 22:12   #1
Ares80
Пользователь
 
Регистрация: 21.07.2011
Сообщений: 13
По умолчанию [РЕШЕНО] Утечка выделенной памяти, пропадает изображение.

Дорогие форумчане, не получается решить проблему, кто поможет отблагодарю!
Когда по программе двигаю мышкой начинает пропадать изображение и растет выделенная память, на вас великих одна надежда!
Код:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, unit2, Vcl.ExtCtrls,
  Vcl.Imaging.GIFImg;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    Image1: TImage;
    Timer1: TTimer;
    Panel2: TPanel;
    Image2: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    TThread1 : Thread_1;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  F, Ex : HWND;


implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
 F := Self.Handle;
 Ex := FindWindowEx(F, 0, 'TPanel', 'Panel1');
 if Timer1.Enabled = False then begin
  Button1.Caption := 'Выключить';
  Timer1.Enabled := True
 end
 else begin
  Button1.Caption := 'Включить';
  Timer1.Enabled := False;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 (image1.Picture.Graphic as TGIFImage).Animate := True;
 (image1.Picture.Graphic as TGIFImage).AnimationSpeed := 100;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 TThread1 := Thread_1.Create(True);
 TThread1.FreeOnTerminate := True;
 TThread1.Resume;
end;

end.
Код:
unit Unit2;

interface

uses
  Winapi.Windows, System.SysUtils, System.Classes, Vcl.Graphics;

type
   Thread_1 = class(TThread)
private
   FTargetHandle: HWND;
   procedure GetTargetRect(out Rect: TRect);
   procedure GetTargetDimensions(out w, h: integer);
public
   property TargetHandle: HWND read FTargetHandle write FTargetHandle;
protected
   procedure Execute; override;
end;

var
   isDrawing:boolean;

implementation

uses unit1;

procedure Thread_1.GetTargetDimensions(out w, h: integer);
var
 Rect: TRect;
begin
 GetTargetRect(rect);
 w := Rect.Right - Rect.Left;
 h := Rect.Bottom - Rect.Top;
end;

procedure Thread_1.GetTargetRect(out Rect: TRect);
begin
 GetWindowRect(TargetHandle, Rect);
end;

procedure Thread_1.Execute;
var
 hWinDC: THandle;
 w, h: integer;
 HWD: HWND;
 HW: String;
 Bmp: TBitmap;
begin
 try
  Bmp := TBitmap.Create;
  Bmp.PixelFormat:=pf24bit;
  HW := IntToStr(Form1.Panel1.Handle);
  HWD := HWND({$IFDEF WIN64}StrToInt64{$ELSE}StrToInt{$ENDIF}(HW));
  TargetHandle := HWD;
  hWinDC := GetWindowDC(TargetHandle);
  GetTargetDimensions(w, h);
  Bmp.Width := w;
  Bmp.Height := h;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, hWinDC, 0, 0, SRCCOPY);
 finally
  ReleaseDC(TargetHandle, hWinDC);
  Form1.Image2.Picture.Assign(Bmp);
  FreeAndNil(Bmp);
 end;
end;

end.
Вложения
Тип файла: rar shot.rar (67.4 Кб, 22 просмотров)
Ares80 вне форума Ответить с цитированием
Старый 03.07.2019, 05:00   #2
Black Fregat
Программист
Участник клуба
 
Аватар для Black Fregat
 
Регистрация: 23.06.2009
Сообщений: 1,772
По умолчанию

Глубоко не копал, навскидку:
1) Не самая лучшая идея - каждый раз создавать новый поток по тику таймера. Сделайте в потоке цикл и в этом цикле просто поставьте Sleep на нужное время
2) Из потока нельзя напрямую обращаться к VCL. Используйте Synchronize

А в чём, собственно, идея этого кода?
Black Fregat вне форума Ответить с цитированием
Старый 03.07.2019, 12:27   #3
Ares80
Пользователь
 
Регистрация: 21.07.2011
Сообщений: 13
По умолчанию

Цитата:
Сообщение от Black Fregat Посмотреть сообщение
Глубоко не копал, навскидку:
1) Не самая лучшая идея - каждый раз создавать новый поток по тику таймера. Сделайте в потоке цикл и в этом цикле просто поставьте Sleep на нужное время
2) Из потока нельзя напрямую обращаться к VCL. Используйте Synchronize

А в чём, собственно, идея этого кода?
Спасибо, решил через цикл и синхронизацию.

Последний раз редактировалось Ares80; 03.07.2019 в 18:43.
Ares80 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Утечка памяти Алексей0001 Общие вопросы Delphi 8 02.02.2018 23:17
Утечка памяти [Освобождение памяти массива] denis76560 Общие вопросы Delphi 4 27.11.2016 18:20
Утечка памяти. Gdasar C++ Builder 15 09.02.2016 08:56
Пропадает изображение в видео alhon Софт 7 11.03.2014 14:48
Утечка памяти forivanb Общие вопросы Delphi 4 11.04.2012 15:28