iewia.pas

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

  begin
    getmem(pw, 256);
    StringToWideChar(dinfo.ID, pw, 256); // calling DevicesInfo fills it
    fRoot := TIEWiaItem.Create;

    hr := fIWiaDevMgr.CreateDevice(pwidechar(widestring(pw)), fRoot.this);  // fix for Delphi 2006
    //hr := fIWiaDevMgr.CreateDevice(pw, fRoot.this);

    freemem(pw);
    if hr = S_OK then
    begin
      if dinfo.DeviceType=iewDigitalCamera then
        fTakePicture:=false
      else
        fTakePicture:=true;
      result := true;
      FillItemChildren(fRoot);
    end
    else
    begin
      FreeAndNil(fRoot);
    end;
  end;
end;

{!!
<FS>TIEWia.UpdateItems

<FM>Declaration<FC>
procedure UpdateItems;

<FM>Description<FN>
Reload items tree.
!!}
procedure TIEWia.UpdateItems;
begin
  if fRoot<>nil then
  begin
    while fRoot.Children.Count > 0 do
    begin
      TIEWiaItem(fRoot.Children[0]).Free;
      fRoot.Children.Delete(0);
    end;
    FillItemChildren(fRoot);
  end;
end;

{!!
<FS>TIEWia.ConnectToUsingDialog

<FM>Declaration<FC>
function ConnectToUsingDialog:boolean;

<FM>Description<FN>
Shows a system dialog that allows users to select a WIA device. Returns True if user presses OK.

<FM>Example<FC>
If ImageEnView.IO.WiaParams.ConnectToUsingDialog then
  ImageEnView.IO.Acquire(ieaWIA);
!!}
function TIEWia.ConnectToUsingDialog: boolean;
var
  hr: HRESULT;
  pw: pwchar;
  i: integer;
  dinfo: TIEWiaDeviceInfo;
  ss: string;
begin
  result := false;
  if fIWiaDevMgr = nil then
    exit;
  if assigned(fRoot) then
    FreeAndNil(fRoot);
  hr := fIWiaDevMgr.SelectDeviceDlgID(IEFindHandle(fCtrlParent), StiDeviceTypeDefault, WIA_SELECT_DEVICE_NODEFAULT, pw);
  if hr <> S_OK then
    exit;
  // search device index
  ss:=WideCharToString(pw);
  GetDevicesInfo(0);  // this will fill fDevicesInfo list, if needed
  for i:=0 to fDevicesInfo.Count-1 do
  begin
    dinfo := DevicesInfo[i];
    if dinfo.ID = ss then
    begin
      result:= ConnectTo( i );
      break;
    end;
  end;
end;

function BuildWiaItemType(lType: integer): TIEWiaItemType;
begin
  result := [];
  if (lType and WiaItemTypeFree) <> 0 then
    result := result + [witFree];
  if (lType and WiaItemTypeImage) <> 0 then
    result := result + [witImage];
  if (lType and WiaItemTypeFile) <> 0 then
    result := result + [witFile];
  if (lType and WiaItemTypeFolder) <> 0 then
    result := result + [witFolder];
  if (lType and WiaItemTypeRoot) <> 0 then
    result := result + [witRoot];
  if (lType and WiaItemTypeAnalyze) <> 0 then
    result := result + [witAnalyze];
  if (lType and WiaItemTypeAudio) <> 0 then
    result := result + [witAudio];
  if (lType and WiaItemTypeDevice) <> 0 then
    result := result + [witDevice];
  if (lType and WiaItemTypeDeleted) <> 0 then
    result := result + [witDeleted];
  if (lType and WiaItemTypeDisconnected) <> 0 then
    result := result + [witDisconnected];
  if (lType and WiaItemTypeHPanorama) <> 0 then
    result := result + [witHPanorama];
  if (lType and WiaItemTypeVPanorama) <> 0 then
    result := result + [witVPanorama];
  if (lType and WiaItemTypeBurst) <> 0 then
    result := result + [witBurst];
  if (lType and WiaItemTypeStorage) <> 0 then
    result := result + [witStorage];
  if (lType and WiaItemTypeTransfer) <> 0 then
    result := result + [witTransfer];
  if (lType and WiaItemTypeGenerated) <> 0 then
    result := result + [witGenerated];
  if (lType and WiaItemTypeHasAttachments) <> 0 then
    result := result + [witHasAttachments];
  if (lType and WiaItemTypeVideo) <> 0 then
    result := result + [witVideo];
  if (lType and WiaItemTypeTwainCapabilityPassThrough) <> 0 then
    result := result + [witTwainCapabilityPassThrough];
  if (lType and WiaItemTypeRemoved) <> 0 then
    result := result + [witRemoved];
  if (lType and WiaItemTypeMask) <> 0 then
    result := result + [witMask];
