preview.pas

为青岛一家公司做的条码打印管理

unit Preview;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Buttons,printers;

type
  TFrmPreview = class(TForm)
    Image1: TImage;
    BtnPrint: TBitBtn;
    BtnClose: TBitBtn;
    procedure FormShow(Sender: TObject);
    procedure BtnPrintClick(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure PrintPreview(var Bmp:TBitmap);
  end;

var
  FrmPreview: TFrmPreview;

implementation

{$R *.DFM}

uses mTm;

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;







{ TFrmPreview }

procedure TFrmPreview.PrintPreview(var Bmp:TBitmap);
var
  {x1,x2,y,Space:integer; }
  TopLeft,TopRight,BottomLeft,BottomRight:TPoint;
begin
  TopLeft.x:=10;
  TopLeft.y:=15;
  TopRight.x:=485;
  TopRight.y:=15;
  BottomLeft.x:=10;
  BottomLeft.y:=305;
  BottomRight.x:=485;
  BottomRight.y:=305;
  Bmp.Width:=664;
  Bmp.Height:=460;
  Bmp.Canvas.MoveTo(TopLeft.x,TopLeft.y);
  Bmp.Canvas.LineTo(TopRight.x,TopRight.y);
  Bmp.Canvas.LineTo(BottomRight.x,BottomRight.y);
  Bmp.Canvas.LineTo(BottomLeft.x,BottomLeft.y);
  Bmp.Canvas.LineTo(TopLeft.x,TopLeft.y);


  Bmp.Canvas.Rectangle(10,305,520,400);
  Bmp.Canvas.Rectangle(10,305,190,400);
  Bmp.Canvas.Rectangle(189,305,303,338);
  Bmp.Canvas.Rectangle(10,388,664,460);
  Bmp.Canvas.MoveTo(10,388+35);
  Bmp.Canvas.LineTo(669,388+35);

  Bmp.Canvas.MoveTo(10+109,388);
  Bmp.Canvas.LineTo(10+109,485);
  Bmp.Canvas.MoveTo(10+109+109,388);
  Bmp.Canvas.LineTo(10+109+109,485);
  Bmp.Canvas.MoveTo(10+109+109+109,388);
  Bmp.Canvas.LineTo(10+109+109+109,485);
  Bmp.Canvas.MoveTo(10+109+109+109+109,388);
  Bmp.Canvas.LineTo(10+109+109+109+109,485);
  Bmp.Canvas.MoveTo(10+109+109+109+109+109,388);