谁有可操作扫描仪的控件,献上200分 斑竹帮帮我啊 (200分)

  • 主题发起人 主题发起人 老人家
  • 开始时间 开始时间

老人家

Unregistered / Unconfirmed
GUEST, unregistred user!
谁有可操作扫描仪的控件,献上200分
 
http://www.csdn.net/cnshare/soft/5/5182.shtm
 
楼主也问啊~
 
to yaya8163
我不会用,你告述我如何用
 
{ ********************************************************************* }
{ * TOopsTwain: version 2.0, Jan 12, 2000. * }
{ * Copyright (C) 1995-2000 OopsWare Company. Oops! * }
{ * OopsWare Company. All rights reserved. * }
{ * E-mail: oops@jn-public.sd.cninfo.net * }
{ * Compiler: Borland Delphi 4.0 * }
{ ********************************************************************* }

unit OopsTwain;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, extctrls;

const
PM_XFERDONE = WM_USER + 0 ;

TWON_PROTOCOLMAJOR = 1;
TWON_PROTOCOLMINOR = 5; // Changed for Version 1.5

TWON_ARRAY = 3; // indicates TW_ARRAY container
TWON_ENUMERATION = 4; // indicates TW_ENUMERATION container
TWON_ONEVALUE = 5; // indicates TW_ONEVALUE container
TWON_RANGE = 6; // indicates TW_RANGE container
TWON_ICONID = 962; // res Id of icon used in USERSELECT lbox
TWON_DSMID = 461; // res Id of the DSM version num resource
TWON_DSMCODEID = 63; // res Id of the Mac SM Code resource
TWON_DONTCARE8 =$ff;
TWON_DONTCARE16 =$ffff;
TWON_DONTCARE32 =$ffffffff;

TWCY_USA = 1;
TWCY_CANADA = 2;
TWCY_MEXICO = 3;
TWCY_BRITAIN = 6;
TWCY_FRANCE = 33;
TWCY_JAPAN = 81;
TWCY_KOREA = 82;
TWCY_CHINA = 86;
TWCY_HONGKONG = 852;
TWCY_TAIWAN = 886;

TWLG_DAN = 0; //Danish
TWLG_DUT = 1; //Dutch
TWLG_ENG = 2; //International English
TWLG_FCF = 3; //French Canadian
TWLG_FIN = 4; //Finnish
TWLG_FRN = 5; //French
TWLG_GER = 6; //German
TWLG_ICE = 7; //Icelandic
TWLG_ITN = 8; //Italian
TWLG_NOR = 9; //Norwegian
TWLG_POR = 10; //Portuguese
TWLG_SPA = 11; //Spanish
TWLG_SWE = 12; //Swedish
TWLG_USA = 13; //U.S. English

DG_CONTROL =$00000001; // data pertaining to control
DG_IMAGE =$00000002; // data pertaining to raster images
DG_IMAGE_OR_CONTROL =$00000003; //is " DG_CONTROL|DG_IMAGE " in C++

DAT_NULL =$0000; // No data or structure.
DAT_CUSTOMBASE =$8000; // Base of custom DATs.
// Data Argument Types for the DG_CONTROL Data Group.
DAT_CAPABILITY =$0001; // TW_CAPABILITY
DAT_EVENT =$0002; // TW_EVENT
DAT_IDENTITY =$0003; // TW_IDENTITY
DAT_PARENT =$0004; // TW_HANDLE, app win handle in Windows
DAT_PENDINGXFERS =$0005; // TW_PENDINGXFERS
DAT_SETUPMEMXFER =$0006; // TW_SETUPMEMXFER
DAT_SETUPFILEXFER =$0007; // TW_SETUPFILEXFER
DAT_STATUS =$0008; // TW_STATUS
DAT_USERINTERFACE =$0009; // TW_USERINTERFACE
DAT_XFERGROUP =$000a; // TW_UINT32
DAT_TWUNKIDENTITY =$000b; // TW_TWUNKIDENTITY
// Data Argument Types for the DG_IMAGE Data Group.
DAT_IMAGEINFO =$0101; // TW_IMAGEINFO
DAT_IMAGELAYOUT =$0102; //TW_IMAGELAYOUT
DAT_IMAGEMEMXFER =$0103; //TW_IMAGEMEMXFER
DAT_IMAGENATIVEXFER =$0104; //TW_UINT32 loword is hDIB, PICHandle
DAT_IMAGEFILEXFER =$0105; //Null data
DAT_CIECOLOR =$0106; //TW_CIECOLOR
DAT_GRAYRESPONSE =$0107; //TW_GRAYRESPONSE
DAT_RGBRESPONSE =$0108; //TW_RGBRESPONSE
DAT_JPEGCOMPRESSION =$0109; //TW_JPEGCOMPRESSION
DAT_PALETTE8 =$010a; //TW_PALETTE8

