---

Datei: dlgWIA.pas

---

// -------------------------------------------------------------------------
//  Demo:
//  WIA in Delphi über Skripting-Interface verwenden
// -------------------------------------------------------------------------
unit dlgWIA;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,WIALib_TLB, ExtCtrls, ComCtrls;

type
  TfrmWIA = class(TForm)
    PageControl1: TPageControl;
    tsLog: TTabSheet;
    tsImage: TTabSheet;
    memLog: TMemo;
    imgImage: TImage;
    btnGo: TButton;
    StatusBar1: TStatusBar;
    procedure btnGoClick(Sender: TObject);
  private
    procedure Log(S: string); overload;
    procedure LogNewLine;
    procedure Log(S: string; Params: array of const); overload;
    procedure LogSeparator;
    procedure OutputItem(Item: IWiaDispatchItem; Name: string);
    procedure OutputDevice(Device: IWiaDeviceInfo; Name: string);
    function GetTempFileName: string;
    function GetDesktopFileName: string;
    function ExecuteFile(FileName: string): Boolean;
  public
  end;

var
  frmWIA: TfrmWIA;

implementation

uses JPEG, shlobj, ActiveX, ShellAPI;

{$R *.dfm}

// ------------------------------------------------
//  WIA-Aktion
// ------------------------------------------------
procedure TfrmWIA.btnGoClick(Sender: TObject);
var
  I: Integer;

  Wia: IWia;
  Device: IWiaDeviceInfo;
  DeviceItem: IWiaDispatchItem;
  ImageItem: IWiaDispatchItem;
  Coll: ICollection;

  FileName: string;
  JPEG: TJPEGImage;
begin
  imgImage.Picture:= nil;
  LogSeparator;

  // Einstiegspunkt in WIA  
  Wia:= CoWia.Create;

  // Anzahl Geräte
  Log('Anzahl Geräte: %d', [Wia.Devices.Count]);
  LogNewLine;

  // Infos über alle Geräte ausgeben
  for I:= 0 to Wia.Devices.Count-1 do
  begin
    Device:= WIA.Devices.Item[I] as IWiaDeviceInfo;
    OutputDevice(Device, 'Nr. ' + IntToStr(I+1));
  end;

  // Mit einem Gerät kommunizieren
  if Wia.Devices.Count > 0 then
  begin
    Log('Verbinden mit Gerät...');

    // Mit erstem Gerät verbinden
    Device:= WIA.Devices.Item[0] as IWiaDeviceInfo;
    DeviceItem:= Device.Create;

    // Alternativ Benutzer ein Gerät interaktiv wählen lassen
    // DeviceItem:= WIA.Create(EmptyParam);

    // Infos über Gerät und darauf befindliche Bilder anzeigen
    OutputItem(DeviceItem, 'Gewähltes Gerät');
    for I:= 0 to DeviceItem.Children.Count - 1 do
    begin
      ImageItem:= DeviceItem.Children.Item[I] as IWiaDispatchItem;
      OutputItem(ImageItem, 'Bild Nr. ' + IntToStr(I+1));
    end;

    // Ein Bild per UI besorgen
    // Alternativ mit TakePicture
    LogSeparator;
    Log('Bild von Gerät besorgen...');
    Coll:= DeviceItem.GetItemsFromUI(SingleImage, MaximizeQuality);

    if Coll.Count > 0 then
    begin
      ImageItem:= Coll.Item[0] as IWiaDispatchItem;
      OutputItem(ImageItem, 'Ausgewähltes Bild');

      // Bild in temporärer Datei auf Festplatte speichern
      FileName:= GetTempFileName;
      ImageItem.Transfer(FileName, False);

      // Bild anzeigen
      imgImage.Picture.Bitmap.LoadFromFile(FileName);

      // Temporäre Datei löschen
      DeleteFile(FileName);

      // Bild als JPEG auf Desktop speichern
      FileName:= GetDesktopFileName;
      Jpeg:= TJPEGImage.Create;
      try
        JPEG.Assign(imgImage.Picture.Graphic);
        JPEG.SaveToFile(FileName);
      finally
        FreeAndNil(JPEG);
      end;

      // JPEG öffnen
      ExecuteFile(FileName);
    end;
  end;
end;

// ------------------------------------------------
//  WIA-Objekte in Memo ausgeben
// ------------------------------------------------
procedure TfrmWIA.OutputDevice(Device: IWiaDeviceInfo; Name: string);
begin
    Log('Gerät %s hat folgende Eigenschaften:', [Name]);

    Log('Name: %s',  [Device.Name]);
    Log('ID: %s',  [Device.Id]);
    Log('Typ: %s',  [Device.type_]);
    Log('Port: %s',  [Device.Port]);
    Log('Hersteller: %s',  [Device.Manufacturer]);
    Log('UIClsid: %s',  [Device.UIClsid]);

    LogNewLine;
