Печать всей формы 2

Delphi , ОС и Железо , Принтеры и Печать

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

{ 
 Dieser Code druckt den Inhalt einer Form aus. 
 Jedoch ohne Rand und Titelleiste. 

 This code prints out form1. Without border and caption bar. 
 Print uses the GetFormImage method to obtain a bitmap of the form and 
 draws that to the printer’s HDC. 
}


 procedure TForm1.Button1Click(Sender: TObject);
 begin
   Form1.Print;
 end;

 { 
  The following TI details a better way to print the contents of 
  a form, by getting the device independent bits in 256 colors 
  from the form, and using those bits to print the form to the 
  printer. 

  In addition, a check is made to see if the screen or printer 
  is a palette device, and if so, palette handling for the device 
  is enabled. If the screen device is a palette device, an additional 
  step is taken to fill the bitmap's palette from the system palette, 
  overcoming some buggy video drivers who don't fill the palette in. 

  Note: Since this code does a screen shot of the form, the form must 
  be the topmost window and the whole from must be viewable when the 
  form shot is made. 

  Copyright by SWAG SUPPORT TEAM 
  http://gdsoft.com/swag/swag.html 
}


 procedure PrintForm(AForm: TForm; BorderWidth: Integer);
 var
   dc: HDC;
   isDcPalDevice: BOOL;
   MemDc: hdc;
   MemBitmap: hBitmap;
   OldMemBitmap: hBitmap;
   hDibHeader: THandle;
   pDibHeader: Pointer;
   hBits: THandle;
   pBits: Pointer;
   ScaleX: Double;
   ScaleY: Double;
   ppal: PLOGPALETTE;
   pal: hPalette;
   Oldpal: hPalette;
   i: Integer;
 begin
   {Get the screen dc}
   dc := GetDc(0);
   {Create a compatible dc}
   MemDc := CreateCompatibleDc(dc);
   {create a bitmap}
   MemBitmap := CreateCompatibleBitmap(Dc,
     AForm.Width,
     AForm.Height);
   {select the bitmap into the dc}
   OldMemBitmap := SelectObject(MemDc, MemBitmap);

   {Lets prepare to try a fixup for broken video drivers}
   isDcPalDevice := False;
   if GetDeviceCaps(dc, RASTERCAPS) and
     RC_PALETTE = RC_PALETTE then
   begin
     GetMem(pPal, SizeOf(TLOGPALETTE) +
     (255 * SizeOf(TPALETTEENTRY)));
     FillChar(pPal^, SizeOf(TLOGPALETTE) +
     (255 * SizeOf(TPALETTEENTRY)), #0);
     pPal^.palVersion    := $300;
     pPal^.palNumEntries :=
       GetSystemPaletteEntries(dc,
       0,
       256,
       pPal^.palPalEntry);
     if pPal^.PalNumEntries <> 0 then
     begin
       pal           := CreatePalette(pPal^);
       oldPal        := SelectPalette(MemDc, Pal, False);
       isDcPalDevice := True
     end
     else
       FreeMem(pPal, SizeOf(TLOGPALETTE) +
       (255 * SizeOf(TPALETTEENTRY)));
   end;

   {copy from the screen to the memdc/bitmap}
   BitBlt(MemDc,
     0, 0,
     AForm.Width, AForm.Height,
     Dc,
     AForm.Left, AForm.Top,
     SrcCopy);

   if isDcPalDevice = True then
   begin
     SelectPalette(MemDc, OldPal, False);
     DeleteObject(Pal);
   end;

   {unselect the bitmap}
   SelectObject(MemDc, OldMemBitmap);
   {delete the memory dc}
   DeleteDc(MemDc);
   {Allocate memory for a DIB structure}
   hDibHeader := GlobalAlloc(GHND,
     SizeOf(TBITMAPINFO) +
     (SizeOf(TRGBQUAD) * 256));
   {get a pointer to the alloced memory}
   pDibHeader := GlobalLock(hDibHeader);

   {fill in the dib structure with info on the way we want the DIB}
   FillChar(pDibHeader^,
     SizeOf(TBITMAPINFO) + (SizeOf(TRGBQUAD) * 256),
     #0);
   PBITMAPINFOHEADER(pDibHeader)^.biSize        :=
     SizeOf(TBITMAPINFOHEADER);
   PBITMAPINFOHEADER(pDibHeader)^.biPlanes      := 1;
   PBITMAPINFOHEADER(pDibHeader)^.biBitCount    := 8;
   PBITMAPINFOHEADER(pDibHeader)^.biWidth       := AForm.Width;
   PBITMAPINFOHEADER(pDibHeader)^.biHeight      := AForm.Height;
   PBITMAPINFOHEADER(pDibHeader)^.biCompression := BI_RGB;

   {find out how much memory for the bits}
   GetDIBits(dc,
     MemBitmap,
     0,
     AForm.Height,
     nil,
     TBitmapInfo(pDibHeader^),
     DIB_RGB_COLORS);

   {Alloc memory for the bits}
   hBits := GlobalAlloc(GHND,
     PBitmapInfoHeader(pDibHeader)^.BiSizeImage);
   {Get a pointer to the bits}
   pBits := GlobalLock(hBits);

   {Call fn again, but this time give us the bits!}
   GetDIBits(dc,
     MemBitmap,
     0,
     AForm.Height,
     pBits,
     PBitmapInfo(pDibHeader)^,
     DIB_RGB_COLORS);

   {Lets try a fixup for broken video drivers}
   if isDcPalDevice = True then
   begin
     for i := 0 to (pPal^.PalNumEntries - 1) do
     begin
       PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed   :=
         pPal^.palPalEntry[i].peRed;
       PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen :=
         pPal^.palPalEntry[i].peGreen;
       PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue  :=
         pPal^.palPalEntry[i].peBlue;
     end;
     FreeMem(pPal, SizeOf(TLOGPALETTE) +
     (255 * SizeOf(TPALETTEENTRY)));
   end;

   {Release the screen dc}
   ReleaseDc(0, dc);
   {Delete the bitmap}
   DeleteObject(MemBitmap);

   {Start print job}
   Printer.BeginDoc;

   {Scale print size}
   if Printer.PageWidth < Printer.PageHeight then
   begin
     ScaleX := Printer.PageWidth;
     ScaleY := AForm.Height * (Printer.PageWidth / AForm.Width);
   end
   else
   begin
     ScaleX := AForm.Width * (Printer.PageHeight / AForm.Height);
     ScaleY := Printer.PageHeight;
   end;


   {Just incase the printer drver is a palette device}
   isDcPalDevice := False;
   if GetDeviceCaps(Printer.Canvas.Handle, RASTERCAPS) and
     RC_PALETTE = RC_PALETTE then
   begin
     {Create palette from dib}
     GetMem(pPal, SizeOf(TLOGPALETTE) +
     (255 * SizeOf(TPALETTEENTRY)));
     FillChar(pPal^, SizeOf(TLOGPALETTE) +
     (255 * SizeOf(TPALETTEENTRY)), #0);
     pPal^.palVersion    := $300;
     pPal^.palNumEntries := 256;
     for i := 0 to (pPal^.PalNumEntries - 1) do
     begin
       pPal^.palPalEntry[i].peRed   :=
         PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed;
       pPal^.palPalEntry[i].peGreen :=
         PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen;
       pPal^.palPalEntry[i].peBlue  :=
         PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue;
     end;
     pal := CreatePalette(pPal^);
     FreeMem(pPal, SizeOf(TLOGPALETTE) +
     (255 * SizeOf(TPALETTEENTRY)));
     oldPal  := SelectPalette(Printer.Canvas.Handle, Pal, False);
     isDcPalDevice := True
   end;

   {send the bits to the printer}
   StretchDiBits(Printer.Canvas.Handle,
     BorderWidth, BorderWidth,
     Round(scaleX)-BorderWidth, Round(scaleY)-BorderWidth,
     0, 0,
     AForm.Width, AForm.Height,
     pBits,
     PBitmapInfo(pDibHeader)^,
     DIB_RGB_COLORS,
     SRCCOPY);

   RotateBitmap(var hDIB: HGlobal; 180; clWhite);

   {Just incase you printer drver is a palette device}
   if isDcPalDevice = True then
   begin
     SelectPalette(Printer.Canvas.Handle, oldPal, False);
     DeleteObject(Pal);
   end;


   {Clean up allocated memory}
   GlobalUnlock(hBits);
   GlobalFree(hBits);
   GlobalUnlock(hDibHeader);
   GlobalFree(hDibHeader);


   {End the print job}
   Printer.EndDoc;
 end;

Это код на языке Delphi для печати формы без рамок и заголовков. Он использует метод GetFormImage для получения битмапа формы, а затем рисует его на HDC принтера.

Вторая часть кода предлагает альтернативный способ печати формы, получая устройственно-независимые биты в 256 цветах из формы, используя эти биты для печати формы на принтере. Код также проверяет, является ли экран или принтер устройством палетки и обрабатывает управление палиткой соответственно.

Некоторые ключевые моменты этого кода:

• Процедура PrintForm принимает два параметра: AForm, который является формой для печати, и BorderWidth, который specifies the width of the border around the form.
• Код создает памятный DC, выбирает его в текущий DC, а затем копирует содержимое формы на памятный DC с помощью BitBlt.
• Затем код конвертирует памятный DC в устройственно-независимый битмап (DIB) с помощью GetDIBits. Этот DIB используется для печати формы.
• Код проверяет, является ли драйвер принтера устройством палетки и обрабатывает управление палиткой соответственно.
• Функция StretchDiBits используется для растяжения DIB на канвас принтера, учитывая ширину рамки.

Пример использования этой процедуры:

procedure TForm1.Button1Click(Sender: TObject);
begin
  PrintForm(Form1, 0); // Печатает Form1 без рамки
end;

Замечание: код может потребовать некоторых модификаций для корректной работы в вашей конкретной ситуации. Кроме того, печать формы может быть медленной операцией, особенно если форма содержит много контролов или имеет большой размер.

В целом, этот код предоставляет хороший стартовый пункт для печати форм без рамок и заголовков в Delphi.

В статье описывается код на Delphi, который позволяет печатать форму с помощью метода GetFormImage.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Принтеры и Печать ::