// All message constants are unique.
MSG_NULL =$0000; // Used in TW_EVENT structure
MSG_CUSTOMBASE =$8000; // Base of custom messages
// Generic messages may be used with any of several DATs.
MSG_GET =$0001; // Get one or more values
MSG_GETCURRENT =$0002; // Get current value
MSG_GETDEFAULT =$0003; // Get default (e.g. power up) value
MSG_GETFIRST =$0004; // Get first of a series of items, e.g. DSs
MSG_GETNEXT =$0005; // Iterate through a series of items.
MSG_SET =$0006; // Set one or more values
MSG_RESET =$0007; // Set current value to default value
// Messages used with DAT_NULL
MSG_XFERREADY =$0101; // The data source has data ready
MSG_CLOSEDSREQ =$0102; // Request for App. to close DS
// Messages used with a pointer to a DAT_STATUS structure
MSG_CHECKSTATUS =$0201; // Get status information
// Messages used with a pointer to DAT_PARENT data
MSG_OPENDSM =$0301; // Open the DSM
MSG_CLOSEDSM =$0302; // Close the DSM
// Messages used with a pointer to a DAT_IDENTITY structure
MSG_OPENDS =$0401; // Open a data source
MSG_CLOSEDS =$0402; // Close a data source
MSG_USERSELECT =$0403; // Put up a dialog of all DS
// Messages used with a pointer to a DAT_USERINTERFACE structure
MSG_DISABLEDS =$0501; // Disable data transfer in the DS
MSG_ENABLEDS =$0502; // Enable data transfer in the DS
// Messages used with a pointer to a DAT_EVENT structure
MSG_PROCESSEVENT =$0601;
// Messages used with a pointer to a DAT_PENDINGXFERS structure
MSG_ENDXFER =$0701;

// Capabilities

CAP_CUSTOMBASE =$8000; //Base of custom capabilities
// all data sources are REQUIRED to support these caps
CAP_XFERCOUNT =$0001;
// image data sources are REQUIRED to support these caps
ICAP_COMPRESSION =$0100;
ICAP_PIXELTYPE =$0101;
ICAP_UNITS =$0102; //default is TWUN_INCHES
ICAP_XFERMECH =$0103;
// all data sources MAY support these caps
CAP_AUTHOR =$1000;
CAP_CAPTION =$1001;
CAP_FEEDERENABLED =$1002;
CAP_FEEDERLOADED =$1003;
CAP_TIMEDATE =$1004;
CAP_SUPPORTEDCAPS =$1005;
CAP_EXTENDEDCAPS =$1006;
CAP_AUTOFEED =$1007;
CAP_CLEARPAGE =$1008;
CAP_FEEDPAGE =$1009;
CAP_REWINDPAGE =$100a;
CAP_INDICATORS =$100b; //Added 1.1
CAP_SUPPORTEDCAPSEXT =$100c; // Added 1.6
CAP_PAPERDETECTABLE =$100d; // Added 1.6
CAP_UICONTROLLABLE =$100e; // Added 1.6
// image data sources MAY support these caps
ICAP_AUTOBRIGHT =$1100;
ICAP_BRIGHTNESS =$1101;
ICAP_CONTRAST =$1103;
ICAP_CUSTHALFTONE =$1104;
ICAP_EXPOSURETIME =$1105;
ICAP_FILTER =$1106;
ICAP_FLASHUSED =$1107;
ICAP_GAMMA =$1108;
ICAP_HALFTONES =$1109;
ICAP_HIGHLIGHT =$110a;
ICAP_IMAGEFILEFORMAT =$110c;
ICAP_LAMPSTATE =$110d;
ICAP_LIGHTSOURCE =$110e;
ICAP_ORIENTATION =$1110;
ICAP_PHYSICALWIDTH =$1111;
ICAP_PHYSICALHEIGHT =$1112;
ICAP_SHADOW =$1113;
ICAP_FRAMES =$1114;
ICAP_XNATIVERESOLUTION =$1116;
ICAP_YNATIVERESOLUTION =$1117;
ICAP_XRESOLUTION =$1118;
ICAP_YRESOLUTION =$1119;
ICAP_MAXFRAMES =$111a;
ICAP_TILES =$111b;
ICAP_BITORDER =$111c;
ICAP_CCITTKFACTOR =$111d;
ICAP_LIGHTPATH =$111e;
ICAP_PIXELFLAVOR =$111f;
ICAP_PLANARCHUNKY =$1120;
ICAP_ROTATION =$1121;
ICAP_SUPPORTEDSIZES =$1122;
ICAP_THRESHOLD =$1123;
ICAP_XSCALING =$1124;
ICAP_YSCALING =$1125;
ICAP_BITORDERCODES =$1126;
ICAP_PIXELFLAVORCODES=$1127;
ICAP_JPEGPIXELTYPE =$1128;
ICAP_TIMEFILL =$112a;
ICAP_BITDEPTH =$112b;
ICAP_BITDEPTHREDUCTION =$112c; //Added 1.5

