iewia.pas

·ImageEn 2.3.0 ImageEn一组用于图像处理、查看和分析的Delphi控件。能够保存几种图像格式

    vt: TVarType;
    wReserved1: Word;
    wReserved2: Word;
    wReserved3: Word;
    case Integer of
      0: (bVal: Byte);
      1: (iVal: SmallInt);
      2: (uiVal: Word);
      3: (boolVal: TOleBool);
      4: (obool: TOleBool); // obool instead of bool, because C++Builder uses bool as keyword
      5: (lVal: Longint);
      6: (ulVal: Cardinal);
      7: (fltVal: Single);
      8: (scode: integer);
      9: (hVal: LARGE_INTEGER);
      10: (uhVal: ULARGE_INTEGER);
      11: (dblVal: Double);
      12: (cyVal: Currency);
      13: (date: TOleDate);
      14: (filetime: TFileTime);
      15: (puuid: PGUID);
      16: (blob: TBlob);
      17: (pclipdata: PClipData);
      18: (pStream: Pointer);
      19: (pStorage: Pointer);
      20: (bstrVal: TBStr);
      21: (pszVal: PAnsiChar);
      22: (pwszVal: PWideChar);
      23: (caub: TCAUB);
      24: (cai: TCAI);
      25: (caui: TCAUI);
      26: (cabool: TCABOOL);
      27: (cal: TCAL);
      28: (caul: TCAUL);
      29: (caflt: TCAFLT);
      30: (cascode: TCASCODE);
      31: (cah: TCAH);
      32: (cauh: TCAUH);
      33: (cadbl: TCADBL);
      34: (cacy: TCACY);
      35: (cadate: TCADATE);
      36: (cafiletime: TCAFILETIME);
      37: (cauuid: TCACLSID);
      38: (caclipdata: TCACLIPDATA);
      39: (cabstr: TCABSTR);
      40: (calpstr: TCALPSTR);
      41: (calpwstr: TCALPWSTR);
      42: (capropvar: TCAPROPVARIANT);
  end;
  TPropVariant = PROPVARIANT;

  STGMEDIUM = packed record
    tymed: Longint;
    case Integer of
      0: (hBitmap: HBitmap; unkForRelease: pointer);
      1: (hMetaFilePict: THandle);
      2: (hEnhMetaFile: THandle);
      3: (hGlobal: HGlobal);
      4: (lpszFileName: PWideChar);
      5: (stm: pointer);
      6: (stg: pointer);
  end;
  PSTGMEDIUM = ^STGMEDIUM;

const
  VT_EMPTY = 0; { [V]   [P]  nothing                     }
  VT_NULL = 1; { [V]        SQL style Null              }
  VT_I2 = 2; { [V][T][P]  2 byte signed int           }
  VT_I4 = 3; { [V][T][P]  4 byte signed int           }
  VT_R4 = 4; { [V][T][P]  4 byte real                 }
  VT_R8 = 5; { [V][T][P]  8 byte real                 }
  VT_CY = 6; { [V][T][P]  currency                    }
  VT_DATE = 7; { [V][T][P]  date                        }
  VT_BSTR = 8; { [V][T][P]  binary string               }
  VT_DISPATCH = 9; { [V][T]     IDispatch FAR*              }
  VT_ERROR = 10; { [V][T]     SCODE                       }
  VT_BOOL = 11; { [V][T][P]  True=-1, False=0            }
  VT_VARIANT = 12; { [V][T][P]  VARIANT FAR*                }
  VT_UNKNOWN = 13; { [V][T]     IUnknown FAR*               }
  VT_DECIMAL = 14; { [V][T]   [S]  16 byte fixed point      }
  VT_I1 = 16; {    [T]     signed char                 }
  VT_UI1 = 17; {    [T]     unsigned char               }
  VT_UI2 = 18; {    [T]     unsigned short              }
  VT_UI4 = 19; {    [T]     unsigned long               }
  VT_I8 = 20; {    [T][P]  signed 64-bit int           }
  VT_UI8 = 21; {    [T]     unsigned 64-bit int         }
  VT_INT = 22; {    [T]     signed machine int          }
  VT_UINT = 23; {    [T]     unsigned machine int        }
  VT_VOID = 24; {    [T]     C style void                }
  VT_HRESULT = 25; {    [T]                                 }
  VT_PTR = 26; {    [T]     pointer type                }
  VT_SAFEARRAY = 27; {    [T]     (use VT_ARRAY in VARIANT)   }
  VT_CARRAY = 28; {    [T]     C style array               }
  VT_USERDEFINED = 29; {    [T]     user defined type          }
  VT_LPSTR = 30; {    [T][P]  null terminated string      }
  VT_LPWSTR = 31; {    [T][P]  wide null terminated string }
  VT_FILETIME = 64; {       [P]  FILETIME                    }
  VT_BLOB = 65; {       [P]  Length prefixed bytes       }
  VT_STREAM = 66; {       [P]  Name of the stream follows  }
  VT_STORAGE = 67; {       [P]  Name of the storage follows }
  VT_STREAMED_OBJECT = 68; {       [P]  Stream contains an object   }
  VT_STORED_OBJECT = 69; {       [P]  Storage contains an object  }
  VT_BLOB_OBJECT = 70; {       [P]  Blob contains an object     }
  VT_CF = 71; {       [P]  Clipboard format            }
  VT_CLSID = 72; {       [P]  A Class ID                  }
  VT_VECTOR = $1000; {       [P]  simple counted array        }
  VT_ARRAY = $2000; { [V]        SAFEARRAY*                  }
  VT_BYREF = $4000; { [V]                                    }
  VT_RESERVED = $8000;
  VT_ILLEGAL = $FFFF;
  VT_ILLEGALMASKED = $0FFF;
  VT_TYPEMASK = $0FFF;

