Скриншот форм

[XeruH]

Нужно мне сделать скриншоты окон своей программы. Хотел было сделать так:

...
var
  DC: HDC;
  Frm: TForm;
  I: Integer;
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    for I := Pred(Screen.FormCount) to 0 do
    begin
      Frm := Screen.Forms[I];
      if not IsWindow(Frm.Handle) or not Frm.Visible then Continue;
    
      Bmp.Width := Frm.Width;
      Bmp.Height := Frm.Height;
      DC := GetWindowDC(Frm.Handle);
      try
        BitBlt(Bmp.Canvas.Handle, 0, 0, Frm.Width, Frm.Height, 0, 0, SrcCopy);
      finally
        ReleaseDC(Frm.Handle, DC);
      end;
      Bmp.SaveToFile('C:\Temp\screen' + IntToStr(I) + '.bmp');
    end;
  finally
    Bmp.Free;
  end;
end;

Однако как оказалось формы перекрытые другими формами он так и сохраняет. Можно было конечно перед BitBlt делать форме BringToFront, но так все мелькает да и не красивое решение.
Последовало предложение послать форме сообщение WM_PAINT, а в качестве контекста устройства задать HDC Bitmap'а. В MSDN написано что для сообщения WM_PAINT wParam и lParam не учитываются. А в инете видел что люди так делают.
Вопрос к знатокам, это работает или нет? (У меня Bitmap оказались пустые)

[asmodey1]

Господи, как же это сложно для среднестатистического ума - сделать поиск по фразе "скриншот"...
Или это только идиотам доступно ? Таким, как я..
Ну хорошо, а уже теперь, просто посмотреть в самый низ этой страницы - вас не затруднит ?
Или вы всегда действуете исключительно по приниципу моего любимого О.Бендера - "на блюдечке с голубой каемочкой" ?

[XeruH]

Сообщение от asmodey1

Господи, как же это сложно для среднестатистического ума - сделать поиск по фразе "скриншот"...
Или это только идиотам доступно ? Таким, как я..
Ну хорошо, а уже теперь, просто посмотреть в самый низ этой страницы - вас не затруднит ?
Или вы всегда действуете исключительно по приниципу моего любимого О.Бендера - "на блюдечке с голубой каемочкой" ?

А вы уверены что внимательно прочитали мой пост?

[asmodey1]

Сообщение от XeruH

А вы уверены что внимательно прочитали мой пост?

Абсолютно.
А вас что-то смущает? Или у вас затруднения с указанием координат ваших форм ?
Или у вас какие-то специфические затруднения ?

[eduard93]

Для таких случаев специально предназначен WM_PRINT.

[XeruH]

Сообщение от eduard93

Для таких случаев специально предназначен WM_PRINT.

Пробывал и WM_PRINT, в результате появляется лишь рамка формы с заголовком.

[mss]

Пробывал и WM_PRINT

Что значит "пробовал" ?
Его не "пробовать" нужно, а обрабатывать !

[eduard93]

Код в студию.

[XeruH]

Вот так работает.

  function PrintWindow(HWND:HWND;hdcBlt:HDC;nFlags:DWORD):BOOL; stdcall; external 'user32.dll';
...
procedure ScreenShotProg;
var
  Frm: TForm;
  I, wX, wY: Integer;
  Bmp: TBitmap;
  hBmp: HBITMAP;
  RC: TRect;
  hSrcDC, hSrcCompDC: HDC;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.Width := Screen.Width;
    Bmp.Height := Screen.Height;
    Bmp.Canvas.Brush.Color := clGray;
    Bmp.Canvas.FillRect(Bmp.Canvas.ClipRect);
    for I := Pred(Screen.FormCount) downto 0 do
    begin
      Frm := Screen.Forms[I];
      if not IsWindow(Frm.Handle) then Exit;

      GetWindowRect(Frm.Handle, RC);
      wX := RC.Right - RC.Left;
      wY := RC.Bottom - RC.Top;

      hSrcDC := GetWindowDC(Frm.Handle);
      try
        hSrcCompDC := CreateCompatibleDC(hSrcDC);
        try
          hBmp := CreateCompatibleBitmap(hSrcDC, wX, wY);
          try
            SelectObject(hSrcCompDC, hBmp);
            PrintWindow(Frm.Handle, hSrcCompDC, 0);
            BitBlt(Bmp.Canvas.Handle, RC.Left, RC.Top, wX, wY, hSrcCompDC, 0, 0, SRCCOPY);
          finally
            DeleteObject(hBmp);
          end;
        finally
          DeleteDC(hSrcCompDC);
        end;
      finally
        ReleaseDC(Frm.Handle, hSrcDC);
      end;
    end;
    Bmp.SaveToFile('имя_файла');
  finally
    Bmp.Free;
  end;
end;

Однако нельзя ли это реализовать проще?

Upd
+PrintWindow поддерживается только с WinXP

[eduard93]

Хм, еще можно использовать PaintTo. И кажется это будет работать и на более старых системах.