end;

{!!
<FS>TIEWia.ShowAcquireDialog

<FM>Declaration<FC>
function ShowAcquireDialog(SystemDialog:boolean):boolean;

<FM>Description<FN>
Shows a system dialog that allows user to set parameters and display a preview of the image.
You still need to call <A TImageEnIO.Acquire> to get the image.
Returns True if user presses OK (or Acquire).

<FM>Example<FC>

If ImageEnView.IO.WiaParams.ShowAcquireDialog(true) then
  ImageEnView.IO.Acquire(ieaWIA);
!!}
// if not connected, connect to first device
// this free and refill al children of fRoot
function TIEWia.ShowAcquireDialog(SystemDialog: boolean): boolean;
var
  hr: HRESULT;
  items: PIWiaItemArray;
  itemsCount: integer;
  i, flags: integer;
  iewi: TIEWiaItem;
  lType: integer;
begin
  result := false;
  if fIWiaDevMgr = nil then
    exit;
  ConnectToDefault;
  if fRoot = nil then
    exit;
  // free fRoot children
  while fRoot.Children.Count > 0 do
  begin
    TIEWiaItem(fRoot.Children[0]).Free;
    fRoot.Children.Delete(0);
  end;
  //
  flags := 0;
  if SystemDialog then
    flags := flags or WIA_DEVICE_DIALOG_USE_COMMON_UI;
  hr := fRoot.This.DeviceDlg(IEFindHandle(fCtrlParent), flags, WIA_INTENT_NONE, itemsCount, items);
  if hr <> S_OK then
    exit;
  for i := 0 to itemsCount - 1 do
  begin
    iewi := TIEWiaItem.Create;
    items[i].QueryInterface(IWiaItem, iewi.This);
    fRoot.Children.Add(iewi);
    iewi.This.GetItemType(lType);
    iewi.ItemType := BuildWiaItemType(lType);
    if (lType and WiaItemTypeFolder) <> 0 then
      // this is a folder
      FillItemChildren(iewi);
  end;
  CoTaskMemFree(items);
  result := true;
end;

constructor TIEWiaItem.Create;
begin
  inherited;
  This := nil;
  Children := TList.Create;
  ItemType := [];
end;

destructor TIEWiaItem.Destroy;
begin
  This := nil; // free the old object
  while Children.Count > 0 do
  begin
    TIEWiaItem(Children[0]).Free;
    Children.Delete(0);
  end;
  FreeAndNil(Children);
  inherited;
end;

procedure TIEWia.FillItemChildren(parent: TIEWiaItem);
var
  hr: HRESULT;
  enum: IEnumWiaItem;
  iewi: TIEWiaItem;
  wi: IWiaItem;
  fetched, lType: integer;
begin
  if assigned(parent.This) then
  begin
    // get item type of the parent (useful only if the parent is the root)
    parent.This.GetItemType(lType);
    parent.ItemType := BuildWiaItemType(lType);
    //
    hr := parent.This.EnumChildItems(enum);
    if hr <> S_OK then
      exit;
    while enum.Next(1, wi, fetched) = S_OK do
    begin
      iewi := TIEWiaItem.Create;
      iewi.This := wi;
      parent.Children.Add(iewi);
      wi.GetItemType(lType);
      iewi.ItemType := BuildWiaItemType(lType);
      if (lType and WiaItemTypeFolder) <> 0 then
        // this is a folder
        FillItemChildren(iewi);
    end;
    enum := nil;
  end;
end;

{!!
<FS>TIEWia.Device

<FM>Declaration<FC>
property Device:<A TIEWiaItem>;

<FM>Description<FN>
Returns the currently connected (selected) device. This is the 'root' item.
!!}
function TIEWia.GetRoot: TIEWiaItem;
begin
  result := fRoot;
end;

