[nixon232]

Снова привет.
Объясните недалекому. Есть:

Код:

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;

Вызов А - вылет АV в последней строке

Код:

  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 );

В чем дело? все же идентично? имейдж пустой и там и там, на начало вызова.

[Decoding]

Все нормально работает

Код:

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

[nixon232]

Тогда в чем может быть проблема? я вызываю не с главной формы, а созданной так:

Код:

 f := TScreenFRM.Create(Self);
   if f.ShowModal=mrOk then

но это вряд ли влияет.
av.PNG

[nixon232]

Снова попробую апнуть тему. Вот листинг. Как я понимаю, он не работает только у меня?

Код:

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;

Что все-таки может быть?

[Shaft]

Если вторую форму создавать вот так

Код:

Form2:=TForm2.Create(Self);
Form2.Show;

или вот так

Код:

Application.CreateForm(TForm2, Form2);
Form2.Show;

То все работает

[nixon232]

Она же так и создается?

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  f: TForm2;

begin
 
  f := TForm2.Create(self);
  f.Show;
end;

переписал на ваш вариант - все так же

Код:

---
var
  Form1: TForm1;
  form2: TForm2;
implementation

{$R *.dfm}
----

[Shaft]

Вот весь код Shoot.pas все работает, а по началу тоже было AV

Код:

unit Shoot;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,  Unit2,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Application.CreateForm(TForm2, Form2);
  Form2.Show;
end;
end.

[nixon232]

Да, в таком варианте АВ нет, но чем создание по первому варианту не проходит? Такое чувство, что Image1 не создается в конструкторе.

[Shaft]

В первом варианте f: TForm2; объявлена и создана как локальная в процедуре Button1Click из Form1, а обращение идет к Form2: TForm2; которая объявлена но не создана.
Иными словами, есть две объявленные f: TForm2; и Form2: TForm2;
f создана а Form2 нет но тем не менее обращение идет к form2.Image1.Picture.Bitmap:=bit; поэтому AV а к f мы не можем обратиться так как она локальная

[nixon232]

Все верно. и решение тогда логичное и простое

Код:

...

type
  TForm2 = class(TForm)
    btn1: TButton;
    Image1: TImage;
    procedure btn1Click(Sender: TObject);
    procedure GetScreen;
  private
    { Private declarations }
  public
    { Public declarations }

  end;
....