[delphi] Kopiowanie zawartości formy do pliku graficznego

Witam. Forma: BorderStyle:=bsNone WindowState:=wsMaximized, na niej jest przycisk i obrazek

procedure TForm1.Button1Click(Sender: TObject);
var
 Can: TCanvas;
 B : TBitmap;
begin
 try
 Can := TCanvas.Create;
 Can.Handle := Getwindowdc(Self.Handle);
 B := TBitmap.Create;
 B.Width := image1.Width;
 B.Height := image1.Height;
 B.Canvas.CopyRect(Rect(image1.Left, image1.Top, image1.Width+image1.Left, image1.Height+image1.Top), Can, Rect(0, 0, image1.Width, image1.Height));
 try
 B.SaveToFile('C:\plik.bmp');
 except
 raise Exception.Create('Bład w zapisie pliku...');
 end;
 finally
 Can.Free;
 B.Free;
end;
end;

Chodzi mi o to, żeby zawartość obrazka (który może znajdować się w dowolnym miejscu formy) została zapisana do pliku. Te moje wypociny niestety nie działają, obrazek nie jest identyczny.

Aha i jeszcze coś: wiem, że jest takie coś jak image1.picture.savetofile ale nie o to mi chodzi. Jeżeli na obrazku będą znajdować się jakieś komponenty (np inne obrazki) to ma być to widoczne w końcowym pliku.
Proszę o pomoc

Prooooszę Was. Potrzebuję tego bardzo... Procedura ma po prostu zapisać obrazek do pliku ale łącznie z różnymi rzeczami (komponentami), które się na nim znajdują...

Pomocy... [???]

Może kopiować wprost z Canvasa formy? (tzn. bez tworzenia nowego Can: TCanvas)

Pokombinowałem i wyszedł mi taki kod jak poniżej. Dodaj do sekcji uses moduł JPEG jeżeli chcesz
zapisywać do jpegów. Testowałem i ładnie zrzuca cały Image oraz komponenty, które są na nim, bo
chyba o to Tobie chodziło żeby zrzucić Image i to co na nim? A jest też wariant zrzutu całej formatki.

procedure TForm1.ScreenShotImage(SourceImg: TImage; DestBitmap: TBitmap);
var
  Dest, Src : TRect;
begin
  Src := Rect(SourceImg.Left, SourceImg.Top, SourceImg.Left + SourceImg.Width, SourceImg.Top + SourceImg.Height);
  Dest := Rect(0, 0, SourceImg.Width, SourceImg.Height);
  DestBitmap.Width := SourceImg.Width;;
  DestBitmap.Height := SourceImg.Height;
  DestBitmap.Canvas.CopyRect(Dest, Canvas, Src);
end;

Przykład zrzutu i zapisu do pliku:

var
  Bmp : TBitmap;
  Jpg : TJPEGImage;
begin
  Bmp := TBitmap.Create;
  Jpg := TJPEGImage.Create;
  ScreenShotImage(Image1, Bmp);
  Jpg.Assign(Bmp);
  Jpg.SaveToFile('D:\timage.jpg');
  Bmp.Free;
  Jpg.Free;
end;

Przykład zrzutu aktywnego okna. Jak ustawisz BorderStyle na bsNone to wyjdzie ok bez belki u góry:

procedure TForm1.ScreenShotForm(DestBitmap: TBitmap);
var
  C : TCanvas;
  R, T : TRect;
  H : THandle;
begin
  C := TCanvas.Create;
  C.Handle := GetWindowDC(GetDesktopWindow);
  H := Handle;
  GetWindowRect(H, T);
  try
    R := Rect(0, 0, T.Right - T.Left, T.Bottom - T.Top);
    DestBitmap.Width := T.Right - T.Left;
    DestBitmap.Height := T.Bottom - T.Top;
    DestBitmap.Canvas.CopyRect(R, C, T);
  finally
    ReleaseDC(0, C.Handle);
    C.Free;
    end;
end;

Przykład zapisu zrzutu do pliku:

var
  Bmp : TBitmap;
  Jpg : TJPEGImage;
begin
  Bmp := TBitmap.Create;
  Jpg := TJPEGImage.Create;
  ScreenShotForm(Bmp);
  Jpg.Assign(Bmp);
  Jpg.SaveToFile('D:\tform.jpg');
  Bmp.Free;
  Jpg.Free;
end;

Wow dzięki jesteś wielki :D
Działa idealnie :)

Hmm natknąłem się na kolejny problem.
Jeżeli na obrazku znajduje się Panel1 a ja nie chcę żeby był on po zapisie obrazka na nim widoczny to przed zapisaniem po prostu zmieniam jego położenie (panel1.left panel1.top) na takie żeby nie znajdował się na obrazku.
Problem w tym że kiedy procedura zmienia położenia panela to w pliku tam gdzie wcześniej był panel jest biały obszar. Tak jakby procedura zapisywała plik zanim zdąży przemieścić panel (albo odświeżyć obraz)...

Wie ktoś co można z tym zrobić? Sleep nie pomaga bo wtedy po prostu dłużej widzę biały obszar w miejscu gdzie był panel...

Mam nadzieje że ktoś zrozumiał w ogóle co napisałem :P
Help! :)

Też zauważyłem ten problem kiedy w procedurze ustawiałem borderStyle na None, na zrzucie w pliku
pokazywały się zarysowane komponenty. Próbowałem ustawić dla na przykład Memo Visible na False
jednak na zrzucie ekranu pojawiał się szary prostokąt o kształcie Panelu. Jednak znalazłem sposób i
Sleep działa tutaj poprawnie. Sprawdź sam u mnie na zrzucie nie widać Panela ani obszaru po nim :)

var
  Bmp : TBitmap;
  Jpg : TJPEGImage;
begin
  Panel1.Visible := False;

  repeat
    Sleep(300);
    Application.ProcessMessages;
  until Panel1.Visible = False;

  Bmp := TBitmap.Create;
  Jpg := TJPEGImage.Create;
  ScreenShotImage(Image1, Bmp);
  Jpg.Assign(Bmp);
  Jpg.SaveToFile('D:\timage.jpg');
  Bmp.Free;
  Jpg.Free;
  Panel1.Visible := True;
end;

Wielkie dzięki! Teraz wszystko działa poprawnie :)

A przy okazji... Da się zapisać jpg tak żeby nie tracił na jakości? Bo jak na obrazku mam czerwone kolory to zmieniają się w bordowe :-P

Nie mam pojęcia dlaczego u mnie czerwony kolor (clRed) wygląda w Memo jako tło na zrzucie tak,
jak należy - chyba, że źle widzę. Może pomoże coś Jpg.CompressionQuality := 100; nie wiem ;-/

No nie wiem.. Mój programik tworzy dynamicznie komponenty na obrazie więc zrobiłem takie próbki (cyfry i litery to TLabel a reszta to TImage)