Пересылка точечного рисунка с экрана на принтер - недопустимая операция, которая потерпит неудачу, если драйвер печати не предназначен, чтобы обнаружить ошибку.
Это означает, что Вы должны использовать методы рисования Canvas такие, как StretchDraw, CopyRect, BrushCopy и т.д. для передачи точечного рисунка принтеру.
Единственный способ напечатать изображение состоит в том, чтобы использованть DIB. Получение правильного DIB может быть затруднено, но есть много функций API Windows, которые будут использоваться.
Следующий пример демонстрирует попытку преодолеть некоторые из этих проблем и ограничений. Пример должен работать правильно под всеми версиями Delphi/C++Builder .
Основная функция в примере - BltTBitmapAsDib(), которая получает дескриптор устройства для отображения и координаты X и Y, а также ширина и высота изображения.
Пример:
uses Printers;
type
PPalEntriesArray = ^TPalEntriesArray; {for palette re-construction}
TPalEntriesArray = array[0..0] of TPaletteEntry;
procedure BltTBitmapAsDib(DestDc : hdc; {Handle of where to blt}
x : word; {Bit at x}
y : word; {Blt at y}
Width : word; {Width to stretch}
Height : word; {Height to stretch}
bm : TBitmap); {the TBitmap to Blt}
var
OriginalWidth :LongInt; {width of BM}
dc : hdc; {screen dc}
IsPaletteDevice : bool; {if the device uses palettes}
IsDestPaletteDevice : bool; {if the device uses palettes}
BitmapInfoSize : integer; {sizeof the bitmapinfoheader}
lpBitmapInfo : PBitmapInfo; {the bitmap info header}
hBm : hBitmap; {handle to the bitmap}
hPal : hPalette; {handle to the palette}
OldPal : hPalette; {temp palette}
hBits : THandle; {handle to the DIB bits}
pBits : pointer; {pointer to the DIB bits}
lPPalEntriesArray : PPalEntriesArray; {palette entry array}
NumPalEntries : integer; {number of palette entries}
i : integer; {looping variable}
begin
{$IFOPT R+}
{$DEFINE CKRANGE}
{$R-}
{$ENDIF}
{Сохраним оригинальную ширину точечного рисунка}
OriginalWidth := bm.Width;
{Получить DC экрана, так как DC в памяти ненадежен}
dc := GetDc(0);
{Палитра устройства?}
IsPaletteDevice :=
GetDeviceCaps(dc, RASTERCAPS) and RC_PALETTE = RC_PALETTE;
{Вернуть DC экрана}
dc := ReleaseDc(0, dc);
{Распределить BitmapInfo}
if IsPaletteDevice then
BitmapInfoSize := sizeof(TBitmapInfo) + (sizeof(TRGBQUAD) * 255)
else
BitmapInfoSize := sizeof(TBitmapInfo);
GetMem(lpBitmapInfo, BitmapInfoSize);
{Заполнить нулями BitmapInfo}
FillChar(lpBitmapInfo^, BitmapInfoSize, #0);
{Заполнить BitmapInfo}
lpBitmapInfo^.bmiHeader.biSize := sizeof(TBitmapInfoHeader);
lpBitmapInfo^.bmiHeader.biWidth := OriginalWidth;
lpBitmapInfo^.bmiHeader.biHeight := bm.Height;
lpBitmapInfo^.bmiHeader.biPlanes := 1;
if IsPaletteDevice then
lpBitmapInfo^.bmiHeader.biBitCount := 8
else
lpBitmapInfo^.bmiHeader.biBitCount := 24;
lpBitmapInfo^.bmiHeader.biCompression := BI_RGB;
lpBitmapInfo^.bmiHeader.biSizeImage :=
((lpBitmapInfo^.bmiHeader.biWidth *
longint(lpBitmapInfo^.bmiHeader.biBitCount)) div 8) *
lpBitmapInfo^.bmiHeader.biHeight;
lpBitmapInfo^.bmiHeader.biXPelsPerMeter := 0;
lpBitmapInfo^.bmiHeader.biYPelsPerMeter := 0;
if IsPaletteDevice then begin
lpBitmapInfo^.bmiHeader.biClrUsed := 256;
lpBitmapInfo^.bmiHeader.biClrImportant := 256;
end else begin
lpBitmapInfo^.bmiHeader.biClrUsed := 0;
lpBitmapInfo^.bmiHeader.biClrImportant := 0;
end;
{Получить дескриптор точечного рисунка и палитры}
hBm := bm.ReleaseHandle;
hPal := bm.ReleasePalette;
Источник: delphi3000.com
|