Richedit Formdruck ?

[marabu]

Hallo Vader,

ich habe mir zu diesem Zweck folgendes zurecht gelegt - vielleicht hilft es auch dir:

Delphi-Quellcode:

function GrabImage(h: HWND): TBitMap;
var
  dc: HDC;
  lpPal: PLogPalette;
  r: TRect;
begin
  dc := GetDC(0);
  GetWindowRect(h, r);
  Result := TBitMap.Create;;
  Result.Width := Succ(r.Right - r.Left);
  Result.Height := Succ(r.Bottom - r.Top);
  if (GetDeviceCaps(dc, RASTERCAPS) AND RC_PALETTE = RC_PALETTE) then
  begin
    GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
    FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
    lpPal^.palVersion := $300;
    lpPal^.palNumEntries := GetSystemPaletteEntries(dc, 0, 256, lpPal^.palPalEntry);
    if (lpPal^.PalNumEntries <> 0) then
      Result.Palette := CreatePalette(lpPal^);
    FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
  end;
  BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, dc, r.Left, r.Top, SRCCOPY);
  ReleaseDC(0, dc);
end;

Delphi-Quellcode:

procedure PrintImage(const x, y, w, h: Integer; bm: TBitMap);
var
  Info: PBitmapInfo;
  InfoSize: DWORD;
  Image: Pointer;
  ImageSize: DWORD;
  Bits: HBITMAP;
  DIBWidth, DIBHeight: DWORD;
begin
  with Printer do
  begin
    Canvas.Lock;
    try
      Bits := bm.Handle;
      GetDIBSizes(Bits, InfoSize, ImageSize);
      Info := AllocMem(InfoSize);
      try
        Image := AllocMem(ImageSize);
        try
          GetDIB(Bits, 0, Info^, Image^);
          with Info^.bmiHeader do
          begin
            DIBWidth := biWidth;
            DIBHeight := biHeight;
          end;
          StretchDIBits(
            Canvas.Handle,
            x, y, w, h,
            0, 0, DIBWidth, DIBHeight,
            Image, Info^, DIB_RGB_COLORS, SRCCOPY
          );
        finally
          FreeMem(Image, ImageSize);
        end;
      finally
        FreeMem(Info, InfoSize);
      end;
    finally
      Canvas.Unlock;
    end;
  end;
end;

Aufrufbeispiele:

Delphi-Quellcode:

procedure TDemoForm.SaveButtonClick(Sender: TObject);
begin
  with GrabImage(Handle) do
  begin
    SaveToFile(ChangeFileExt(ParamStr(0), '.bmp'));
    Free;
  end;
end;

procedure TDemoForm.PrintButtonClick(Sender: TObject);
var
  bm: TBitMap;
  ratio: Extended;
  iOffset, iMaxWidth, iWidth, iHeight: Cardinal;
begin
  bm := GrabImage(Handle);
  try
    ratio := bm.Width / bm.Height;
    with Printer do
    begin
      iMaxWidth := Succ(Canvas.ClipRect.Right - Canvas.ClipRect.Left);
      iWidth := Round(iMaxWidth * 0.8);
      iHeight := Round(iWidth / ratio);
      iOffset := (iMaxWidth - iWidth) div 2;
      BeginDoc;
      PrintImage(iOffset, iOffset, iWidth, iHeight, bm);
      EndDoc;
    end;
  finally
    bm.Free;
  end;
end;

GrabImage() liefert nicht nur die client area, sondern auch die vom window manager gemalten Bereiche (borders, caption, ...)

Grüße vom marabu