Печать Image

[Наталья]

Помогите кто знает как можно напечатать рисунок из Image  программно. Т.е. кликнула печать и он печатает.
Пробовала через:

Printer.BeginDoc;
with Image1.Picture.BitMap do
Printer.Canvas.CopyRect(Rect(0,0,Height,Width),
                              Canvas,Rect(0,0,Height,Width));
Print.EndDoc;

Рисунок получается очень маленьким и ориентацию тоже не получается установить.
Так же пыталась с помощью оператора ShellExecute
но опять таки ориентацию листа задать не удалось.
Помогите, с кодом желательно.

[x77]

для растягивания рисунка испольуйте Canvas.StretchDraw. с изменением ориентации - сложнее, либо через преобразования типа XForm (сам с ней не работал, так что код не привожу), либо программно "переворачивать" рисунок перед выводом, попиксельно.

[Наталья]

Мне не нужно растягивать рисунок, вернее нужно сохранить пропорции, сложность пожалуй оснавная в изменении ориентации листа. А как можно повернуть рисунок?

[x77]

Наталья, TPrinter.Orientation := poLanscape;, например.

[Наталья]

Это я пробовала но не сработало как раз этот код почему -то вызывает ошибку??

[x77]

какую ошибку? Printer.Orientation := poLandscape; надо вызывать до BeginDoc.

[Наталья]

Я сейчас сделала код такой,  печатает на весь лист но ориентация все равно книжная, а не альбомная  
Printer.Orientation:= poLandscape;
form2.Image2.Picture.SaveToFile('tempgraf.bmp');

ShellExecute(Handle, 'print', 'tempgraf.bmp',nil,nil,sw_show);
 

[Серж]

Наталья, ты задаешь ориентацию в одной программе, а печатаешь в другой.

[Серж]

Наталья, вот текст процедуры, которая работает в какой-то моей программе.

procedure PrintBitmap(ABitmap: TBitmap; Comment: string; UseComment: boolean);
var B: TBitmap;
    isPrnPal: Boolean;
    Pal, OldPal: hPalette;
    PageWidth, PageHeight: Integer;
    PageMargin: TPoint;
    TestInt: Integer;
    ImagePageWidth: Integer;
    ImagePageHeight: Integer;
    ScaleX, ScaleY, OffsetX, OffsetY: Integer;
    ImageSize, InfoSize: DWord;
    PImage, PInfo: Pointer;
    TextSize:TSize;
begin
   Pal := 0;
   OldPal := 0;
   Printer.BeginDoc;
   B := TBitmap.Create;
   B.Assign(ABitmap);
   B.PixelFormat := pf24bit;
   isPrnPal := False;
   if (GetDeviceCaps(Printer.Canvas.Handle, RasterCaps) and RC_Palette) =
RC_Palette then
      begin
         B.PixelFormat := pf8bit;
         Pal := CopyPalette(B.Palette);
         OldPal := SelectPalette(Printer.Canvas.Handle, Pal, False);
         isPrnPal := True;
      end;
   PageWidth := Integer(GetDeviceCaps(Printer.Canvas.Handle, HORZRES));
   PageHeight := Integer(GetDeviceCaps(Printer.Canvas.Handle, VERTRES));
   PageMargin.X := 0; PageMargin.Y := 0;
   TestInt := Integer(GetPrintingOffset);
   if Escape(Printer.Canvas.Handle, QUERYESCSUPPORT, SizeOf(TestInt),
@TestInt, nil) <> 0 then
      begin
         if Escape(Printer.Canvas.Handle, GETPRINTINGOFFSET, 0, nil,
@PageMargin) <= 0 then
            begin
               PageMargin.X := 0;
               PageMargin.Y := 0;
            end;
      end;
   ImagePageWidth := PageWidth-2*PageMargin.X;
   ImagePageHeight := PageHeight-2*PageMargin.Y;
   if ((ImagePageWidth <= ImagePageHeight) and (B.Width >= B.Height)) or
      ((ImagePageWidth > ImagePageHeight) and (B.Width < B.Height)) then
      begin
         ScaleX := ImagePageWidth;
         ScaleY := Trunc(B.Height*ImagePageWidth/B.Width);
         OffsetX := PageMargin.X;
         OffsetY := (PageHeight div 2) - (ScaleY div 2);
      end else
      begin
         ScaleY := ImagePageHeight;
         ScaleX := Trunc(B.Width*ImagePageHeight/B.Height);
         OffsetY := PageMargin.Y;
         OffsetX := (PageWidth div 2) - (ScaleX div 2);
      end;
   GetDIBSizes(B.Handle, InfoSize, ImageSize);
   GetMem(PImage, ImageSize);
   GetMem(PInfo, InfoSize);
   GetDIB(B.Handle, B.Palette, PInfo^, PImage^);
   StretchDIBits(Printer.Canvas.Handle, OffsetX, OffsetY, ScaleX, ScaleY,
                 0, 0, B.Width, B.Height, PImage, PBitmapInfo(PInfo)^,
                 DIB_RGB_COLORS, SRCCOPY);
   FreeMem(PImage); FreeMem(PInfo);
   if isPrnPal then
      begin
         SelectPalette(Printer.Canvas.Handle, OldPal, False);
         DeleteObject(Pal);
      end;

   if UseComment then
   Begin
    With Printer.Canvas do
    Begin
     Font.Name:='Arial';
     Font.Size:=8;
     TextSize:=TextExtent(Comment);
     if ShowLabel then
      TextOut(OffSetX+40,OffsetY+41,Comment)
     else
      TextOut(OffSetX,OffsetY+ScaleY,Comment);
    End;
   End;

   Printer.EndDoc;
end;

Возможно, в ней есть внешние ссылки, их выбрось, кроме того, она накладывает текст на рисунок, этот код тоже можно выбросить.

[x77]

Серж, разве твоя процедура печатает в альбомной ориентации?

[Серж]

x77, программа печатает в той ориентации, которая задается предварительными настройками принтера, я перед печатью могу вызвать диалог настройки. Можно вставить настройку ориентации и в программу, как ты писал.