![]() |
|
|
|||||||
| Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
|
|||
|
|||
|
Есть форма, на ней кнопка, клик по ней вызывает другую форму, она полупрозрачная, на ней выделяю область экрана и делаю скриншот этой области.. в ходе работы программы всё нормально... При закрытии программы выдает уведомление:
![]() вот код той формы, в которой создается tbitmap и делается скриншот. Код:
private
isDown: Boolean;
downX, downY: Integer;
{ Private declarations }
public
Bild: TBitMap;
{ Public declarations }
end;
var
FORM_SCREEN: TFORM_SCREEN;
implementation
{$R *.dfm}
uses Unit1;
function CaptureScreenRect(aRect: TRect): TBitMap;
var
ScreenDC: HDC;
begin
Result := TBitMap.Create;
Result.Width := aRect.Right - aRect.Left;
Result.Height := aRect.Bottom - aRect.Top;
ScreenDC := GetDC(0);
try
BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, ScreenDC, aRect.Left, aRect.Top, SRCCOPY);
finally
ReleaseDC(0, ScreenDC);
end;
end;
function GetRectByCoord(x1, y1, x2, y2: Integer): TRect;
begin
Result.Left := Min(x1, x2);
Result.Right := Max(x1, x2);
Result.Top := Min(y1, y2);
Result.Bottom := Max(y1, y2);
end;
procedure TFORM_SCREEN.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
isDown := True;
downX := X;
downY := Y;
end;
end;
{тут я выделил область и принимаюсь за создание скриншота и его сохранение}
procedure TFORM_SCREEN.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
jpg: TJPEGImage;
begin
if Button = mbLeft then // ЛКМ
begin
isDown := False;
jpg := TJPEGImage.Create;
try
Bild := CaptureScreenRect(GetRectByCoord(downX, downY, X, Y));
jpg.Assign(Bild);
Inc(SCREEN_COUNT);
jpg.SaveToFile(SCREEN_PATH + 'Screen_' + IntToStr(SCREEN_COUNT) + '.jpg');
finally
FreeAndNil(Bild);
FreeAndNil(jpg);
self.Close;
end;
end;
end;
procedure TFORM_SCREEN.FormShow(Sender: TObject); // создание битмапа в onShow
begin
Bild := TBitMap.Create;
end;полагаю дело в переменной Bild ? подскажите, что не так? |
|
#2
|
|||
|
|||
|
черт) разобрался, нагуглил ответ...
проблема была в том, что я заранее создаю Bild: tbitmap.create; Но при использовании функции он создается второй раз: Код:
function CaptureScreenRect(aRect: TRect): TBitMap;
var
ScreenDC: HDC;
begin
Result := TBitMap.Create; //<---------- тут)
Result.Width := aRect.Right - aRect.Left;
Result.Height := aRect.Bottom - aRect.Top;
ScreenDC := GetDC(0);
try
BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, ScreenDC, aRect.Left, aRect.Top, SRCCOPY);
finally
ReleaseDC(0, ScreenDC);
end;
end; |