//Return Codes and Condition Codes section
// Return Codes: DSM_Entry and DS_Entry may return any one of these values.
TWRC_CUSTOMBASE =$8000;
TWRC_SUCCESS =0;
TWRC_FAILURE =1; //App may get TW_STATUS for info on failure
TWRC_CHECKSTATUS =2; //"tried hard"; get status
TWRC_CANCEL =3;
TWRC_DSEVENT =4;
TWRC_NOTDSEVENT =5;
TWRC_XFERDONE =6;
TWRC_ENDOFLIST =7; //After MSG_GETNEXT if nothing left
//Condition Codes: App gets these by doing DG_CONTROL DAT_STATUS MSG_GET.
TWCC_CUSTOMBASE =$8000;
TWCC_SUCCESS =0; //It worked!
TWCC_BUMMER =1; //Failure due to unknown causes
TWCC_LOWMEMORY =2; //Not enough memory to perform operation
TWCC_NODS =3; //No Data Source
TWCC_MAXCONNECTIONS =4; //DS is connected to max possible apps
TWCC_OPERATIONERROR =5; //DS or DSM reported error, app shouldn't
TWCC_BADCAP =6; //Unknown capability
TWCC_BADPROTOCOL =9; //Unrecognized MSG DG DAT combination
TWCC_BADVALUE =10; //Data parameter out of range
TWCC_SEQERROR =11; //DG DAT MSG out of expected sequence
TWCC_BADDEST =12; //Unknown destination App/Src in DSM_Entry

type
TW_HANDLE = Word;
TW_MEMREF = pointer;

// TW_HUGE = Longint;
TW_STR32 = Array [0..33] of Char;
// TW_STR64 = Array [0..65] of Char;
// TW_STR128 = Array [0..129] of Char;
// TW_STR255 = Array [0..255] of Char;
// TW_INT8 = ShortInt;
TW_INT16 = Smallint;
TW_INT32 = Longint;
// TW_UINT8 = Byte;
TW_UINT16 = Smallint; // Unsinged integer !!!
TW_UINT32 = Longint;
TW_BOOL = Byte; // Unsinged Short Boolean !!!

TW_FIX32 = packed record // Fixed point structure type.
Whole : TW_INT16; // maintains the sign
Frac : TW_INT16;
end;
pTW_FIX32 = ^TW_FIX32;

TW_VERSION = packed record
MajorNum : TW_UINT16; // Major revision number of the software.
MinorNum : TW_UINT16; // Incremental revision number of the software.
Language : TW_UINT16; // e.g. TWLG_SWISSFRENCH
Country : TW_UINT16; // e.g. TWCY_SWITZERLAND
Info : TW_STR32; // e.g. "1.0b3 Beta release"
end;

TW_IDENTITY = packed record
Id : TW_UINT32; // Unique number. In Windows, app hWnd
Version : TW_VERSION; // Identifies the piece of code
ProtocolMajor : TW_UINT16; // App and DS must set to TWON_PROTOCOLMAJOR
ProtocolMinor : TW_UINT16; // App and DS must set to TWON_PROTOCOLMINOR
SupportedGroups : TW_UINT32; // Bit field OR combination of DG_ constants
Manufacturer : TW_STR32; // Manufacturer name, e.g. "Hewlett-Packard"
ProductFamily : TW_STR32; // Product family name, e.g. "ScanJet"
ProductName : TW_STR32; // Product name, e.g. "ScanJet Plus"
end;
pTW_IDENTITY = ^TW_IDENTITY;

TW_IMAGEINFO = packed record // DAT_IMAGEINFO. App gets detailed image info from DS with this.
XResolution :TW_FIX32; // Resolution in the horizontal
YResolution :TW_FIX32; // Resolution in the vertical
ImageWidth :TW_INT32; // Columns in the image, -1 if unknown by DS
ImageLength :TW_INT32; // Rows in the image, -1 if unknown by DS
SamplesPerPixel :TW_INT16; // Number of samples per pixel, 3 for RGB
BitsPerSample :Array[0..7]of TW_INT16; // Number of bits for each sample
BitsPerPixel :TW_INT16; // Number of bits for each padded pixel
Planar :TW_BOOL; // True if Planar, False if chunky
PixelType :TW_INT16; // How to interp data; photo interp (TWPT_)
Compression :TW_INT16; // How the data is compressed (TWCP_xxxx)
end;
pTW_IMAGEINFO = ^TW_IMAGEINFO;

TW_CAPABILITY = packed record //DAT_CAPABILITY. Used by app to get/set capability from/in a data source.
Cap,
ConType : TW_UINT16;
hContainer : THandle;
end;
pTW_CAPABILITY = ^TW_CAPABILITY;

TW_USERINTERFACE = packed record
ShowUI : TW_BOOL; // TRUE if DS should bring up its UI
ModalUI : TW_BOOL; // For Mac only - true if the DS's UI is modal
hParent : TW_HANDLE; // For windows only - App window handle
end;
pTW_USERINTERFACE = ^TW_USERINTERFACE;

TW_EVENT = packed record
pEvent :TW_MEMREF; // Windows pMSG or Mac pEvent.
TWMessage :TW_UINT16; // TW msg from data source, e.g. MSG_XFERREADY
end;
pTW_EVENT = ^TW_EVENT;

