home *** CD-ROM | disk | FTP | other *** search
/ Computerworld 1996 March / Computerworld_1996-03_cd.bin / idg_cd3 / aplikace / office / ccopier1 / source / scmain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-14  |  7.0 KB  |  244 lines
  1. unit Scmain;
  2. {
  3.  Copier-Utility: CompuCopier
  4.  This program demonstrate the use of the eztwain.dll (eztwain.pas).
  5.  If you have a flatbed scanner and a graphics printer, you can use
  6.  'Compu-Copier' to make copies of a sheet of paper in a easy way.
  7.  
  8.  known bugs:
  9.  - colored copies are not possible, because of a bug in eztwain.dll
  10. }
  11. interface
  12.  
  13. uses
  14.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  15.   Forms, Dialogs, StdCtrls, EzTwain, Printers, ExtCtrls, Spin,
  16.   Menus, Scoptio, Scabout;
  17.  
  18. type
  19.   TForm1 = class(TForm)
  20.     Button1: TButton;
  21.     PrinterSetupDialog1: TPrinterSetupDialog;
  22.     SpinEdit1: TSpinEdit;
  23.     Label1: TLabel;
  24.     MainMenu1: TMainMenu;
  25.     MFile: TMenuItem;
  26.     MPrintersettings: TMenuItem;
  27.     MClose: TMenuItem;
  28.     Label2: TLabel;
  29.     SpinEdit2: TSpinEdit;
  30.     MScannersettings: TMenuItem;
  31.     Button2: TButton;
  32.     Label3: TLabel;
  33.     MOptions: TMenuItem;
  34.     About1: TMenuItem;
  35.     procedure Button1Click(Sender: TObject);
  36.     procedure FormCreate(Sender: TObject);
  37.     procedure MPrintersettingsClick(Sender: TObject);
  38.     procedure MCloseClick(Sender: TObject);
  39.     procedure MScannersettingsClick(Sender: TObject);
  40.     procedure Button2Click(Sender: TObject);
  41.     procedure MOptionsClick(Sender: TObject);
  42.     procedure About1Click(Sender: TObject);
  43.   private
  44.     { Private-Deklarationen }
  45.     procedure UpDateInfo;
  46.   public
  47.     { Public-Deklarationen }
  48.   end;
  49.  
  50. var
  51.   Form1: TForm1;
  52.  
  53. implementation
  54.  
  55. {$R *.DFM}
  56.  
  57. function DibNumColors(pv: pointer): word;
  58. {given a pointer to a locked DIB, return the number of palette entries: 0,2,16, or 256}
  59. var
  60.     Bits: integer;
  61.     lpbi: PBITMAPINFOHEADER;
  62.     lpbc: PBITMAPCOREHEADER;
  63. begin
  64.     lpbi := PBITMAPINFOHEADER(pv);
  65.     lpbc := PBITMAPCOREHEADER(pv);
  66.     {
  67.     /*    With the BITMAPINFO format headers, the size of the palette
  68.      *    is in biClrUsed, whereas in the BITMAPCORE - style headers, it
  69.      *    is dependent on the bits per pixel ( = 2 raised to the power of
  70.      *    bits/pixel).
  71.      */
  72.     }
  73.     if (lpbi^.biSize <> sizeof(TBITMAPCOREHEADER)) then
  74.     begin
  75.         if (lpbi^.biClrUsed <> 0) then
  76.             Result := WORD(lpbi^.biClrUsed);
  77.         Bits := lpbi^.biBitCount;
  78.     end
  79.     else
  80.     begin
  81.         Bits := lpbc^.bcBitCount;
  82.     end;
  83.     Result := (1 shl Bits) and $01ff; {up to 8 bits, 2 ^ Bits - otherwise, 0.}
  84. end;
  85.  
  86. function LPBits(lpdib: PBITMAPINFOHEADER): pointer;
  87. { Given a pointer to a locked DIB, return a pointer to the actual bits (pixels) }
  88. var
  89.     dwColorTableSize: longint;
  90. begin
  91.     dwColorTableSize := longint( (DibNumColors(lpdib) * sizeof(TRGBQUAD)));
  92.     lpBits := pointer( longint(lpdib) + lpdib^.biSize + dwColorTableSize);
  93. end;
  94.  
  95. procedure PrintDIB(PrinterHandle: HDC; BHandle: HBitmap; UserScaleX, UserScaleY: Single; Center: TCenterState);
  96.  function GetDibResX(Info: PBitmapInfoHeader): Single;
  97.  begin {DIB-resolution in dpi}
  98.     Result:=Info^.biXPelsPerMeter*25.4/1000; {Resolution in dpi}
  99.  end;
  100.  function GetDibResY(Info: PBitmapInfoHeader): Single;
  101.  begin
  102.     Result:=Info^.biYPelsPerMeter*25.4/1000; {Resolution in dpi}
  103.  end;
  104.  function GetPrnResX( h: HDC ): Single;
  105.  begin {Printerresolution in dpi}
  106.    Result:=GetDeviceCaps(h, logPixelsX);
  107.  end;
  108.  function GetPrnResY( h: HDC ): Single;
  109.  begin {Printerresolution in dpi}
  110.    Result:=GetDeviceCaps(h, logPixelsY);
  111.  end;
  112.  var
  113.     Info: PBitmapInfoHeader;
  114.     i: integer;
  115.     x,y,w,h: longint;
  116.     Offset, PageSize: TPoint;
  117.     ScaleX, ScaleY: Single;
  118. begin
  119.   Info:=GlobalLock(BHandle);
  120.   if ( Info<>nil ) then begin
  121.         { calculate ratio of printer/dip resolution }
  122.         ScaleX:=GetPrnResX(PrinterHandle) / GetDibResX(Info);
  123.         ScaleY:=GetPrnResY(PrinterHandle) / GetDibResY(Info);
  124.         { consider user scale}
  125.         ScaleX:=UserScaleX*ScaleX;
  126.         ScaleY:=UserScaleY*ScaleY;
  127.         { get paper offset }
  128.         if Escape(PrinterHandle, GETPRINTINGOFFSET, 0, NIL, @Offset)<=0 then
  129.            Offset:=point(0,0);
  130.         { center the destination bitmap }
  131.         PageSize:=point(GetDeviceCaps(PrinterHandle, HORZRES), GetDeviceCaps(PrinterHandle, VERTRES));
  132.         w:=round(Info^.biWidth*ScaleX);
  133.         h:=round(Info^.biHeight*ScaleY);
  134.         case Center of
  135.              tctNone: begin
  136.                       X:=0; Y:=0;
  137.                       end;
  138.              tctTopCenter: begin
  139.                            X:=(PageSize.X-w) div 2;
  140.                            Y:=0;
  141.                            end;
  142.              tctCenter: begin
  143.                            X:=(PageSize.X-w) div 2;
  144.                            Y:=(PageSize.Y-h) div 2;
  145.                         end;
  146.              tctBottomCenter: begin
  147.                            X:=(PageSize.X-w) div 2;
  148.                            Y:=(PageSize.Y-h);
  149.                         end;
  150.              else     begin
  151.                       X:=0; Y:=0;
  152.                       end;
  153.         end;
  154.         { draw it on printer canvas }
  155.         i:=StretchDIBits( PrinterHandle,
  156.                           X-Offset.X, Y-Offset.Y, w, h,
  157.                           0, 0, Info^.biWidth, Info^.biHeight,
  158.                           LPBits(Info), PBitmapinfo(Info)^,
  159.                           DIB_RGB_COLORS, SRCCOPY);
  160.   end;
  161.   GlobalUnlock(BHandle);
  162. end;
  163.  
  164. procedure TForm1.Button1Click(Sender: TObject);
  165. var i, Max : integer;
  166.     Hbmp   : HBitmap;
  167. begin
  168.  Button1.Enabled:=False;
  169.  try
  170.     Hbmp:=TWAIN_AcquireNative(Handle, TWAIN_ANYTYPE); { get bitmap }
  171.     if Hbmp<>0 then
  172.     begin
  173.      with Printer do begin
  174.          BeginDoc;
  175.          Max:=SpinEdit2.Value;                        { number of copies }
  176.          if Escape(Canvas.Handle, SETCOPYCOUNT, sizeof(Max), @Max, @i)=1 then
  177.             Max:=1;
  178.        try
  179.         for i:=1 to Max do
  180.           PrintDIB( Canvas.Handle, Hbmp,
  181.                     SpinEdit1.Value/100, SpinEdit1.Value/100, { user zoom }
  182.                     PaperSettings.GetCenterState );
  183.        finally;
  184.          EndDoc;
  185.        end;
  186.      end;
  187.     end;
  188.  finally
  189.   if Hbmp<>0 then
  190.   begin
  191.     TWAIN_FreeNative(Hbmp);
  192.   end;
  193.  end;
  194.  Button1.Enabled:=True;
  195. end;
  196.  
  197. procedure TForm1.FormCreate(Sender: TObject);
  198. begin
  199.     UpDateInfo;
  200. end;
  201.  
  202. procedure TForm1.MPrintersettingsClick(Sender: TObject);
  203. begin
  204.      PrinterSetupDialog1.Execute;
  205.      UpDateInfo;
  206. end;
  207.  
  208. procedure TForm1.MCloseClick(Sender: TObject);
  209. begin
  210.      Close;
  211. end;
  212.  
  213. procedure TForm1.MScannersettingsClick(Sender: TObject);
  214. begin
  215.   TWAIN_SelectImageSource(Handle);
  216.   UpDateInfo;
  217. end;
  218.  
  219. procedure TForm1.Button2Click(Sender: TObject);
  220. var
  221.     Hbmp: HBitmap;
  222. begin
  223.     Hbmp:=TWAIN_AcquireNative(Handle, TWAIN_ANYTYPE);
  224.     TWAIN_WriteNativeToFilename(Hbmp, 'Test.bmp' );
  225.     TWAIN_FreeNative(Hbmp);
  226. end;
  227.  
  228. procedure TForm1.UpDateInfo;
  229. begin
  230.      Label3.Caption:='Printer: '+Printer.Printers.Strings[Printer.PrinterIndex];
  231. end;
  232.  
  233. procedure TForm1.MOptionsClick(Sender: TObject);
  234. begin
  235.     PaperSettings.ShowModal;
  236. end;
  237.  
  238. procedure TForm1.About1Click(Sender: TObject);
  239. begin
  240.     AboutBox.ShowModal;
  241. end;
  242.  
  243. end.
  244.