汉王扫描仪调用接口,delphi代码

请访问:www.horseb.org

www.horseb.net

作者主页

unit BaseScan;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, TWainH, extctrls, Clipbrd, Buttons, FileCtrl, ShellAPI;

const WM_SCANBASE = WM_USER + $101;

type
TClearBlankFunc = function(hBmp: THandle; topBeg,topEnd,bottomBeg,bottomEnd: Integer;
r: Single): Integer; stdcall;
TSaveDIBFunc = function(HWND, BmpHandel: THandle; FileName: PChar): Integer; stdcall;
TWInitialize = procedure(pIdentity: pTW_IDENTITY; hMainWnd: HWND;
nXFerType: TW_INT16; strFileName: Pchar; wMsgBase: WPARAM); stdcall;
//1:use memory tranfer
//2:file transfer
//3:native transfer
SetMessageLevel = procedure(Level: integer); stdcall;
TWOpenDSM = function: Bool; stdcall;
TWIsDSMOpen = function: Bool; stdcall;
TWIsDSOpen = function: Bool; stdcall;
TWSelectDS = function: Bool; stdcall;
CloseConnection = procedure(Bitmap: THANDLE); stdcall; //***
ProcessTWMessage = function(pMsg: PMsg; m_hWnd: Thandle): Bool; stdcall;
TWAcquire = function(hWnd: THandle; ShowUI: BOOL; Flag: TW_INT16): Bool; stdcall;
ResetID = procedure; stdcall;
TWCloseDSM = function(Bitmap: THANDLE): Bool; stdcall; //***

TBaseScanForm = class(TForm)
ScanBtn: TButton;
SelectDvcBtn: TButton;
NewScanBtn: TButton;
AddScanBtn: TButton;
CheckBlank: TCheckBox;
Label1: TLabel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ScanBtnClick(Sender: TObject);
procedure SelectDvcBtnClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure AddScanBtnClick(Sender: TObject);
procedure NewScanBtnClick(Sender: TObject);
private
{ Private declarations }
TifCount: Integer;
AppIdentity: TW_IDENTITY;
ConvertHandle: THandle;
Dllhandle, ClearBlankHandle: Thandle;
PTWAcquire, PTWIsDSMOpen, PTWIsDSOpen, PProcessTWMessage:TFarProc;//TFarProc=pointer-----Windows
PTWOpenDSM, PTWSelectDS, PTWCloseDSM, PResetID:TFarProc;
PTSaveDIBFunc, PClearBlank: TFarProc;
function InitScanner: Boolean;
procedure WMScanbase(var Msg: TMessage); Message WM_SCANBASE;
procedure WMScanbase1(var Msg: TMessage); Message WM_SCANBASE+1;
function DeleteFileInPath: Boolean;
function GetMaxFileName: Integer;
public
Inde: Integer;
Savepath: String;
Perfix: String;
procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
end;

const ML_NONE = 0;
const ML_ERROR = 1;
const ML_INFO = 2;
const ML_FULL = 3;
const VALID_HANDLE = 32; // valid windows handle SB >= 32

var
BaseScanForm: TBaseScanForm;

implementation

{$R *.DFM}

function TBaseScanForm.InitScanner: Boolean;
var
PTWInitialize:TFarProc;//TFarProc=pointer-----Windows
PSetMessageLevel:TFarProc;//TFarProc=pointer-----Windows
begin
Result := False;
AppIdentity.Id := 0; // init to 0, but Source Manager will assign real value
AppIdentity.Version.MajorNum := 1;
AppIdentity.Version.MinorNum := 5;
AppIdentity.Version.Language := TWLG_USA;
AppIdentity.Version.Country := TWCY_CHINA;
lstrcpy(AppIdentity.Version.Info, '1TIDE1.0 9/1/98');
lstrcpy(AppIdentity.ProductName, 'TIDE1.0');

AppIdentity.ProtocolMajor := TWON_PROTOCOLMAJOR;
AppIdentity.ProtocolMinor := TWON_PROTOCOLMINOR;
AppIdentity.SupportedGroups := DG_IMAGE or DG_CONTROL;
lstrcpy(AppIdentity.Manufacturer, 'Chinese HanWang Company');
lstrcpy(AppIdentity.ProductFamily, 'TIDE');