TW_PENDINGXFERS = packed record
Count :TW_UINT16; // Number of additional "images" pending.
Reserved :TW_UINT32;
end;
pTW_PENDINGXFERS = ^TW_PENDINGXFERS;


{**********************************************************************
* Function: DSM_Entry, the only entry point into the Data Source Manager.
* Parameters:
* pOrigin Identifies the source module of the message. This could
* identify an Application, a Source, or the Source Manager.
* pDest Identifies the destination module for the message.
* This could identify an application or a data source.
* If this is NULL, the message goes to the Source Manager.
* DG The Data Group.
* Example: DG_IMAGE.
* DAT The Data Attribute Type.
* Example: DAT_IMAGEMEMXFER.
* MSG The message. Messages are interpreted by the destination module
* with respect to the Data Group and the Data Attribute Type.
* Example: MSG_GET.
* pData A pointer to the data structure or variable identified
* by the Data Attribute Type.
* Example: (TW_MEMREF)&ImageMemXfer
* where ImageMemXfer is a TW_IMAGEMEMXFER structure.
* Returns:
* ReturnCode
* Example: TWRC_SUCCESS.
********************************************************************}

DSM_Entry = function( pOrigin :pTW_IDENTITY;
pDest :pTW_IDENTITY;
DG :TW_UINT32;
DAT :TW_UINT16;
MSG :TW_UINT16;
pData :TW_MEMREF ) : TW_UINT16; stdcall;

{**********************************************************************
* Function: DS_Entry, the entry point provided by a Data Source.
* Parameters:
* pOrigin Identifies the source module of the message. This could
* identify an application or the Data Source Manager.
* DG The Data Group.
* Example: DG_IMAGE.
* DAT The Data Attribute Type.
* Example: DAT_IMAGEMEMXFER.
* MSG The message. Messages are interpreted by the data source
* with respect to the Data Group and the Data Attribute Type.
* Example: MSG_GET.
* pData A pointer to the data structure or variable identified
* by the Data Attribute Type.
* Example: (TW_MEMREF)&ImageMemXfer
* where ImageMemXfer is a TW_IMAGEMEMXFER structure.
* Returns:
* ReturnCode
* Example: TWRC_SUCCESS.
* Note:
* The DSPROC type is only used by an application when it calls
* a Data Source directly, bypassing the Data Source Manager.
******************************************************************** }

DS_Entry = function ( pOrigin : pTW_IDENTITY;
DG : TW_UINT32;
DAT : TW_UINT16;
MSG : TW_UINT16;
pData : TW_MEMREF) :TW_UINT16; stdcall;

TOnTwRC = procedure(Sender: TObject; const Level: Integer; var ReturnCode: UINT) of object;

TtransferType = (doNativeTransfer,doFileTransfer,doMemTransfer);

TOopsTwain = class(TComponent)
private { Private declarations }
AppID,dsID : TW_IDENTITY;
TWhMainWnd : HWND; // Backup Main Window Handle.
TWDSMOpen, TWDSOpen, TWDSEnabled: Boolean; // Twain Curren States.
FTransferType : TtransferType;
showTwMsg : Boolean;
lpDSM_Entry : DSM_Entry ;
twUI : TW_USERINTERFACE; // Structure of User Interface.
hDSMDLL : THandle; // TWAIN_32.DLL 's Handle.
fHooked : Boolean;
fOnTwEvent : TNotifyEvent;
fOnTwReturnCode :TOnTwRC;
procedure SetTransferType(Value: TtransferType);
procedure SetshowTwMsg(Value: Boolean);
procedure TWshowMessage(Value: String);
procedure TWInitialize; //Must be Loadded after AppMain Form Create;
function TWSelectDS: TW_UINT16;
procedure TWTransferImage;
function ProcessTWMessage(var Message :TMessage; TwhWnd :THandle):Boolean;
procedure NativeTransfer;
procedure FileTransfer;
procedure WndProc(var Message: TMessage);
procedure HookWin;
procedure UnHookWin;
protected { Protected declarations }
OldWndProc : TFarProc;
NewWndProc : Pointer;
Procedure TwXferDone(Var TwEvn : TMessage); Message PM_XFERDONE;
public { Public declarations }
BitMap :TBitMap;
binfo : TW_IMAGEINFO;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function TWOpenDSM: TW_UINT16; // DSM
function TWCloseDSM: TW_UINT16;
function TWisDSMOpen: Boolean;
function TWOpenDS: TW_UINT16; // DS
function TWCloseDS: TW_UINT16;
function TWisDSOpen: Boolean;
function TWEnableDS(Show: Boolean): TW_UINT16; // UI
function TWDisableDS: TW_UINT16;
function TWisDSEnable: Boolean;
procedure TWTerminate;
function SelectSource: TW_UINT16;
function Acquire(Show: Boolean):TW_UINT16;
procedure CurrentDSInfo;
published { Published declarations }
property ShowTwainMessage :Boolean read showTwMsg write SetshowTwMsg;
property TransferType :TtransferType read FTransferType write SetTransferType;
property OnCaptrue :TNotifyEvent read fOnTwEvent write fOnTwEvent;
property OnTwReturnCode :TOnTwRC read fOnTwReturnCode write fOnTwReturnCode;
end;

