Текущий архив: 2006.03.05;
Скачать: CL | DM;

Вниз

И снова про ScreenShot с формы   Найти похожие ветки 

← →
Officeman   (2006-02-13 19:20) [0]

нашёл код, который снимает скриншот со всего экрана.
немогу снять скриншот только формы. при условии  учитывать
положение формы.


procedure TForm1.Timer1Timer(Sender: TObject);
var DCDesk: HDC; // hDC of Desktop
bmp: TBitmap;
begin
bmp := TBitmap.Create;
bmp.Height := Screen.Height;
bmp.Width := Screen.Width;
DCDesk := GetWindowDC(GetDesktopWindow);
BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,
       DCDesk, 0, 0, SRCCOPY);
bmp.SaveToFile("c:\ScreenShot.bmp");
//  bmp.SaveToFile("c:\"+inttostr(intX)+".jpeg");
  ReleaseDC(GetDesktopWindow, DCDesk);
bmp.Free;
end;


пишу так:


BitBlt(bmp.Canvas.Handle, form1.left, form1.top, form1.Width, form1.Height.......


при этом размеры ректангла придерживаются размерам формы,
но почему то всего начинается с координат x=0, y=0

---

← →
Marser ©   (2006-02-13 19:47) [1]

А просто TForm.Canvas никак?

---

← →
Officeman   (2006-02-13 21:39) [2]

сохраняет только БЕЛОЕ окно по размерам формы  =))

procedure TForm2.zag_kClick(Sender: TObject);
var DCDesk: HDC; // hDC of Desktop
bmp: TBitmap;
begin
bmp := TBitmap.Create;
bmp.Height := form2.Height;
bmp.Width := form2.Width;
BitBlt(bmp.Canvas.Handle,0,0, 100, 100, form2.Handle, 0, 0, SRCCOPY);
bmp.SaveToFile("c:\ScreenShot.jpeg");
bmp.Free;
end;

---

← →
Ого   (2006-02-13 21:58) [3]


unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ExtCtrls;

type
 TForm1 = class(TForm)
   ButtonExit: TButton;
   Button1: TButton;
   procedure ButtonExitClick(Sender: TObject);
   procedure Button1Click(Sender: TObject);
 private
 public
   procedure MakeScreenShot(const AusSchnitt: TBitmap);
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}
function EnumMiniProc (Wd: HWnd; Param: LongInt): Boolean; stdcall;
begin
 if (Wd = Form1.Handle){  and (Wd <> HWND_DESKTOP)}then
   If  IsWindowVisible(WD) then
     If  not IsIconic(WD) then
       If  isWindow(WD) then
         ShowWindow(WD, SW_MINIMIZE);

 EnumMiniProc := TRUE;
end;

procedure TForm1.ButtonExitClick(Sender: TObject);
begin
 Close;
end;

procedure TForm1.MakeScreenShot(const AusSchnitt: TBitmap);
var
DesktopDC: HDC;
begin
DesktopDC := GetDC(HWND_DESKTOP);
try
  AusSchnitt.PixelFormat := pfDevice;
  StretchBlt(AusSchnitt.Canvas.Handle, AusSchnitt.Width, AusSchnitt.Height,
             -AusSchnitt.Width, -AusSchnitt.Height, DesktopDC, 0, 0,Screen.Width,
             Screen.Height, SRCCOPY);

  BitBlt(DesktopDC, 0, 0, AusSchnitt.Width, AusSchnitt.Height,
         AusSchnitt.Canvas.Handle, 0, 0, SRCCOPY);
finally
  DeleteDC(DesktopDC);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 Bmp: TBitmap;
begin
 EnumWindows(@EnumMiniProc, 0);

 Bmp := TBitmap.Create;
 try
   Bmp.Width := Screen.Width;
   Bmp.Height := Screen.Height;
   MakeScreenShot(Bmp);
   Bmp.SaveToFile("TestDSK.bmp");
 finally
   Bmp.Free;
 end;
end;

end.



---

← →
Officeman   (2006-02-13 22:05) [4]

=)))))))))))))))))))))))))

очень смешно.  чуть со стула не упал со смеху.

---

← →
Officeman   (2006-02-13 22:08) [5]

ну на самом деле.  люди - человеки.

Нужен screenshot формы !!!!

---

← →
Zeqfreed ©   (2006-02-13 22:22) [6]

procedure TForm1.Button1Click(Sender: TObject);
begin
 with TBitmap.Create() do begin
  try
   Width := Self.Width;
   Height := Self.Height;
   PixelFormat := pf24bit;
   BitBlt(Canvas.Handle, 0, 0, Width, Height, GetDC(GetDesktopWindow()), Self.Left, Self.Top, SRCCOPY);
   SaveToFile("screenshot.bmp");
  finally
   Free;
  end;
 end;
end;

---

← →
Officeman   (2006-02-13 22:32) [7]

to  Zeqfreed
спасибо. теперь я разобрался.

---

Страницы: 1 вся ветка

Текущий архив: 2006.03.05;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.033 c