// pass app particulars to glue code
PTWInitialize:=GetProcAddress(DllHandle, Pchar('_TWInitialize@20'));
PSetMessageLevel:=GetProcAddress(DllHandle,Pchar('_SetMessageLevel@4'));
if (PTWInitialize<>Nil) and (PSetMessageLevel<>Nil) then
begin
try
TWInitialize(PTWInitialize)(@AppIdentity, Self.Handle, 3, '', WM_SCANBASE);
SetMessageLevel(PSetMessageLevel)(ML_ERROR); //show error message only
Result := True;
except
end;
end;
end;

procedure TBaseScanForm.FormCreate(Sender: TObject);
begin
ClearBlankHandle := LoadLibrary(Pchar('ClearBlank.dll'));
if ClearBlankHandle<=0 then
begin
ShowMessage('不能启动ClearBlank.DLL');
exit;
end;
PClearBlank := GetProcAddress(ClearBlankHandle,Pchar('ClearBlank'));
if PClearBlank=Nil then
begin
ShowMessage('调用函数失败。');
exit;
end;

ConvertHandle := LoadLibrary(Pchar('Convert.dll'));
if ConvertHandle<=0 then
begin
ShowMessage('不能启动Convert.DLL');
exit;
end;

Dllhandle := LoadLibrary(Pchar('scdll32.dll'));
if DllHandle<=0 then
begin
ShowMessage('不能启动scdll32.DLL');
exit;
end;
PTSaveDIBFunc := GetProcAddress(ConvertHandle,Pchar('HDIB2Tiff'));
if PTSaveDIBFunc=Nil then
begin
ShowMessage('调用函数失败。');
exit;
end;
PResetID := GetProcAddress(DllHandle,Pchar('_ResetID@0'));
PTWOpenDSM := GetProcAddress(DllHandle,Pchar('_TWOpenDSM@0'));
PTWSelectDS := GetProcAddress(DllHandle,Pchar('_TWSelectDS@0'));
PTWCloseDSM := GetProcAddress(DllHandle,Pchar('_TWCloseDSM@4'));
PTWAcquire:=GetProcAddress(DllHandle,Pchar('_TWAcquire@12'));
PTWIsDSOpen:=GetProcAddress(DllHandle,Pchar('_TWIsDSOpen@0'));
PTWIsDSMOpen:=GetProcAddress(DllHandle,Pchar('_TWIsDSMOpen@0'));
PProcessTWMessage:=GetProcAddress(DllHandle,Pchar('_ProcessTWMessage@8'));
if (PTWIsDSOpen=Nil) or (PTWIsDSMOpen=Nil) or (PProcessTWMessage=Nil) then
begin
ShowMessage('调用函数失败。');
exit;
end;
end;

procedure TBaseScanForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
PCloseConnection: TFarProc;
begin
PCloseConnection:=GetProcAddress(DllHandle,Pchar('_CloseConnection@4'));
if PTWIsDSOpen<>Nil then
CloseConnection(PCloseConnection)(0);
end;

procedure TBaseScanForm.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
try
Handled := TWIsDSOpen(PTWIsDSOpen) and TWIsDSMOpen(PTWIsDSMOpen) and ProcessTWMessage(PProcessTWMessage)(@Msg, Self.Handle); //show error message only
except
Handled := False;
Exit;
end
{ for all other messages, Handled remains False }
{ so that other message handlers can respond }
end;

procedure TBaseScanForm.WMScanbase(var Msg: TMessage);
var
m: String;
begin
if Msg.WParam = 0 then
Msg.Result := 11
else
begin
if CheckBlank.Checked then
if TClearBlankFunc(PClearBlank)(Msg.WParam, StrToInt(Edit2.Text), StrToInt(Edit3.Text), StrToInt(Edit4.Text), StrToInt(Edit5.Text), StrToFloat(Edit1.Text)) <> 0 then
Exit;

Inde := Inde + 1;
if Inde<10 then
m := '000'+IntToStr(Inde)
else if (Inde >=10) and (Inde<100) then
m := '00'+IntToStr(Inde)
else if (Inde >=100) and (Inde<1000) then
m := '0'+IntToStr(Inde)
else if Inde >=1000 then
m := IntToStr(Inde);
if TSaveDIBFunc(PTSaveDIBFunc)(0, Msg.WParam,PChar(SavePath+'/'+Perfix+m+'.tif'))<>0 then
SHowMessage('调用Conver失败')
else
TifCount := TifCount + 1;
end;
end;