procedure Register;

implementation

constructor TOopsTwain.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fHooked:=False;
BitMap:=TBitMap.Create;
with AOwner as TForm do TWhMainWnd :=Handle; //Initializing AppID & Backup App's Main Window Handle.
TWInitialize;
end;

destructor TOopsTwain.Destroy;
begin
TWTerminate;
BitMap.DesTroy;
inherited Destroy;
end;

procedure TOopsTwain.HookWin;
begin
OldWndProc := TFarProc(GetWindowLong(TWhMainWnd, GWL_WNDPROC));
NewWndProc := MakeObjectInstance(WndProc);
SetWindowLong(TWhMainWnd, GWL_WNDPROC, LongInt(NewWndProc));
fHooked:=True;
end;

procedure TOopsTwain.UnHookWin;
begin
If not fHooked then exit;
SetWindowLong(TWhMainWnd, GWL_WNDPROC, LongInt(OldWndProc));
if AsSigned(NewWndProc) then FreeObjectInstance(NewWndProc);
NewWndProc := nil;
FHooked := False;
end;

procedure TOopsTwain.SetTransferType(Value: TtransferType);
begin
if FTransferType<>Value then FTransferType:=Value
end;

procedure TOopsTwain.SetshowTwMsg(Value: Boolean);
begin
if showTwMsg<>Value then showTwMsg:=Value
end;

procedure TOopsTwain.TWshowMessage(Value: String);
var TwErrMsg :Array[0..255]of char;
begin
strPcopy(TwErrMsg,Value);
if showTwMsg then MessageBox(TWhMainWnd,TwErrMsg,'TWAIN 出错信息:',MB_ICONWARNING+MB_OK);
end;

procedure TOopsTwain.TWInitialize;
begin
AppID.Id := 0; // init to 0, but Source Manager will assign real value
AppID.Version.MajorNum := 1;
AppID.Version.MinorNum := 0;
AppID.Version.Language := TWLG_ENG;
AppID.Version.Country := TWCY_CHINA;
strcopy (AppID.Version.Info, 'TWAIN_32 Twacker 2.0 01/12/2000');
strcopy (AppID.ProductName, 'OopsWare TWAIN Component');
AppID.ProtocolMajor := TWON_PROTOCOLMAJOR;
AppID.ProtocolMinor := TWON_PROTOCOLMINOR;
AppID.SupportedGroups := DG_IMAGE_OR_CONTROL;
strcopy (AppID.Manufacturer, 'OopsWare Company.');
strcopy (AppID.ProductFamily, 'TWAIN Component for Delphi');
TWDSMOpen := False;
TWDSOpen := False;
TWDSEnabled:= False;
end;

(*************************************************
* Twain function Weither DSM is Openned *
*************************************************)
function TOopsTwain.TWisDSMOpen: Boolean;
begin Result:=TWDSMOpen end;

(*************************************************
* Twain function Weither DS is Openned *
*************************************************)
function TOopsTwain.TWisDSOpen: Boolean;
begin Result:=TWDSOpen end;

(*************************************************
* Twain function Weither DS is Enabled *
*************************************************)
function TOopsTwain.TWisDSEnable: Boolean;
begin Result:=TWDSEnabled end;