const
  ole32 = 'ole32.dll';

function CoCreateInstance(const clsid: TGUID; unkOuter: IUnknown; dwClsContext: Longint; const iid: TGUID; out pv): HResult; stdcall; external ole32 name 'CoCreateInstance';

function OleInitialize(pwReserved: Pointer): HResult; stdcall; external ole32 name 'OleInitialize';

procedure OleUninitialize; stdcall; external ole32 name 'OleUninitialize';

procedure CoTaskMemFree(pv: pointer); stdcall; external ole32 name 'CoTaskMemFree';
//procedure ReleaseStgMedium(pmedium:pointer); stdcall; external ole32 name 'ReleaseStgMedium';

function FreePropVariantArray(cVariants: ULONG; rgvars: PPROPVARIANT): HRESULT; stdcall; external ole32 name 'FreePropVariantArray';

constructor TIEWia.Create(parent: TComponent);
var
  callback:TWiaEventCallBack;
begin
  inherited Create;
  if not IEOleInitialized then
    OleInitialize(nil);
  fItemsTreeUpdated:=nil;
  fCtrlParent := parent;
  fMultiCallBack := nil;
  fOnProgress := nil;
  ProcessingBitmap := nil;
  fDevicesInfo := TList.Create;
  fRoot := nil;
  fIWiaDevMgr := nil;
  fTakePicture:=true;
  fDeleteTakenPicture:=false;
  fSaveTransferBufferAs:='';
  fTransferFormat:=ietfDefault;
  fCurrentIndex:=0;
  CoCreateInstance(CLSID_WiaDevMgr, nil, CLSCTX_LOCAL_SERVER, IID_IWiaDevMgr, fIWiaDevMgr);

  fEventCallBack1:=nil;
  fEventCallBack2:=nil;
  fEventCallBack3:=nil;
  if fIWIADevMgr<>nil then
  begin
    callback:=TWiaEventCallBack.Create(self); // this object will become fEventCallBack1
    fIWiaDevMgr.RegisterEventCallbackInterface(0, nil, @WIA_EVENT_ITEM_CREATED, callback, fEventCallBack1);

    callback:=TWiaEventCallBack.Create(self); // this object will become fEventCallBack2
    fIWiaDevMgr.RegisterEventCallbackInterface(0, nil, @WIA_EVENT_ITEM_DELETED, callback, fEventCallBack2);

    callback:=TWiaEventCallBack.Create(self); // this object will become fEventCallBack3
    fIWiaDevMgr.RegisterEventCallbackInterface(0, nil, @WIA_EVENT_TREE_UPDATED, callback, fEventCallBack3);
  end;

