|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
|
|||
|
|||
AV При попытке загрузить BMP
Снова привет.
Объясните недалекому. Есть: Код:
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; Код:
procedure GetSceen; var pt : TPoint; r : TRect; h : HWND; bit: TBitmap; begin bit:=TBitmap.Create; GetCursorPos(pt); h:=WindowFromPoint( pt ); GetWindowRect( h, r ); bit:=CaptureScreenRect( r ); bit.SaveToFile(ExtractFilePath(Application.ExeName)+'123.bmp'); with ScreenFRM do begin Image1.Picture.Bitmap:=bit; Вызов В: Если вызвать в OnShow То все прекрасно работает. Код:
procedure TScreenFRM.FormShow(Sender: TObject); var pt : TPoint; r : TRect; h : HWND; bit: TBitmap; begin bit:=TBitmap.Create; h:=WindowFromPoint( Mouse.CursorPos ); GetWindowRect( h, r ); Image1.Picture.Bitmap:= CaptureScreenRect( r ); Последний раз редактировалось nixon232, 27.05.2017 в 21:54. |
#2
|
||||
|
||||
Все нормально работает
Код:
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; procedure GetSceen; var pt : TPoint; r : TRect; h : HWND; bit: TBitmap; begin bit:=TBitmap.Create; GetCursorPos(pt); h:=WindowFromPoint( pt ); GetWindowRect( h, r ); bit:=CaptureScreenRect( r ); //bit.SaveToFile(ExtractFilePath(Application.ExeName)+'123.bmp'); with Form1 do begin Image1.Picture.Bitmap:=bit; end; bit.Free; end; procedure TForm1.Button1Click(Sender: TObject); begin GetSceen; end; Протестировал в XE2 |
#4
|
|||
|
|||
Снова попробую апнуть тему. Вот листинг. Как я понимаю, он не работает только у меня?
Код:
procedure GetScreen; var pt : TPoint; r : TRect; h : HWND; bit: TBitmap; begin try bit:=TBitmap.Create; h:=WindowFromPoint( Mouse.CursorPos ); GetWindowRect( h, r ); // Form2.Image1.Picture:=nil; bit:= CaptureScreenRect( r ); form2.Image1.Picture.Bitmap:=bit; // вылетаем тут finally bit.Free; end; Код:
procedure TWinControl.MainWndProc(var Message: TMessage); begin try try WindowProc(Message); finally FreeDeviceContexts; FreeMemoryContexts; end; except Application.HandleException(Self); // вот сюда. end; end; Последний раз редактировалось nixon232, 06.08.2017 в 15:25. |
#5
|
|||
|
|||
Если вторую форму создавать вот так
Код:
Form2:=TForm2.Create(Self); Form2.Show; Код:
Application.CreateForm(TForm2, Form2); Form2.Show; |
#6
|
|||
|
|||
Она же так и создается?
Код:
procedure TForm1.Button1Click(Sender: TObject); var f: TForm2; begin f := TForm2.Create(self); f.Show; end; Код:
--- var Form1: TForm1; form2: TForm2; implementation {$R *.dfm} ---- |