[aqula]

Нашел в нете модуль который сохраняет bmp в pdf

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
 Bm:TBitmap;
 hWinDC:THandle;
begin
  Bm:=TBitmap.Create;
  Bm.Width:=Self.Width;
  Bm.Height:=Self.Height;
  hWinDC:=GetWindowDC(Self.Handle);
  BitBlt(Bm.Canvas.Handle,0,0,Bm.Width, Bm.Height, hWinDC,0,0,SRCCOPY);
  ReleaseDC(Self.Handle,hWinDC);
  if SaveDialog1.Execute then
    bmp2pdf.BMPtoPDF(Bm,SaveDialog1.FileName);
  Bm.Free;

Но в маленьком ноуте форма вся не влезает. появляется скроллинг. И печатает урезанную форму. Как сделать чтоб вся форма влезала в файл (без скроллбара)?

[icWasya]

а если вместо этого

Код:

hWinDC:=GetWindowDC(Self.Handle);   
BitBlt(Bm.Canvas.Handle,0,0,Bm.Width, Bm.Height, hWinDC,0,0,SRCCOPY); 

использовать

Код:

Self.PaintTo(Bm.Canvas,0,0);

[aqula]

Скроллы не печатаются это плюс, но саму форму как и прежде не расстягивает на полную... как видит так и печатает.

[aqula]

проблему решил

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
 Bm:TBitmap;
 hWinDC:THandle;
 w,h:Integer;
begin
  w:=Self.Width;
  h:=Self.Height;
  //Self.Left:=0;
  //Self.Top:=0;
  Self.Width:=1285;
  Self.Height:=935;
  Bm:=TBitmap.Create;
  Bm.Width:=Self.Width-5;
  Bm.Height:=Self.Height-30;

//  hWinDC:=GetWindowDC(Self.Handle);
//  hWinDC:=GetDC(Self.Handle);
//  BitBlt(Bm.Canvas.Handle,0,0,Bm.Width, Bm.Height, hWinDC,0,0,SRCCOPY);
  Self.PaintTo(Bm.Canvas,0,0);
  ReleaseDC(Self.Handle,hWinDC);
  Self.Width:=w;
  Self.Height:=h;
  if SaveDialog1.Execute then
    bmp2pdf.BMPtoPDF(Bm,SaveDialog1.FileName);
  Bm.Free;

Спасибо Васе.

[aqula]

Тему продолжу. Помогите пожалуйста.
Теперь мне нужно этот битмап вывести на принтер. Картинка создается но на принтер не вылазит - печатает пустую. Вот код:

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  Bm:TBitmap;
  X1,X2,Y1,Y2,w,h:Integer;
  PrintDlg:TPrintDialog;
  hWinDC:THandle;
  Image1: TImage;
begin

  Image1:=TImage.Create(self);

  w:=Self.Width;
  h:=Self.Height;
  Self.Width:=1285;   // чтоб все элементы поместились на страницу независимо от разрешения экрана.
  Self.Height:=935;

  Bm:=TBitmap.Create;
  Bm.Width:=Self.Width-5;
  Bm.Height:=Self.Height-30;

  //hWinDC:=GetWindowDC(Self.Handle);
  hWinDC:=GetDC(Self.Handle);
  //BitBlt(Bm.Canvas.Handle,0,0,Bm.Width, Bm.Height, hWinDC,0,0,SRCCOPY);
  Self.PaintTo(Bm.Canvas,0,0);
  ReleaseDC(Self.Handle,hWinDC);
  Self.Width:=w;
  Self.Height:=h;


   // Clipboard.Assign(Bm);
    Image1.Picture.Bitmap.Assign(Bm);
    Clipboard.Assign(Image1.Picture);  /// картинка в буфере есть!!!
	// значит до этого все ОК, но потом....

// Создаю и отображаю на экране стандартное окно печати
  PrintDlg:=TPrintDialog.Create(Self);

  if PrintDlg.Execute then
  begin
  // Начинаю новый документ
  Printer.Orientation:=poLandScape; // делаю книжную ориентацию
  Printer.BeginDoc;
  Printer.Canvas.Refresh;

  //Рассчитываю размеры изображения
  X1:=0;
  Y1:=0;
  X2:=round(Printer.PageWidth);
  Y2:=round(Printer.PageHeight);
 
 //Вывод изображения на печать

  // сначала пробовал так
  with  Image1.Picture do
  	 Printer.Canvas.CopyRect(Rect(X1,Y1,X2,Y2),Bitmap.Canvas,Rect(0,0,Width,Height));
  // потом так c bitmap
  //Printer.Canvas.CopyRect(Rect(X1,Y1,X2,Y2),Bm.Canvas,Rect(0,0,Bm.Width,Bm.Height));
  // думал может надо с StretchDraw
  //Printer.Canvas.StretchDraw(Rect(X1,Y1,X2,Y2), Image1.Picture.Graphic);
  // но все равно печатает пустую страницу

  Printer.EndDoc;
  end;
  //Уничтожаю созданное окно печати
  Bm.Free;
  PrintDlg.Free;
end;

[Alegun]

Как распечатать битмап, пример из DRKB

Код:

procedure StretchPrint(R: TRect; ABitmap: Graphics.TBitmap);
var
dc: HDC;
isDcPalDevice: Bool;
hDibHeader: THandle;
pDibHeader: pointer;
hBits: THandle;
pBits: pointer;
ppal: PLOGPALETTE;
pal: hPalette;
Oldpal: hPalette;
i: integer;
begin
pal := 0;
OldPal := 0;

{Get the screen dc}
dc := GetDc(0);

{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 := ABitmap.width;
PBITMAPINFOHEADER(pDibHeader)^.biHeight := ABitmap.height;
PBITMAPINFOHEADER(pDibHeader)^.biCompression := BI_RGB;

{find out how much memory for the bits}
GetDIBits(dc, ABitmap.Handle, 0, ABitmap.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, ABitmap.Handle, 0, ABitmap.height, pBits, PBitmapInfo(pDibHeader)^,  DIB_RGB_COLORS);

{Release the screen dc}
ReleaseDc(0, dc);

{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, R.Left, R.Top, R.Right - R.Left,
   R.Bottom - R.Top, 0, 0, ABitmap.Width, ABitmap.Height, pBits,
   PBitmapInfo(pDibHeader)^, DIB_RGB_COLORS, SRCCOPY);

{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;