end;

destructor TIEWia.Destroy;
begin
  // unregister events
  fEventCallBack1:=nil;
  fEventCallBack2:=nil;
  fEventCallBack3:=nil;
  //
  fIWiaDevMgr := nil;
  EmptyDeviceInfo;
  FreeAndNil(fDevicesInfo);
  if assigned(fRoot) then
    FreeAndNil(fRoot);
  inherited;
end;

procedure TIEWia.EmptyDeviceInfo;
begin
  while fDevicesInfo.Count > 0 do
  begin
    TIEWiaDeviceInfo(fDevicesInfo[0]).free;
    fDevicesInfo.Delete(0);
  end;
end;

function GET_STIDEVICE_TYPE(dwDevType: dword): integer;
begin
  result := HIWORD(dwDevType);
end;

function GET_STIDEVICE_SUBTYPE(dwDevType: dword): integer;
begin
  result := LOWORD(dwDevType);
end;

procedure TIEWia.FillDevices;
const
  PN = 7;
var
  pIEnumWIA_DEV_INFO: IEnumWIA_DEV_INFO;
  pIWiaPropStg: IWiaPropertyStorage;
  hr: HRESULT;
  ulFetched: integer;
  vPropSpec: array[0..PN - 1] of PROPSPEC;
  vPropVar: array[0..PN - 1] of PROPVARIANT;
  inf: TIEWiaDeviceInfo;
begin
  if fIWiaDevMgr = nil then
    exit;
  hr := fIWiaDevMgr.EnumDeviceInfo(WIA_DEVINFO_ENUM_LOCAL, pIEnumWIA_DEV_INFO);
  if hr <> 0 then
    exit;
  hr := pIEnumWIA_DEV_INFO.Reset;
  if hr <> 0 then
    exit;
  EmptyDeviceInfo;
  while true do
  begin
    hr := pIEnumWIA_DEV_INFO.Next(1, pIWiaPropStg, ulFetched);
    if (hr = 0) and (ulFetched = 1) then
    begin
      fillchar(vPropVar[0], sizeof(PROPVARIANT) * PN, 0);
      vPropSpec[0].ulKind := PRSPEC_PROPID;
      vPropSpec[0].propid := WIA_DIP_DEV_ID;
      vPropSpec[1].ulKind := PRSPEC_PROPID;
      vPropSpec[1].propid := WIA_DIP_DEV_NAME;
      vPropSpec[2].ulKind := PRSPEC_PROPID;
      vPropSpec[2].propid := WIA_DIP_DEV_TYPE;
      vPropSpec[3].ulKind := PRSPEC_PROPID;
      vPropSpec[3].propid := WIA_DIP_DRIVER_VERSION;
      vPropSpec[4].ulKind := PRSPEC_PROPID;
      vPropSpec[4].propid := WIA_DIP_PORT_NAME;
      vPropSpec[5].ulKind := PRSPEC_PROPID;
      vPropSpec[5].propid := WIA_DIP_SERVER_NAME;
      vPropSpec[6].ulKind := PRSPEC_PROPID;
      vPropSpec[6].propid := WIA_DIP_VEND_DESC;
      hr := pIWiaPropStg.ReadMultiple(PN, @vPropSpec[0], @vPropVar[0]);
      if hr = S_OK then
      begin
        inf := TIEWiaDeviceInfo.Create;
        inf.Name := vPropVar[1].bstrVal;
        inf.ID := vPropVar[0].bstrVal;
        case (vPropVar[2].lVal shr 16) and $FFFF of
          StiDeviceTypeScanner: inf.DeviceType := iewScanner;
          StiDeviceTypeDigitalCamera: inf.DeviceType := iewDigitalCamera;
          StiDeviceTypeStreamingVideo: inf.DeviceType := iewStreamingVideo;
        end;
        inf.DriverVersion := vPropVar[3].bstrVal;
        inf.PortName := vPropVar[4].bstrVal;
        inf.ServerName := vPropVar[5].bstrVal;
        inf.Vendor := vPropVar[6].bstrVal;
        fDevicesInfo.Add(inf);
      end;
      FreePropVariantArray(PN, @vPropVar[0]);
      pIWiaPropStg := nil;
    end
    else
      break;
  end;
end;