end;

procedure TfrmWIA.OutputItem(Item: IWiaDispatchItem; Name: string);
begin
    Log('Item %s hat folgende Eigenschaften:', [Name]);

    Log('Name: %s',  [Item.Name]);
    Log('Fullname: %s',  [Item.FullName]);
    Log('Typ: %s',  [Item.ItemType]);
    Log('Breite: %d',  [Item.Width]);
    Log('Höhe: %d',  [Item.Height]);
    Log('Bildbreite: %d',  [Item.PictureWidth]);
    Log('Bildhöhe: %d',  [Item.PictureHeight]);
    Log('Verbindungsstatus: %s',  [Item.ConnectStatus]);
    Log('Anzahl Kinder: %d',  [Item.Children.Count]);
    Log('Zeit: %s',  [Item.Time]);
    Log('Firmware: %s',  [Item.FirmwareVersion]);

    LogNewLine;
end;

// ------------------------------------------------
//  Text in Memo ausgeben
// ------------------------------------------------

procedure TfrmWIA.Log(S: string);
begin
  memLog.Lines.Add(S);
end;

procedure TfrmWIA.Log(S: string; Params: array of const);
begin
  Log(Format(S, Params));
end;

procedure TfrmWIA.LogNewLine;
begin
  Log('');
end;

procedure TfrmWIA.LogSeparator;
begin
  LogNewLine;
  Log('----------------------------------------------------------');
  LogNewLine;
end;

// ------------------------------------------------
//  Dateinamen ermitteln
// ------------------------------------------------
function WinGetTempFileName(prefix: string): string;
var
  TempDir: String;
  Buffer: String;
  Size: Integer;
begin
  SetLength(prefix, 3);

  Size := Windows.GetTempPath(0, nil);
  SetLength(TempDir, Size);
  Windows.GetTempPath(Size, PChar(TempDir));

  SetLength( Buffer, MAX_PATH-14 );
  Windows.GetTempFileName(PChar(TempDir), PChar(Prefix), 0, PChar(Buffer));

  Result:= StrPas(PAnsiChar(Buffer));
end;

function GetShellDirectory(ID: Integer): string;
var
  S: string;
  ItemIDList: PItemIDList;
  SystemHeap: IMalloc;
begin
  Result := EmptyStr;

  if SHGetSpecialFolderLocation(Forms.Application.Handle, ID, ItemIDList) = NOERROR then
  begin
    try
      SetLength(S, MAX_PATH);
      if SHGetPathFromIDList(ItemIDList, PChar(S)) then
      begin
        Result:= Copy(S, 1, Pos(#0, S) - 1);
      end;
    finally
      // Von der Shell reservierten Speicher freigeben
      if SHGetMalloc(SystemHeap) = NOERROR then
      begin
        SystemHeap.Free(ItemIDList);
      end;
    end;
  end;
end;

function TfrmWIA.GetTempFileName: string;
begin
  Result:= WinGetTempFileName('WIA');
end;

function TfrmWIA.GetDesktopFileName: string;
begin
  Result:= GetShellDirectory(CSIDL_DESKTOP);
  Result:= IncludeTrailingPathDelimiter(Result);
  Result:= Result + 'WIA_Demo.jpeg';
end;

// ------------------------------------------------
//  Datei ausführen
// ------------------------------------------------
function TfrmWIA.ExecuteFile(FileName: string): Boolean;
var
  Res: Integer;
begin
  Res:= ShellExecute(Forms.Application.Handle, nil, PChar(FileName), nil, nil, SW_SHOWNORMAL);
  Result:= Res > 32;
end;

end.

---

Datei: dlgWIA.dfm

---

object frmWIA: TfrmWIA
  Width = 870
  Height = 640
  Caption = 'WIA'
  Position = poScreenCenter
  object PageControl1: TPageControl
    ActivePage = tsLog
    Align = alClient
    TabOrder = 0
    object tsLog: TTabSheet
      Caption = 'Log'
      object memLog: TMemo
        Align = alClient
        ScrollBars = ssVertical
        TabOrder = 0
      end
    end
    object tsImage: TTabSheet
      Caption = 'Bild'
      ImageIndex = 1
      object imgImage: TImage
        Align = alClient
        Center = True
        Proportional = True
        Stretch = True
      end
    end
  end
  object btnGo: TButton
    Left = 728
    Top = 4
    Width = 123
    Height = 49
    Anchors = [akTop, akRight]
    Caption = 'Go!'
    TabOrder = 1
    OnClick = btnGoClick
  end
  object StatusBar1: TStatusBar
  end
end

---