TImage图象如何打印？（50分相送）

uses Printers;
1.将Image1直接输出至打印机
Printer.Canvas.Draw(x,y,Image1.Picture.Graphic);//x,y为位置
2..将Image1输出至打印机(比例的调整)
Printer.Canvas.StretchDraw(ARect, Image1.Picture.Graphic);
//ARect :TRect是一个区域
ARect:=Rect(Left,Top,Width,Height)

用下面的方法即可
  if PrintDialog1.Execute then
  begin
    Printer.BeginDoc;
    Printer.Canvas.Draw(0,0,Image1.Picture.Graphic);
    Printer.EndDoc;
  end;
不过这种方法使用的是打印机的分辨率，处理起来不太灵活，可以试试打印机Canvasr的StrethDraw
方法，方法声明为：
procedure StretchDraw(const Rect:TRect;Graphic:TGraphic);
其中RECT参数代表图形输出区域的大小，TRECT的类型声明为：
TRect=record
case Integer of
   0:(Left,Top,Right,Bottom:Integer);
   1:(TopLeft,BootomRight:TPoint);
end;
只要调整Rect的大小及在打印页面上位置就可达到满意的效果。

unit pas_tmprint;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,PathFile,StrProcess,Uconst, DB, DBTables,inifiles,printers;type
  Tfrm_tmprint = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Image1: TImage;
    Button1: TButton;
    Session1: TSession;
    QuTM: TQuery;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);  private
    { Private declarations }
  public
    { Public declarations }
      function pdw_makebarcode(str_tm:String):String;
      procedure AutoCreateAlias;   //建立别名      function GetCodeSymbol(Code:string):string;
      function GetBarCodeSymBol(BarCode:string):string;
      procedure DrawBarCode(var Bmp:TBitmap;BarCode:string);
  end;var
  frm_tmprint: Tfrm_tmprint;
  ary_bmp:array of Tbitmap;
