home *** CD-ROM | disk | FTP | other *** search
- unit Scmain;
- {
- Copier-Utility: CompuCopier
- This program demonstrate the use of the eztwain.dll (eztwain.pas).
- If you have a flatbed scanner and a graphics printer, you can use
- 'Compu-Copier' to make copies of a sheet of paper in a easy way.
-
- known bugs:
- - colored copies are not possible, because of a bug in eztwain.dll
- }
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs, StdCtrls, EzTwain, Printers, ExtCtrls, Spin,
- Menus, Scoptio, Scabout;
-
- type
- TForm1 = class(TForm)
- Button1: TButton;
- PrinterSetupDialog1: TPrinterSetupDialog;
- SpinEdit1: TSpinEdit;
- Label1: TLabel;
- MainMenu1: TMainMenu;
- MFile: TMenuItem;
- MPrintersettings: TMenuItem;
- MClose: TMenuItem;
- Label2: TLabel;
- SpinEdit2: TSpinEdit;
- MScannersettings: TMenuItem;
- Button2: TButton;
- Label3: TLabel;
- MOptions: TMenuItem;
- About1: TMenuItem;
- procedure Button1Click(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure MPrintersettingsClick(Sender: TObject);
- procedure MCloseClick(Sender: TObject);
- procedure MScannersettingsClick(Sender: TObject);
- procedure Button2Click(Sender: TObject);
- procedure MOptionsClick(Sender: TObject);
- procedure About1Click(Sender: TObject);
- private
- { Private-Deklarationen }
- procedure UpDateInfo;
- public
- { Public-Deklarationen }
- end;
-
- var
- Form1: TForm1;
-
- implementation
-
- {$R *.DFM}
-
- function DibNumColors(pv: pointer): word;
- {given a pointer to a locked DIB, return the number of palette entries: 0,2,16, or 256}
- var
- Bits: integer;
- lpbi: PBITMAPINFOHEADER;
- lpbc: PBITMAPCOREHEADER;
- begin
- lpbi := PBITMAPINFOHEADER(pv);
- lpbc := PBITMAPCOREHEADER(pv);
- {
- /* With the BITMAPINFO format headers, the size of the palette
- * is in biClrUsed, whereas in the BITMAPCORE - style headers, it
- * is dependent on the bits per pixel ( = 2 raised to the power of
- * bits/pixel).
- */
- }
- if (lpbi^.biSize <> sizeof(TBITMAPCOREHEADER)) then
- begin
- if (lpbi^.biClrUsed <> 0) then
- Result := WORD(lpbi^.biClrUsed);
- Bits := lpbi^.biBitCount;
- end
- else
- begin
- Bits := lpbc^.bcBitCount;
- end;
- Result := (1 shl Bits) and $01ff; {up to 8 bits, 2 ^ Bits - otherwise, 0.}
- end;
-
- function LPBits(lpdib: PBITMAPINFOHEADER): pointer;
- { Given a pointer to a locked DIB, return a pointer to the actual bits (pixels) }
- var
- dwColorTableSize: longint;
- begin
- dwColorTableSize := longint( (DibNumColors(lpdib) * sizeof(TRGBQUAD)));
- lpBits := pointer( longint(lpdib) + lpdib^.biSize + dwColorTableSize);
- end;
-
- procedure PrintDIB(PrinterHandle: HDC; BHandle: HBitmap; UserScaleX, UserScaleY: Single; Center: TCenterState);
- function GetDibResX(Info: PBitmapInfoHeader): Single;
- begin {DIB-resolution in dpi}
- Result:=Info^.biXPelsPerMeter*25.4/1000; {Resolution in dpi}
- end;
- function GetDibResY(Info: PBitmapInfoHeader): Single;
- begin
- Result:=Info^.biYPelsPerMeter*25.4/1000; {Resolution in dpi}
- end;
- function GetPrnResX( h: HDC ): Single;
- begin {Printerresolution in dpi}
- Result:=GetDeviceCaps(h, logPixelsX);
- end;
- function GetPrnResY( h: HDC ): Single;
- begin {Printerresolution in dpi}
- Result:=GetDeviceCaps(h, logPixelsY);
- end;
- var
- Info: PBitmapInfoHeader;
- i: integer;
- x,y,w,h: longint;
- Offset, PageSize: TPoint;
- ScaleX, ScaleY: Single;
- begin
- Info:=GlobalLock(BHandle);
- if ( Info<>nil ) then begin
- { calculate ratio of printer/dip resolution }
- ScaleX:=GetPrnResX(PrinterHandle) / GetDibResX(Info);
- ScaleY:=GetPrnResY(PrinterHandle) / GetDibResY(Info);
- { consider user scale}
- ScaleX:=UserScaleX*ScaleX;
- ScaleY:=UserScaleY*ScaleY;
- { get paper offset }
- if Escape(PrinterHandle, GETPRINTINGOFFSET, 0, NIL, @Offset)<=0 then
- Offset:=point(0,0);
- { center the destination bitmap }
- PageSize:=point(GetDeviceCaps(PrinterHandle, HORZRES), GetDeviceCaps(PrinterHandle, VERTRES));
- w:=round(Info^.biWidth*ScaleX);
- h:=round(Info^.biHeight*ScaleY);
- case Center of
- tctNone: begin
- X:=0; Y:=0;
- end;
- tctTopCenter: begin
- X:=(PageSize.X-w) div 2;
- Y:=0;
- end;
- tctCenter: begin
- X:=(PageSize.X-w) div 2;
- Y:=(PageSize.Y-h) div 2;
- end;
- tctBottomCenter: begin
- X:=(PageSize.X-w) div 2;
- Y:=(PageSize.Y-h);
- end;
- else begin
- X:=0; Y:=0;
- end;
- end;
- { draw it on printer canvas }
- i:=StretchDIBits( PrinterHandle,
- X-Offset.X, Y-Offset.Y, w, h,
- 0, 0, Info^.biWidth, Info^.biHeight,
- LPBits(Info), PBitmapinfo(Info)^,
- DIB_RGB_COLORS, SRCCOPY);
- end;
- GlobalUnlock(BHandle);
- end;
-
- procedure TForm1.Button1Click(Sender: TObject);
- var i, Max : integer;
- Hbmp : HBitmap;
- begin
- Button1.Enabled:=False;
- try
- Hbmp:=TWAIN_AcquireNative(Handle, TWAIN_ANYTYPE); { get bitmap }
- if Hbmp<>0 then
- begin
- with Printer do begin
- BeginDoc;
- Max:=SpinEdit2.Value; { number of copies }
- if Escape(Canvas.Handle, SETCOPYCOUNT, sizeof(Max), @Max, @i)=1 then
- Max:=1;
- try
- for i:=1 to Max do
- PrintDIB( Canvas.Handle, Hbmp,
- SpinEdit1.Value/100, SpinEdit1.Value/100, { user zoom }
- PaperSettings.GetCenterState );
- finally;
- EndDoc;
- end;
- end;
- end;
- finally
- if Hbmp<>0 then
- begin
- TWAIN_FreeNative(Hbmp);
- end;
- end;
- Button1.Enabled:=True;
- end;
-
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- UpDateInfo;
- end;
-
- procedure TForm1.MPrintersettingsClick(Sender: TObject);
- begin
- PrinterSetupDialog1.Execute;
- UpDateInfo;
- end;
-
- procedure TForm1.MCloseClick(Sender: TObject);
- begin
- Close;
- end;
-
- procedure TForm1.MScannersettingsClick(Sender: TObject);
- begin
- TWAIN_SelectImageSource(Handle);
- UpDateInfo;
- end;
-
- procedure TForm1.Button2Click(Sender: TObject);
- var
- Hbmp: HBitmap;
- begin
- Hbmp:=TWAIN_AcquireNative(Handle, TWAIN_ANYTYPE);
- TWAIN_WriteNativeToFilename(Hbmp, 'Test.bmp' );
- TWAIN_FreeNative(Hbmp);
- end;
-
- procedure TForm1.UpDateInfo;
- begin
- Label3.Caption:='Printer: '+Printer.Printers.Strings[Printer.PrinterIndex];
- end;
-
- procedure TForm1.MOptionsClick(Sender: TObject);
- begin
- PaperSettings.ShowModal;
- end;
-
- procedure TForm1.About1Click(Sender: TObject);
- begin
- AboutBox.ShowModal;
- end;
-
- end.
-