(*************************************************
* Twain function: Open DSM *
*************************************************)
function TOopsTwain.TWOpenDSM: TW_UINT16;
var twRC: TW_UINT16;
sWindowsPath: Array [0..200] of char;
begin
Result:= TWRC_FAILURE;
GetWindowsDirectory(sWindowsPath,200);
Strcat(sWindowsPath,'/TWAIN_32.DLL');
hDSMDLL:=LoadLibrary(sWindowsPath);
if (hDSMDLL<>0) and not(TWisDSMOpen) then
begin
@lpDSM_Entry := GetProcAddress(hDSMDLL,'DSM_Entry');
if @lpDSM_Entry <> nil then
begin
twRC:= lpDSM_Entry(@AppID,NIL,DG_CONTROL,DAT_PARENT,MSG_OPENDSM,@TwhMainWnd);
if twRC=TWRC_SUCCESS
then begin TWDSMOpen:=True; Result:=twRC; end
else TWshowMessage('Error Open DSM!'#13#10'DG_CONTROL/DAT_PARENT/MSG_OPENDSM');
end //end if get proc addr has no error!
else TWshowMessage('Error Get DSM Entry!');
end //end if Load TWAIN_32.DLL Error;
else TWshowMessage('Error Load TWAIN_32.DLL');
end;

(*************************************************
* Twain function: Close DSM *
*************************************************)
function TOopsTwain.TWCloseDSM: TW_UINT16;
var twRC: TW_UINT16;
begin
Result:= TWRC_FAILURE;
if TWisDSMOpen then
begin
twRC:= lpDSM_Entry(@AppID,NIL,DG_CONTROL,DAT_PARENT,MSG_CLOSEDSM,@TwhMainWnd);
if twRC<>TWRC_SUCCESS then TWshowMessage('Error Close DSM!'#13#10'DG_CONTROL/DAT_PARENT/MSG_CLOSEDSM');
if hDSMDLL<>0 then FreeLibrary (hDSMDLL); // Free TWAIN_32.DLL
hDSMDLL:= 0;
dsID.Id:= 0;
Result:= twRC;
end
else TWshowMessage('Can not Close DSM while is not Openned');
TWDSMOpen:=False;
end;

(*************************************************
* Twain function: Select DS. *
*************************************************)
function TOopsTwain.TWSelectDS: TW_UINT16;
var twRC: TW_UINT16;
NewDsID: TW_IDENTITY;
begin
Result:=TWRC_FAILURE;
NewDsID.Id:=0;
NewDsID.ProductName[0]:=#0;
if TWisDSMOpen then
if not(TWisDSOpen)then
begin
twRc := lpDSM_Entry(@AppID, NIL, DG_CONTROL, DAT_IDENTITY, MSG_USERSELECT, @NewDsID);
if twRC=TWRC_SUCCESS then dsID := NewDsID;
Result:=twRC;
end
else TWshowMessage('Can not Select New DS while DS is Openning')
else TWshowMessage('Can not Select DS while DSM not Openned');
end;

(*************************************************
* Twain function: Open DS *
*************************************************)
function TOopsTwain.TWOpenDS: TW_UINT16;
var twRC: TW_UINT16;
begin
Result:=TWRC_FAILURE;
if TWisDSMOpen then
if not(TWisDSOpen) then
begin
twRC:= lpDSM_Entry(@AppID, NIL, DG_CONTROL, DAT_IDENTITY, MSG_OPENDS, @dsID);
if twRC=TWRC_SUCCESS then
begin
TWDSOpen:=True;
HookWin;
end
else TWshowMessage('Error Open DS'#13#10'DG_CONTROL/DAT_IDENTITY/MSG_OPENDS');
Result:=twRC;
end
else TWshowMessage('Can not Open DS while It is Openning')
else TWshowMessage('Can not Open DS while DSM not Openning');
end;

(*************************************************
* Twain function: Close DS *
*************************************************)
function TOopsTwain.TWCloseDS: TW_UINT16;
var twRC: TW_UINT16;
begin
Result:=TWRC_FAILURE;
if TWisDSOpen then
if not(TWisDSEnable) then
begin
twRC:= lpDSM_Entry(@AppID, NIL, DG_CONTROL, DAT_IDENTITY, MSG_CLOSEDS, @dsID);
if twRC=TWRC_SUCCESS then
begin
TWDSOpen:=False;
UnHookWin;
end
else TWshowMessage('Error Close DS'#13#10'DG_CONTROL/DAT_IDENTITY/MSG_CLOSEDS');
dsID.Id := 0;
dsID.ProductName[0] := #0;
Result:=twRC;
end
else TWshowMessage('Can not Close DS while DS is Enabled')
else TWshowMessage('Can not Close DS while it is not Openning');
TWDSOpen:=False;
end;

(*************************************************
* Twain function: Enable DS *
*************************************************)
function TOopsTwain.TWEnableDS(Show: Boolean): TW_UINT16;
var twRC: TW_UINT16;
begin
Result:=TWRC_FAILURE;
if TWisDSOpen then
if not(TWisDSEnable) then
begin
twUI.hParent := TWhMainWnd;
if Show then twUI.ShowUI := 1
else twUI.ShowUI := 0;
twRC:= lpDSM_Entry(@AppID, @dsID, DG_CONTROL, DAT_USERINTERFACE, MSG_ENABLEDS, @twUI);
if twRC=TWRC_SUCCESS
then TWDSEnabled:=True
else TWshowMessage('Error Enable DS'#13#10'DG_CONTROL/DAT_USERINTERFACE/MSG_ENABLEDS');
Result:=twRC;
end
else TWshowMessage('Can not Enable DS while it already Enabled')
else TWshowMessage('Can not Enable DS while DS is not Openning');
end;

(*************************************************
* Twain function: Disable DS *
*************************************************)
function TOopsTwain.TWDisableDS: TW_UINT16;
var twRC: TW_UINT16;
begin
Result:=TWRC_FAILURE;
if TWisDSEnable then
begin
twUI.hParent := TWhMainWnd;
twUI.ShowUI := TWON_DONTCARE8;
twRC:= lpDSM_Entry(@AppID, @dsID, DG_CONTROL, DAT_USERINTERFACE, MSG_DISABLEDS, @twUI);
if twRC=TWRC_SUCCESS
then TWDSEnabled:=False
else TWshowMessage('Error Disable DS'#13#10'DG_CONTROL/DAT_USERINTERFACE/MSG_DISABLEDS');
Result:=twRC;
end
else TWshowMessage('Can not Disable DS while DS Already Disabled');
TWDSEnabled:=False;
end;

(**************************************************
* Twain Terminate *
**************************************************)
procedure TOopsTwain.TWTerminate;
begin
TWDisableDS;
TWCloseDS;
TWCloseDSM;
end;

(**************************************************
* Twain Select Source *
* Return Code *
* 0 :Success, 1 :failure, 3 :User do cancel *
**************************************************)
function TOopsTwain.SelectSource: TW_UINT16;
begin
Result:=TWRC_FAILURE;
if not(TWisDSMOpen) then TWOpenDSM;
if TWisDSOpen then Exit; //Can't Do Select While DS is Openning!
Result:=TWSelectDS;
if TWisDSMOpen then TWCloseDSM;
end;

function TOopsTwain.Acquire(Show: Boolean):TW_UINT16;
var twRC :TW_UINT16;
begin
twRC:=TWRC_FAILURE;
Result:=TWRC_FAILURE;
if not(TWisDSMOpen) then twRC:=TWOpenDSM;
if twRC<>TWRC_SUCCESS then Exit;
if not(TWisDSOpen) then twRC:=TWOpenDS;
if twRC<>TWRC_SUCCESS then Exit;
if not(TWisDSEnable) then Result:=TWEnableDS(True);
end;

procedure TOopsTwain.CurrentDSInfo;
var TwDsInfo: Array [0..400] of Char;
DispDsInfo :TW_IDENTITY;
begin
if not(TWisDSMOpen) then
begin
if TWOpenDSM<>TWRC_SUCCESS then Exit;
if TWOpenDS<>TWRC_SUCCESS then Exit;
DispDsInfo:=dsID; TWCloseDS ; TWCloseDSM;
TwDsInfo[0]:=#0;
StrCat(TwDsInfo,'设备版本: '); StrCat(TwDsInfo,DispDsInfo.Version.Info); StrCat(TwDsInfo,#13#10);
StrCat(TwDsInfo,'设备名称: '); StrCat(TwDsInfo,DispDsInfo.ProductName); StrCat(TwDsInfo,#13#10);
StrCat(TwDsInfo,'设备型号: '); StrCat(TwDsInfo,DispDsInfo.ProductFamily); StrCat(TwDsInfo,#13#10);
StrCat(TwDsInfo,'制 造 商: '); StrCat(TwDsInfo,DispDsInfo.Manufacturer); StrCat(TwDsInfo,#13#10);
StrCat(TwDsInfo,'----------------------------------------'#13#10#13#10);
StrCat(TwDsInfo,'TWAIN Component 1.1 for Delphi'#13#10#13#10);
StrCat(TwDsInfo,'Copyright (C) 1995-2000 OopsWare Company.'#13#10);
StrCat(TwDsInfo,'E-Mail: qiangdu@hotmail.com');
MessageBox(TWhMainWnd,TwDsInfo,'当前的扫描仪设备驱动信息.',MB_ICONINFORMATION+MB_OK);
end
end;

function TOopsTwain.ProcessTWMessage(var Message :TMessage; TwhWnd :THandle):Boolean;
var twRC :TW_UINT16;
twEv :TW_EVENT;
theMsg : TMsg;
begin // Here Something delicacy that MSG of C++ and TMessage of Delphi are not Same.
twRC:=TWRC_NOTDSEVENT;
Result:=False;
if TWIsDSOpen then
begin
theMsg.hWnd:=TWhMainWnd;
theMsg.message:=Message.Msg;
theMsg.wParam:=Message.WParam;
theMsg.lParam:=Message.LParam;
twEv.pEvent := @theMsg; //twEvent.pEvent = (TW_MEMREF)lpMsg;
twRC :=lpDSM_Entry(@appID, @dsID, DG_CONTROL, DAT_EVENT, MSG_PROCESSEVENT, @twEv);
case twEv.TWMessage of
MSG_XFERREADY :TWTransferImage;
MSG_CLOSEDSREQ :TWTerminate;
end;
Message.Msg :=theMsg.message;
Message.WParam :=theMsg.wParam;
Message.LParam :=theMsg.lParam;
end;
if twRC=TWRC_DSEVENT
then Result:=True;
end;

procedure TOopsTwain.TWTransferImage;
begin
case FTransferType of
doNativeTransfer : NativeTransfer;
doFileTransfer : FileTransfer;
doMemTransfer : ;
end;
end;

procedure TOopsTwain.NativeTransfer;
var twPendingXfer: TW_PENDINGXFERS;
lpDib, lpBi :PBITMAPINFOHEADER;
lpBits :Pointer;
dwColorTableSize: TW_UINT32;
LogPal : TMaxLogPalette; // Color Palette.
twRC, twRC2 :TW_UINT16;
hBitMap :TW_UINT32;
hbm_acq, hDibPal :THandle;
mDC :HDC;
begin
dwColorTableSize := 0;
twPendingXfer.count:= 0;
repeat
twRC := lpDSM_Entry(@appID,@dsID,DG_IMAGE,DAT_IMAGENATIVEXFER,MSG_GET,@hBitMap);
case twRC of
TWRC_XFERDONE:begin
hbm_acq := hBitMap;
twRC2 :=lpDSM_Entry(@appID,@dsID,DG_CONTROL,DAT_PENDINGXFERS,MSG_ENDXFER,@twPendingXfer);
if twRC2<>TWRC_SUCCESS then TWshowMessage('DG_CONTROL/DAT_PENDINGXFERS/MSG_ENDXFER');
if twPendingXfer.Count = 0 then
begin
lpdib := GlobalLock(hbm_acq);
if (lpdib<>NIL) then
begin
TWTerminate;
lpBi := lpDib;
case lpBi^.biBitCount of
1 : dwColorTableSize := 8;
4 : dwColorTableSize := 64;
8 : dwColorTableSize := 1024;
24 : dwColorTableSize := 0;
end;
lpBits := Pointer(Longint(lpDib) + Longint(lpBi^.biSize) + Longint(dwColorTableSize));
mDC := GetDC(TWhMainWnd);
LogPal.palVersion :=$0300; LogPal.palNumEntries :=256;
hDibPal:=CreatePalette(PLogPalette(@LogPal)^);
if hDibPal<>0 then
begin
SelectPalette (mDC, hDibPal, FALSE);
RealizePalette (mDC);
end;
Bitmap.Handle := CreateDIBitmap (mDC, (lpDib)^, CBM_INIT, lpBits,PBitMapInfo(lpDib)^ , DIB_RGB_COLORS);
ReleaseDC (TWhMainWnd, mDC);
GlobalUnlock(hbm_acq);
OnCaptrue(Self);
end
else TWshowMessage('Could Not Lock Bitmap Memory');
end;
end;
TWRC_CANCEL :begin
TWshowMessage('Source (or User) Canceled Transfer');
end;
TWRC_FAILURE :begin
TWshowMessage('TWRC_FAILURE');
end;
else begin
TWshowMessage('Other Error Code');
end;
end; //End Case .
until twPendingXfer.count=0;
end;

procedure TOopsTwain.FileTransfer;
var twImageInfo :TW_IMAGEINFO;
twRC : TW_UINT16;
s,ss : array[0..400]of char;
st,stt : string;
begin
lpDSM_Entry(@appID,@dsID,DG_IMAGE,DAT_IMAGEINFO,MSG_GET,@twImageInfo);
lpDSM_Entry(@appID,@dsID,DG_IMAGE,DAT_IMAGEINFO,MSG_GET,@ss[0]);
stt:='';
for twRC:=0 to 40 do
stt:=stt+inttostr(ord(ss[twRC]))+',';
TWTerminate;
st:='XRes:'+inttostr(twImageInfo.XResolution.Whole)+' YRes:'+inttostr(twImageInfo.YResolution.Whole)+#13#10;
st:=st+'Width:'+inttostr(twImageInfo.ImageWidth)+' Height:'+inttostr(twImageInfo.ImageLength)+#13#10;
st:=st+'SPP:'+inttostr(twImageInfo.SamplesPerPixel)+' BPP:'+inttostr(twImageInfo.BitsPerPixel)+#13#10;
st:=st+stt;
StrPCopy(s,st);
MessageBox(TWhMainWnd,s,'info',MB_OK);
end;

Procedure TOopsTwain.TwXferDone(Var TwEvn : TMessage);
begin
OnCaptrue(Self);
end;

procedure TOopsTwain.WndProc(var Message: TMessage);
begin
if not(ProcessTWMessage(Message,TWhMainWnd)) then
Message.Result := CallWindowProc(OldWndProc, TWhMainWnd, Message.Msg, Message.wParam, Message.lParam);
end;

procedure Register;
begin
RegisterComponents('OopsWare', [TOopsTwain]);
end;

end.
 
你贴源码干什么?
 
windows就自带了个图象处理,一共有4个ActiveX,
装上就可以用了,不单带扫描功能,还能调整图像。
 
WINDOWS 自带的(其实也不是自带的,你安装WINDOWS的时候记得安装“映像”),然后在
Delphi的导入ActiveX控件那里就可以找到“Kodak 图象扫描”。
 
To stlont and SupermanTm
我早就用过,但如果ImgScan1.ShowSetupBeforeScan := False;
则扫描的大小就不对。如何设置扫描的大小
ImgScan1.ShowSetupBeforeScan := True;
则调出扫描仪对话框,扫描的大小就正确。
现在要求不显示扫描仪的对话框,就能使扫描大小正确,如何做?

To all
我谢谢大家,虽然没帮到我


 
很想帮你,可是俺实在太菜了。[:(]
 
什么是斑竹?
 
看看这个论坛 http://liuyj.tzo.com/liuyj
 
WINDOWS2000也可以吗?
我原先没装“映象”,现在怎么找也找不到这个组件啊?
 

Similar threads

后退
顶部