Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
{ Print a device independent bitmap, stretched to fill as much as possible of
the printable area defined by the rectangle RectMax, while maintaining the
correct X/Y proportions. The printing is centrally aligned within RectMax.
Parameters:
Bmp: Device independent bitmap to be printed
RectMax: Rectangle (in pixels) defining the maximum bounds of the
printable area. The rectangle is specified relative to the print
offset (leftmost/topmost point that can be printed). }
procedure TForm1.PrintDIB(const Bmp: TBitmap;
const RectMax: TRect);
var
HBmp: HBITMAP;
InfoSize, ImageSize: DWORD;
Info: PBitmapInfo;
Image: Pointer;
WidthMax, HeightMax: Integer;
PrintWidth, PrintHeight: Integer;
PrintLeft, PrintTop: Integer;
begin
Printer.BeginDoc;
try
HBmp := Bmp.Handle;
GetDIBSizes(HBmp, InfoSize, ImageSize);
Info := AllocMem(InfoSize);
try
Image := AllocMem(ImageSize);
try
GetDIB(HBmp, 0, Info^, Image^);
WidthMax := RectMax.Right - RectMax.Left;
HeightMax := RectMax.Bottom - RectMax.Top;
PrintWidth := (HeightMax * Bmp.Width) div Bmp.Height;
if PrintWidth < WidthMax then
begin
PrintHeight := HeightMax;
PrintLeft := RectMax.Left + (WidthMax - PrintWidth) div 2;
PrintTop := RectMax.Top;
end
else
begin
PrintWidth := WidthMax;
PrintHeight := (WidthMax * Bmp.Height) div Bmp.Width;
PrintLeft := RectMax.Left;
PrintTop := RectMax.Top + (HeightMax - PrintHeight) div 2;
end;
StretchDIBits(Printer.Canvas.Handle,
PrintLeft, PrintTop, PrintWidth, PrintHeight,
0, 0, Bmp.Width, Bmp.Height, Image, Info^,
DIB_RGB_COLORS, SRCCOPY);
finally
FreeMem(Image, ImageSize);
end;
finally
FreeMem(Info, InfoSize);
end;
finally
Printer.EndDoc;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
DefMarginMM = 2000; //Default print margin in 100ths of a milllimetre
DefMarginIn = 750; //Default print margin in 1000ths of an inch
InchToMM = 25.4;
var
LocaleMeas: array [0..1] of char;
DefMargin: Integer;
OldCursor: TCursor;
PixPerInchX, PixPerInchY: Integer;
PageEdgeR, PageEdgeB: Integer;
PrinterMarginL, PrinterMarginR, PrinterMarginT, PrinterMarginB: Integer;
ScaleX, ScaleY: Real;
MarginL, MarginR, MarginT, MarginB: Integer;
PrintRectMax: TRect;
PrintBmp: TBitmap;
begin
// Run the print dialog window
if PrintDialog1.Execute then // User has selected "Print"
begin
// Setup measurement system to be the same as user default for the locale
// and set default margins
GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_IMEASURE, LocaleMeas,
SizeOf(LocaleMeas));
with PageSetupDialog1 do
begin
if LocaleMeas[0] = '0' then
begin
Units := pmMillimeters;
DefMargin := DefMarginMM; // Margin in 100ths of a mm
end
else
begin
Units := pmInches;
DefMargin := DefMarginIn; // Margin in 1000ths of an inch
end;
MarginLeft := DefMargin;
MarginTop := DefMargin;
MarginRight := DefMargin;
MarginBottom := DefMargin;
end;
// Run the page setup dialog window
if PageSetupDialog1.Execute then // User has selected "OK"
begin
OldCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
try
// Get the printer info and determine the printable area
with Printer do
begin
PixPerInchX := GetDeviceCaps(Handle, LOGPIXELSX);
PixPerInchY := GetDeviceCaps(Handle, LOGPIXELSY);
PageEdgeR := GetDeviceCaps(Handle, PHYSICALWIDTH);
PageEdgeB := GetDeviceCaps(Handle, PHYSICALHEIGHT);
PrinterMarginL := GetDeviceCaps(Handle, PHYSICALOFFSETX);
PrinterMarginR := PageEdgeR - (PrinterMarginL + PageWidth);
PrinterMarginT := GetDeviceCaps(Handle, PHYSICALOFFSETY);
PrinterMarginB := PageEdgeB - (PrinterMarginT + PageHeight);
end;
with PageSetupDialog1 do
begin
// Scalings from page setup margins to pixels
if Units = pmMillimeters then //Margins in 100ths of a mm
begin
ScaleX := PixPerInchX / (100 * InchToMM);
ScaleY := PixPerInchY / (100 * InchToMM);
end
else //Margins in 1000ths of an inch
begin
ScaleX := PixPerInchX / 1000;
ScaleY := PixPerInchY / 1000;
end;
// Convert margin selections to pixels.
// NOTE - Due to problems in the page setup dialog with metric
// measurements, the printer minimum margins may not have been applied
// correctly, so the minimum margins are applied here as well.
MarginL := Max(Trunc(MarginLeft * ScaleX), PrinterMarginL);
MarginR := Max(Trunc(MarginRight * ScaleX), PrinterMarginR);
MarginT := Max(Trunc(MarginTop * ScaleY), PrinterMarginT);
MarginB := Max(Trunc(MarginBottom * ScaleY), PrinterMarginB);
end;
// Maximum print area (in pixels) relative to the printer offset
PrintRectMax := Rect(MarginL - PrinterMarginL, MarginT - PrinterMarginT,
PageEdgeR - MarginR - PrinterMarginL,
PageEdgeB - MarginB - PrinterMarginT);
PrintBmp := TBitmap.Create;
try
PrintBmp.HandleType := bmDIB;
PrintBmp := GetPrintBmp; //***Function GetPrintBmp to be provided
// Print image
PrintDIB(PrintBmp, PrintRectMax);
finally
PrintBmp.Free;
end;
finally
Screen.Cursor := OldCursor;
end;
end;
end;
end;