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 } interfaceuses 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 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; 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.
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
}
interfaceuses
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
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;
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.
程序始终提示 EZTWAIN.dll。为无效的window映像,