procedure TBaseScanForm.WMScanbase1(var Msg: TMessage);
begin
ScanBtn.Enabled := not Bool(Msg.WParam);
Sleep(1000);
NewScanBtn.Enabled := ScanBtn.Enabled;
AddScanBtn.Enabled := ScanBtn.Enabled;
Label1.Caption := '本次扫描共扫了'+IntToStr(TifCount)+'幅图象。';
Msg.Result := 11;
end;

procedure TBaseScanForm.ScanBtnClick(Sender: TObject);
begin
Inde := GetMaxFileName;
TifCount := 0;
if TWIsDSOpen(PTWIsDSOpen) then
ResetID(PResetID);
if not TWAcquire(PTWAcquire)(Self.Handle, True, 1) then
ShowMessage('请检查扫描仪是否能正常工作。');
end;

procedure TBaseScanForm.SelectDvcBtnClick(Sender: TObject);
begin
if TWOpenDSM(PTWOpenDSM) then
begin
TWSelectDS(PTWSelectDS);
TWCloseDSM(PTWCloseDSM)(0);
end;
end;

procedure TBaseScanForm.FormDestroy(Sender: TObject);
begin
if DLLHandle > 0 then
Freelibrary(DllHandle);
if ConvertHandle > 0 then
Freelibrary(ConvertHandle);
if ClearBlankHandle > 0 then
Freelibrary(ClearBlankHandle);
end;

procedure TBaseScanForm.FormShow(Sender: TObject);
begin
Savepath := 'D:/testTif';
Perfix := 'p';
if not InitScanner then
begin
ShowMessage('扫描初始化失败。');
Close;
end;
end;

procedure TBaseScanForm.AddScanBtnClick(Sender: TObject);
begin
Inde := GetMaxFileName;
TifCount := 0;
if TWIsDSOpen(PTWIsDSOpen) then
ResetID(PResetID);
if not TWAcquire(PTWAcquire)(Self.Handle, True, 1) then
ShowMessage('请检查扫描仪是否能正常工作。');
end;

procedure TBaseScanForm.NewScanBtnClick(Sender: TObject);
begin
if MessageBox(Application.Handle, Pchar('执行该操作会先把原来的图象删除，再重新扫描，你确定吗？'),
Pchar('确认操作'), MB_ICONWARNING or MB_OKCANCEL) <> IDOK then Exit;
DeleteFileInPath;
Inde := GetMaxFileName;
TifCount := 0;
if TWIsDSOpen(PTWIsDSOpen) then
ResetID(PResetID);
if not TWAcquire(PTWAcquire)(Self.Handle, True, 1) then
ShowMessage('请检查扫描仪是否能正常工作。');
end;

function TBaseScanForm.DeleteFileInPath: Boolean;
var
F:TShFileOpStruct;
begin
F.wnd:=0;
F.wFunc:=FO_DELETE; {操作方式}
F.pFrom:=PChar(SavePath + '/*.*' +#0#0);
F.pTo:=PChar(''+#0#0);
F.fFlags:=FOF_SILENT or FOF_NOCONFIRMATION;
result:= ShFileOperation(F)=0;
end;

function TBaseScanForm.GetMaxFileName: Integer;
function GetCount(Str: String): Integer;
begin
try
Result := StrToInt(Copy(Str,2,4));
except
Result := 0;
end;
end;
var
SR: TSearchRec;
Temp: Integer;
begin
Result := 0;
if DirectoryExists(SavePath) then
begin
if FindFirst(SavePath + '/'+Perfix+'*.tif', faAnyFile, SR) = 0 then
begin
Temp := GetCount(SR.Name);
if Temp > Result then
Result := Temp;
while FindNext(sr) = 0 do
begin
Temp := GetCount(SR.Name);
if Temp > Result then
Result := Temp;
end;
FindClose(sr);
end;
end
else
if not CreateDir(SavePath) then
begin
ShowMessage('不能创建目录'+SavePath+'，程序将关闭。');
Close;
end;
end;

end.