Показать сообщение отдельно
  #4  
Старый 05.07.2018, 09:50
Аватар для Vayrus
Vayrus Vayrus вне форума
Исполняемый Ретровирус
 
Регистрация: 09.08.2008
Адрес: Umbrella Corporation
Сообщения: 744
Репутация: 1293
По умолчанию

Попробуйте эти варианты, не тестировал, в проблему вопроса вникать некогда)

Код:
//v1
function GetScreenShot(const AHandle: THandle; FileName: String; QuickSave: Boolean): Boolean;
var
  fBitmap: PBitmap;
  DC: HDC;
  Rect: TRect;
  OSD: POpenSaveDialog;
  Image: PPngObject;

begin
  Image := NewPngObject;
  fBitmap := nil;
  Result := False;
  DC := GetDC(AHandle);
  if DC <> 0 then
    try
      if not GetClientRect(AHandle, Rect) then Exit;
      fBitmap := NewDIBBitmap(Rect.Right - Rect.Left, Rect.Bottom - Rect.Top, pf32bit);
      Result := BitBlt(fBitmap.Canvas.Handle, 0, 0, fBitmap.Width, fBitmap.Height, DC, 0, 0, SRCCOPY);
      if not Result then Exit;
      Image.AssignHandle(fBitmap.Handle, false, 0);
      if not QuickSave then
        begin
        OSD := NewOpenSaveDialog('', '', DefOpenSaveDlgOptions );
        OSD.Filter := 'PNG - Portable Network Graphics|*.png';
        OSD.Filename := FileName;
        OSD.WndOwner := OpWnd;
        OSD.OpenDialog := false;
        if OSD.Execute then
          begin
          Image.SaveToFile(OSD.Filename);
          end;
        OSD.Free;
        end
      else Image.SaveToFile(FileName);
    finally
      fBitmap.Free;
      Image.Free;
      ReleaseDC(AHandle, DC);
    end;
end;

//v2
//WindowSnap(Self.Handle, Image1.Picture.Bitmap) ;
//Image1.Refresh;
function WindowSnap(windowHandle: HWND; bmp: TBitmap): boolean;
var
  r: TRect;
  user32DLLHandle: THandle;
  printWindowAPI: function(sourceHandle: HWND; destinationHandle: HDC;
    nFlags: UINT): BOOL; stdcall;
begin
  result := False;
  user32DLLHandle := GetModuleHandle(user32) ;
  if user32DLLHandle <> 0 then
  begin
    @printWindowAPI := GetProcAddress(huser32, 'PrintWindow') ;
    if @printWindowAPI <> nil then
    begin
      GetWindowRect(windowHandle, r) ;
      bmp.Width := r.Right - r.Left;
      bmp.Height := r.Bottom - r.Top;
      bmp.Canvas.Lock;
      try
        result := printWindowAPI(windowHandle, bmp.Canvas.Handle, 0) ;
      finally
        bmp.Canvas.Unlock;
      end;
    end;
  end;
end; (*WindowSnap*)

//v3
procedure TForm1.Button1Click(Sender: TObject);
const
  FullWindow = True; // Set to false if you only want the client area.
var
  Win: HWND;
  DC: HDC;
  Bmp: TBitmap;
  FileName: string;
  WinRect: TRect;
  Width: Integer;
  Height: Integer;
begin
  Form1.Hide;
  try
    Application.ProcessMessages; // Was Sleep(500);
    Win := GetForegroundWindow;

    if FullWindow then
    begin
      GetWindowRect(Win, WinRect);
      DC := GetWindowDC(Win);
    end else
    begin
      Windows.GetClientRect(Win, WinRect);
      DC := GetDC(Win);
    end;
    try
      Width := WinRect.Right - WinRect.Left;
      Height := WinRect.Bottom - WinRect.Top;

      Bmp := TBitmap.Create;
      try
        Bmp.Height := Height;
        Bmp.Width := Width;
        BitBlt(Bmp.Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SRCCOPY);
        FileName := 'Screenshot_' + 
          FormatDateTime('mm-dd-yyyy-hhnnss', Now());
        Bmp.SaveToFile(Format('C:\Screenshots\%s.bmp', [FileName]));
      finally
        Bmp.Free;
      end;
    finally
      ReleaseDC(Win, DC);
    end;
  finally
    Form1.Show;
  end;
end;
Ответить с цитированием