关于使用 twain 扫描/保存图片的问题.请各位高手近来看一看.( 附源程序 )2

Question

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;

Answer 1

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: [email protected]');
    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;

Answer 2

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.
终于贴完了 !!! 各位高手帮忙呀 ！！