{!!
<FS>TIEWia.GetDeviceProperty

<FM>Declaration<FC>
function GetDeviceProperty(PropId:TPropID):Variant;

<FM>Description<FN>
Gets a device property value as Variant.
<A WIA device properties>.

<FM>Example<FC>
// returns the horizontal bed size
HorizBedSize := ImageEnView.IO.WiaParams.GetDeviceProperty(WIA_DPS_HORIZONTAL_BED_SIZE);
!!}
// if not connected, connect to first device
function TIEWia.GetDeviceProperty(PropId: dword): Variant;
begin
  if fRoot = nil then
    ConnectTo(0);
  result := GetItemProperty(PropId, fRoot);
end;

{!!
<FS>TIEWia.SetDeviceProperty

<FM>Declaration<FC>
function SetDeviceProperty(PropId: dword; val: integer): boolean;

<FM>Description<FN>
Sets a device property value as integer.
<A WIA device properties>.
!!}
// This is important starting at Delphi 6 because it requires typed constants otherwise the variant in invalid!
function TIEWia.SetDeviceProperty(PropId: dword; val: integer): boolean;
begin
  result:=SetDevicePropertyVariant(PropId,Variant(val));
end;

{!!
<FS>TIEWia.SetDevicePropertyVariant

<FM>Declaration<FC>
function SetDevicePropertyVariant(PropId: dword; val: Variant): boolean;

<FM>Description<FN>
Sets a device property value as Variant.
<A WIA device properties>.

<FM>Example<FC>
// sets the string to print (when the scanner supports the endorser)
ImageEnView.IO.WiaParams.SetDeviceProperty(WIA_DPS_ENDORSER_STRING, 'Hello World!');
!!}
// if not connected, connect to first device
function TIEWia.SetDevicePropertyVariant(PropId: dword; val: Variant): boolean;
begin
  if fRoot = nil then
    ConnectTo(0);
  result := SetItemProperty(PropId, val, fRoot);
end;

{!!
<FS>TIEWia.DevicesInfo

<FM>Declaration<FC>
property DevicesInfo[idx:integer]:<A TIEWiaDeviceInfo>;

<FM>Description<FN>
Returns info about the specified WIA device. TIEWiaDeviceInfo is defined with:

<FM>Example<FC>

// this fills a combobox with all installed devices
with ImageEnView.IO.WIAParams do
  for i:=0 to DevicesInfoCount-1 do
    ComboBox1.Items.Add( DevicesInfo[I].Name );
  end;
!!}
function TIEWia.GetDevicesInfo(idx: integer): TIEWiaDeviceInfo;
begin
  if fDevicesInfo.Count = 0 then
    FillDevices;
  if idx < fDevicesInfo.Count then
    result := fDevicesInfo[idx]
  else
    result := nil;
end;

procedure TIEWia.ConnectToDefault;
begin
  if fRoot = nil then
    ConnectTo(0);
end;

// if not connected, connect to first device

{!!
<FS>TIEWia.DevicesInfoCount

<FM>Declaration<FC>
property DevicesInfoCount:integer;

<FM>Description<FN>
Returns the number of WIA devices available.
!!}
function TIEWia.GetDevicesInfoCount: integer;
begin
  ConnectToDefault;
  if fDevicesInfo.Count = 0 then
    FillDevices;
  result := fDevicesInfo.Count;
end;

{!!
<FS>TIEWia.ConnectTo

<FM>Declaration<FC>
function ConnectTo(idx:integer):boolean;

<FM>Description<FN>
Connect to the specified device. Returns True if successful.

<FM>Example<FC>
ImageEnView.IO.WiaParams.ConnectTo( 1 );  // connect to the second device
ImageEnView.IO.Acquire(ieaWIA);  // acquire using connected device<FN>
!!}
function TIEWia.ConnectTo(idx: integer): boolean;
var
  hr: HRESULT;
  pw: pwchar;
  dinfo: TIEWiaDeviceInfo;
begin
  result := false;
  if fIWiaDevMgr = nil then
    exit;
  if assigned(fRoot) then
    FreeAndNil(fRoot);
  fRoot := nil;
  fCurrentIndex:=idx;
  dinfo := DevicesInfo[idx];
  if dinfo <> nil then