implementation
  uses pas_gobal;
{$R *.dfm}
////图片打印类/////
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
  {If range checking is on - lets turn it off for now}
  {we will remember if range checking was on by defining}
  {a define called CKRANGE if range checking is on.}
  {We do this to access array members past the arrays}
  {defined index range without causing a range check}
  {error at runtime. To satisfy the compiler, we must}
  {also access the indexes with a variable. ie: if we}
  {have an array defined as a: array[0..0] of byte,}
  {and an integer i, we can now access a[3] by setting}
  {i := 3; and then accessing a[i] without error}
  {$IFOPT R+}
  {$DEFINE CKRANGE}
  {$R-}
  {$ENDIF}  {Save the original width of the bitmap}
  OriginalWidth := bm.Width;  {Get the screen's dc to use since memory dc's are not reliable}
  dc := GetDc(0);
  {Are we a palette device?}
  IsPaletteDevice :=
  GetDeviceCaps(dc, RASTERCAPS) and RC_PALETTE = RC_PALETTE;
  {Give back the screen dc}
  dc := ReleaseDc(0, dc);  {Allocate the BitmapInfo structure}
  if IsPaletteDevice then BitmapInfoSize := sizeof(TBitmapInfo) + (sizeof(TRGBQUAD) * 255)
  else BitmapInfoSize := sizeof(TBitmapInfo);
  GetMem(lpBitmapInfo, BitmapInfoSize);  {Zero out the BitmapInfo structure}
  FillChar(lpBitmapInfo^, BitmapInfoSize, #0);  {Fill in the BitmapInfo structure}
  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;  {Take ownership of the bitmap handle and palette}
  hBm := bm.ReleaseHandle;
  hPal := bm.ReleasePalette;  {Get the screen's dc to use since memory dc's are not reliable}
  dc := GetDc(0);  if IsPaletteDevice then begin
    {If we are using a palette, it must be}
    {selected into the dc during the conversion}
    OldPal := SelectPalette(dc, hPal, TRUE);
    {Realize the palette}
    RealizePalette(dc);
  end;
  {Tell GetDiBits to fill in the rest of the bitmap info structure}
  GetDiBits(dc,hBm,0,lpBitmapInfo^.bmiHeader.biHeight,nil,TBitmapInfo(lpBitmapInfo^),DIB_RGB_COLORS);  {Allocate memory for the Bits}
  hBits := GlobalAlloc(GMEM_MOVEABLE,
  lpBitmapInfo^.bmiHeader.biSizeImage);
  pBits := GlobalLock(hBits);
  {Get the bits}
  GetDiBits(dc,hBm,0,lpBitmapInfo^.bmiHeader.biHeight,pBits,TBitmapInfo(lpBitmapInfo^),DIB_RGB_COLORS);
  if IsPaletteDevice then begin
    {Lets fix up the color table for buggy video drivers}
    GetMem(lPPalEntriesArray, sizeof(TPaletteEntry) * 256);
    {$IFDEF VER100}
    NumPalEntries := GetPaletteEntries(hPal,0,256,lPPalEntriesArray^);
    {$ELSE}
    NumPalEntries := GetSystemPaletteEntries(dc,0,256,lPPalEntriesArray^);
    {$ENDIF}
    for i := 0 to (NumPalEntries - 1) do begin
      lpBitmapInfo^.bmiColors[i].rgbRed :=lPPalEntriesArray^[i].peRed;
      lpBitmapInfo^.bmiColors[i].rgbGreen :=lPPalEntriesArray^[i].peGreen;
      lpBitmapInfo^.bmiColors[i].rgbBlue :=lPPalEntriesArray^[i].peBlue;
    end;
    FreeMem(lPPalEntriesArray, sizeof(TPaletteEntry) * 256);
  end;
  if IsPaletteDevice then begin
    {Select the old palette back in}
    SelectPalette(dc, OldPal, TRUE);
    {Realize the old palette}
    RealizePalette(dc);
  end;  {Give back the screen dc}
  dc := ReleaseDc(0, dc);
  {Is the Dest dc a palette device?}
  IsDestPaletteDevice :=
  GetDeviceCaps(DestDc, RASTERCAPS) and RC_PALETTE = RC_PALETTE;  if IsPaletteDevice then begin
    {If we are using a palette, it must be}
    {selected into the dc during the conversion}
    OldPal := SelectPalette(DestDc, hPal, TRUE);
    {Realize the palette}
    RealizePalette(DestDc);
  end;  {Do the blt}
  StretchDiBits(DestDc,x,y,Width,Height,0,0,OriginalWidth,lpBitmapInfo^.bmiHeader.biHeight,
                pBits,lpBitmapInfo^,DIB_RGB_COLORS,SrcCopy);
  if IsDestPaletteDevice then begin
    {Select the old palette back in}
    SelectPalette(DestDc, OldPal, TRUE);
    {Realize the old palette}
    RealizePalette(DestDc);
  end;  {De-Allocate the Dib Bits}
  GlobalUnLock(hBits);
  GlobalFree(hBits);  {De-Allocate the BitmapInfo}
  FreeMem(lpBitmapInfo, BitmapInfoSize);  {Set the ownership of the bimap handles back to the bitmap}
  bm.Handle := hBm;
  bm.Palette := hPal;  {Turn range checking back on if it was on when we started}
  {$IFDEF CKRANGE}
  {$UNDEF CKRANGE}
  {$R+}
  {$ENDIF}
end;////图片打印类/////

procedure Tfrm_tmprint.AutoCreateAlias;    //建立别名
var
datapath:String;
begin
  if session1.IsAlias('bxtm') then
    begin
      exit;
    end
  else
   begin
    datapath:=pas_gobal.path+'\data';
    session1.AddStandardAlias('bxtm',datapath,'Paradox');
   end;
end;
function Tfrm_tmprint.pdw_makebarcode(str_tm:String):string;  //返回条码字符串
var
myconfig:tinifile ;
start:String;
flag:String;
vend:String;
begin
  pas_gobal.configfile:=pas_gobal.path+'\config.ini';
  myconfig:=tinifile.Create(pas_gobal.configfile);
  start:=myconfig.ReadString('TM','start','');
  flag:=myconfig.ReadString('TM','flag','');
  vend:=myconfig.ReadString('TM','vend','');
  result:=start+flag+str_tm+vend;
end;
function tfrm_tmprint.GetCodeSymbol(Code:string):String;  //编码转换
begin
  Result:='';
  QuTM.Active:=False;
  QuTM.Sql.Clear;
  QuTM.Sql.Add(SqlGetSign+Code+'''');
  QuTM.Active:=True;
  Result:=QuTM['TMCode'];
  QuTM.Active:=False;
end;
function tfrm_tmprint.GetBarCodeSymBol(barcode:string):string; //完所所有的字符编辑转换
var
  i:integer;
  Len:integer;
begin
  Result:='';
  Len:=Length(BarCode);
  for i:=1 to Len do begin
    Result:=Result+GetCodeSymbol(BarCode[i]);
  end;
end;
procedure tfrm_tmprint.DrawBarCode(var Bmp:TBitmap;BarCode:string);
var
  i,Len,x,j,k:integer;
  BarCodeSymbol:string;
begin
  BarCodeSymbol:=GetBarCodeSymbol(BarCode);
  Len:=Length(BarCodeSymbol);
  x:=1;  //原 x:=0
  k:=0;
  Bmp.Width:=256;    //原来的值256
  Bmp.Height:=55;    //原不的值是60
  Bmp.Canvas.Brush.Color:=clwhite;
  //Bmp.Canvas.Brush.Style:=bsSolid;
  Bmp.Canvas.FillRect(Rect(0,0,256,55));
  Bmp.Canvas.Font.size:=9;
// Bmp.Canvas.Font.Style:=[fsBold];
  Bmp.Canvas.MoveTo(0,0);
  for i:=1 to Len do begin
    j:=i mod 10;
    if j=0 then Inc(k);
    case BarCodeSymbol[i] of
      'A':begin
            Bmp.Canvas.MoveTo(x,0);
            Bmp.Canvas.LineTo(x,40);
            if x=0 then begin
              Bmp.Canvas.TextOut(5,40,'*');
            end else begin
              if j=0 then begin
                Bmp.Canvas.Textout(x,40,BarCode[k+1]);
              end;
            end;
            x:=x+1;
          end;
      'B':begin
            if j=0 then begin
              Bmp.Canvas.Textout(x,40,BarCode[k+1]);
            end;
            x:=x+1;
          end;
      'C':begin
            Bmp.Canvas.MoveTo(x,0);
            Bmp.Canvas.LineTo(x,40);
            Bmp.Canvas.MoveTo(x+1,0);
            Bmp.Canvas.LineTo(x+1,40);
            Bmp.Canvas.MoveTo(x+2,0);
            Bmp.Canvas.LineTo(x+2,40);
            if j=0 then begin
              Bmp.Canvas.Textout(x,40,BarCode[k+1]);
            end;
            x:=x+3;
          end;
      'D':begin
            if j=0 then begin
              Bmp.Canvas.Textout(x,40,BarCode[k+1]);
            end;
            x:=x+3 ;
          end;
    else
      Exit;
    end;
  end;
end;
procedure Tfrm_tmprint.FormShow(Sender: TObject);
var
i,len:integer;
barcode:String;
x,x1,y,y1,l,h,flag:integer;  //x 列，y 行,l长度,h高度
begin
AutoCreateAlias;
len:=pas_gobal.mytm.Count;
setlength(ary_bmp,len);
x:=30;
y:=20;
y1:=20;
l:=260;
h:=55;
x1:=390;
flag:=1;
for i:=0 to len-1 do
  begin
    ary_bmp[i]:=tbitmap.Create;
    barcode:=pdw_makebarcode(pas_gobal.mytm.Strings[i]);
    DrawBarCode(ary_bmp[i],barcode);
    if flag mod 2 =1 then
     begin
       image1.Canvas.StretchDraw(rect(x,y,x+l,y+h),ary_bmp[i]);
       y:=y+80;
     end
    else
     begin
       image1.Canvas.StretchDraw(rect(x1,y1,x1+l,y1+h),ary_bmp[i]);
       y1:=y1+80;
     end;
    flag:=flag+1;
  end;end;procedure Tfrm_tmprint.Button1Click(Sender: TObject);
var
i,len:integer;
barcode:String;
x,x1,y,y1,l,h,flag:integer;  //x 列，y 行,l长度,h高度
begin
flag:=1;
len:=pas_gobal.mytm.Count;
printer.Title:='条码打印';
printer.BeginDoc;
for i:=0 to len-1 do
  begin
    //ary_bmp[i]:=tbitmap.Create;
    //barcode:=pdw_makebarcode(pas_gobal.mytm.Strings[i]);
    //DrawBarCode(ary_bmp[i],barcode);
    if flag mod 2 =1 then
     begin
       BltTBitmapAsDib(Printer.Canvas.Handle,x*6,y*6,(x+l)*6,(y+h)*6,ary_bmp[i]);
       //BltTBitmapAsDib(Printer.Canvas.Handle,30*6,20*6,(270)*6,(90)*6,bmp);
       y:=y+80;
     end
    else
     begin
       BltTBitmapAsDib(Printer.Canvas.Handle,x1*6,y1*6,(x1+l)*6,(y1+h)*6,ary_bmp[i]);
       y1:=y1+80;
     end;
    flag:=flag+1;
  end;
printer.EndDoc;
end;procedure Tfrm_tmprint.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Session1.Active:=false;
  QuTM.Active:=false;
end;end.

上面代码是在image 上,生成条码,然后打印................................你必须要会算分辨率...要不你可以用快速报表来解决..

屏幕的分辨率一般是72或者96DPI,而打印机无论横向或者纵向都至少有300DPI,所以要按看到的尺寸打印出来就必须获得屏幕分辨率和打印机分辨率,两者相除得一个比例,然后按这个比例把图片输出到打印机就行了

大家有没有遇到打印机不支持StretchDraw方法的，打印出来是空白！

调试易

TImage图象如何打印？（50分相送）

解决方案 »