|
Estaba un poco aburrido de mi rutina y aproveche tu problema para hacer algo distinto, esto funciona pero seguro debe haber una forma mejor.
Esta sacado del TForm.Print
procedure TForm1.PrintGridClick(Sender: TObject);
var
bm : TBitmap;
Ofs: Integer;
Bits: HBITMAP;
DIBWidth, DIBHeight: Longint;
PrintWidth, PrintHeight: Longint;
Image: Pointer;
ImageSize, InfoSize: DWORD;
Info: PBitmapInfo;
begin
if GetWindowLong(DBgrid1.Handle, GWL_STYLE) and WS_BORDER <> 0 then
Ofs := -1 // Don't draw form border
else
Ofs := 0; // There is no border
bm := TBitmap.Create;
bm.Width := DBgrid1.Width;
bm.Height := DBgrid1.Height;
bm.Canvas.Lock;
bm.Canvas.Brush := DBgrid1.Brush;
bm.Canvas.FillRect(DBgrid1.ClientRect);
DBgrid1.PaintTo(bm.Canvas.Handle, Ofs, Ofs);
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;
PrintWidth := MulDiv(DIBWidth, Printer.PageHeight, DIBHeight);
if PrintWidth < Printer.PageWidth then
PrintHeight := Printer.PageHeight
else
begin
PrintWidth := Printer.PageWidth;
PrintHeight := MulDiv(DIBHeight, Printer.PageWidth, DIBWidth);
end;
Printer.BeginDoc;
Printer.Canvas.Lock;
StretchDIBits(Printer.Canvas.Handle, 0, 0, PrintWidth, PrintHeight, 0, 0,
DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
Printer.Canvas.Draw(0,0,bm);
Printer.Canvas.Unlock;
Printer.EndDoc;
finally
FreeMem(Image, ImageSize);
end;
finally
FreeMem(Info, InfoSize);
bm.Canvas.Unlock;
bm.Free;
end;
end;
Saludos,
|