| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

И снова про ScreenShot с формы [D6, 2000]

Officeman ©   (2006-02-13 19:20:00) 

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


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

---

Officeman   (2006-02-13 22:32:00) [1]

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

---

Zeqfreed   (2006-02-13 22:22:00) [2]

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:08:00) [3]

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

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

---

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

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

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

---

Ого   (2006-02-13 21:58:00) [5]


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 21:39:00) [6]

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

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;

---

Marser   (2006-02-13 19:47:00) [7]

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

---

Наверх