Советы по Delphi. Версия 1.4.3 от 1.1.2001

Озеров Валентин

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;

 {Освобождаем dc экрана}

 ReleaseDc(0, dc);

 {Удаляем

изображение}

 DeleteObject(MemBitmap);

 {Запускаем работу печати}

 Printer.BeginDoc;

 {Масштабируем размер печати}

 if Printer.PageWidth < Printer.PageHeight then begin

ScaleX := Printer.PageWidth;

ScaleY := Form1.Height * (Printer.PageWidth / Form1.Width);

 end else begin

ScaleX := Form1.Width * (Printer.PageHeight / Form1.Height);

ScaleY := Printer.PageHeight;

 end;

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

 isDcPalDevice := false;

 if GetDeviceCaps(Printer.Canvas.Handle, RASTERCAPS) and RC_PALETTE = RC_PALETTE then begin

{Создаем палитру для 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;

 {посылаем биты на принтер}

 StretchDiBits(Printer.Canvas.Handle, 0, 0, Round(scaleX), Round(scaleY), 0, 0, Form1.Width, Form1.Height, pBits, PBitmapInfo(pDibHeader)^, DIB_RGB_COLORS,SRCCOPY);

 {Просто используем

драйвер принтера для устройства палитры}

 if isDcPalDevice = true then begin

SelectPalette(Printer.Canvas.Handle, oldPal, false);

DeleteObject(Pal);

 end;

 {Очищаем распределенную память}

 GlobalUnlock(hBits);

 GlobalFree(hBits);

 GlobalUnlock(hDibHeader);

 GlobalFree(hDibHeader);

 {Заканчиваем работу печати}

 Printer.EndDoc;

end;

Как мне отправить на принтер чистый поток данных?

Nomadic советует:

Под Win16 Вы можете использовать функцию SpoolFile, или Passthrough escape, если принтер поддерживает последнее.

Под Win32 Вы можете использовать WritePrinter.

Ниже пример открытия принтера и записи чистого потока данных в принтер.

Учтите, что Вы должны передать корректное имя принтера, такое, как "HP LaserJet 5MP", чтобы функция сработала успешно.

Конечно, Вы можете включать в поток данных любые необходимые управляющие коды, которые могут потребоваться.

uses WinSpool;

procedure WriteRawStringToPrinter(PrinterName: String; S: String);

var

 Handle: THandle;

 N: DWORD;

 DocInfo1: TDocInfo1;

begin

 if not OpenPrinter(PChar(PrinterName), Handle, nil) then begin

ShowMessage('error ' + IntToStr(GetLastError));

Exit;

 end;

 with DocInfo1 do begin

pDocName := PChar('test doc');

pOutputFile := nil;

pDataType := 'RAW';

 end;

 StartDocPrinter(Handle, 1, @DocInfo1);

 StartPagePrinter(Handle);

 WritePrinter(Handle, PChar(S), Length(S), N);

 EndPagePrinter(Handle);

 EndDocPrinter(Handle);

 ClosePrinter(Handle);