function GetFirstImageItem(Current: TIEWiaItem): TIEWiaItem;
var
  i: integer;
begin
  result := nil;
  if Current = nil then
    exit;
  if witImage in Current.ItemType then
    result := Current
  else if witFolder in Current.ItemType then
    for i := 0 to Current.Children.Count - 1 do
    begin
      result := GetFirstImageItem(TIEWiaItem(Current.Children[i]));
      if result <> nil then
        exit; // found one
    end;
end;

function GetLastImageItem(Current: TIEWiaItem): TIEWiaItem;
var
  i: integer;
begin
  result := nil;
  if Current = nil then
    exit;
  if witImage in Current.ItemType then
    result := Current
  else if witFolder in Current.ItemType then
    for i := Current.Children.Count - 1 downto 0 do
    begin
      result := GetLastImageItem(TIEWiaItem(Current.Children[i]));
      if result <> nil then
        exit; // found one
    end;
end;


(*
procedure ConvertGUIDToPROPVARIANT(gg:TGUID; outvar:PPROPVARIANT);
begin
 zeromemory(outvar,sizeof(PROPVARIANT));
   outvar.vt:=VT_CLSID;
 outvar.puuid:=
end;
*)

function ConvertPROPVARIANTGUID_ToString(invar: PPROPVARIANT): string;
begin
  result := IEConvertGUIDToString(invar^.puuid);
end;

function ConvertPROPVARIANT_ToSmallIntArray(invar:PPROPVARIANT):variant;
var
  i:integer;
begin
  result:=VarArrayCreate([0,invar^.caui.cElems-1],varSmallInt);
  for i:=0 to invar^.caui.cElems-1 do
    result[i]:=invar^.caui.pElems[i];
end;

function ConvertPROPVARIANT_ToByteArray(invar:PPROPVARIANT):variant;
var
  i:integer;
begin
  result:=VarArrayCreate([0,invar^.caub.cElems-1],varByte);
  for i:=0 to invar^.caub.cElems-1 do
    result[i]:=invar^.caub.pElems[i];
end;

{$OPTIMIZATION OFF}
// this allows to get unsupported values by Variant (as GUID)

function PropVariantToVariant(vv: PPROPVARIANT): Variant;
var
  xv: variant;
begin
  case vv^.vt of
    VT_CLSID:
      result := ConvertPROPVARIANTGUID_ToString(vv);
    VT_UI2 or VT_VECTOR:
      // array of words
      result := ConvertPROPVARIANT_ToSmallIntArray(vv);
    VT_UI1 or VT_VECTOR:
      // array of bytes
      result := ConvertPROPVARIANT_ToByteArray(vv);
    else
    begin
      try
      copymemory(@TVarData(xv), vv, sizeof(PROPVARIANT));
      result := xv;
      zeromemory(@TVarData(xv), sizeof(PROPVARIANT));
      except
      end;
    end;
  end;
end;

// this allows to get unsupported values by Variant (as GUID)

procedure VariantToPropVariant(invar: Variant; outvar: PPROPVARIANT);
var
  xv: variant;
  IsString: boolean;
  IsStringGuid: boolean;
  ss: string;
  gg: PGUID;
begin
  IsString := (TVarData(invar).VType and varString) <> 0;
  IsStringGuid := false;
  if IsString then
  begin
    // check if it is a string guid
    ss := invar;
    IsStringGuid := (length(ss) >= 38) and (ss[10] = '-') and (ss[15] = '-') and (ss[20] = '-') and (ss[25] = '-') and (ss[1] = '{') and (ss[38] = '}');
  end;
  if IsStringGuid then
  begin
    getmem(gg, sizeof(TGUID));
    IEConvertStringToGUID(invar, gg);
    zeromemory(outvar, sizeof(PROPVARIANT));
    outvar^.vt := VT_CLSID;
    outvar^.puuid := gg;
  end
  else
  begin
    xv := invar;
    copymemory(outvar, @TVarData(xv), sizeof(PROPVARIANT));
    zeromemory(@TVarData(xv), sizeof(PROPVARIANT));
  end;
end;

// use this only with PROPVARIANTs created using VariantTopropVariant

procedure FreeCreatedPropVariant(invar: PPROPVARIANT);
var
  xv: variant;
begin
  if invar^.vt=VT_CLSID t