Xojo Conferences
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Win/WIA/WIA Scan
Function:
Required plugins for this example: MBS Win Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Win/WIA/WIA Scan
This example is the version from Sun, 5th Nov 2016.
Project "WIA Scan.rbp"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
EventHandler Sub Open() if not TargetWin32 then MsgBox "This project needs Windows." end if End EventHandler
EventHandler Function UnhandledException(error As RuntimeException) As Boolean MsgBox Join(error.Stack, EndOfLine) End EventHandler
End Class
Class MainWindow Inherits Window
Control List Inherits Listbox
ControlInstance List Inherits Listbox
EventHandler Sub Change() if List.ListIndex >= 0 then dim v as Variant = List.RowTag(List.ListIndex) if v isa WIAItemMBS then dim it as WIAItemMBS = v ListProperties it TransferButton.Enabled=True TakePictureButton.Enabled = true Return elseif v isa WIAPropertyStorageMBS then dim it as WIAPropertyStorageMBS = v ListProperties it TransferButton.Enabled = false TakePictureButton.Enabled = false Return else MsgBox "no item or property storage." end if end if TransferButton.Enabled = false TakePictureButton.Enabled = false PList.DeleteAllRows End EventHandler
EventHandler Sub ExpandRow(row As Integer) dim v as Variant = List.RowTag(row) if v isa WIAItemMBS then dim it as WIAItemMBS = v EnumerateItems it end if End EventHandler
End Control
Control PList Inherits Listbox
ControlInstance PList Inherits Listbox
End Control
Control SelectDeviceDialogButton Inherits BevelButton
ControlInstance SelectDeviceDialogButton Inherits BevelButton
EventHandler Sub Action() dim it as WIAItemMBS = DeviceManager.SelectDeviceDialog(self, DeviceManager.kDeviceTypeDefault, DeviceManager.kSelectDeviceNoDefault) if it <> nil then List.DeleteAllRows AddItem it end if End EventHandler
End Control
Control TakePictureButton Inherits BevelButton
ControlInstance TakePictureButton Inherits BevelButton
EventHandler Sub Action() dim v as Variant = List.RowTag(list.ListIndex) if v isa WIAItemMBS then dim device as WIAItemMBS = v dim it as WIAItemMBS = device.DeviceCommand(device.kCommandTakePicture) if device.Lasterror<>0 then MsgBox "Lasterror: "+str(device.Lasterror)+EndOfLine+EndOfLine+GetWindowsErrorMessageMBS(device.Lasterror) end if if it<>Nil then AddItem it end if end if End EventHandler
End Control
Control TransferButton Inherits BevelButton
ControlInstance TransferButton Inherits BevelButton
EventHandler Sub Action() Transfer End EventHandler
End Control
Control bar Inherits ProgressBar
ControlInstance bar Inherits ProgressBar
End Control
Control ImageButton Inherits BevelButton
ControlInstance ImageButton Inherits BevelButton
EventHandler Sub Action() dim v as Variant = List.RowTag(list.ListIndex) dim SelectedDevice as WIAItemMBS if v isa WIAItemMBS then SelectedDevice = v end if if DeviceManager <> nil then dim DeviceType as integer = DeviceManager.kDeviceTypeDefault // or kDeviceTypeDigitalCamera, kDeviceTypeScanner, kDeviceTypeStreamingVideo dim flags as integer = 0 // flags: // DeviceManager.kSelectDeviceNoDefault: // Force this method to display the Select Device dialog box. For more information, see the Remarks section of this reference page. // DeviceManager.kDeviceDialogSingleImage // Restrict image selection to a single image in the device image acquisition dialog box. // DeviceManager.kDeviceDialogUseCommonUI // Use the system UI, if available, rather than the vendor-supplied UI. If the system UI is not available, the vendor UI is used. If neither UI is available, the function returns E_NOTIMPL. dim Intent as integer = DeviceManager.kIntentImageTypeColor // we like to get color preset dim root as WIAItemMBS = SelectedDevice // optional, can be nil dim file as FolderItem = SpecialFolder.Desktop.Child("test.jpg") DeviceManager.GetImageDialog(self, DeviceType, flags, intent, file, root) end if End EventHandler
End Control
Control Label1 Inherits Label
ControlInstance Label1 Inherits Label
End Control
Control SelectDeviceDialogButton1 Inherits BevelButton
ControlInstance SelectDeviceDialogButton1 Inherits BevelButton
EventHandler Sub Action() ListDevices End EventHandler
End Control
Control Label3 Inherits Label
ControlInstance Label3 Inherits Label
End Control
Control Label4 Inherits Label
ControlInstance Label4 Inherits Label
End Control
Control Label5 Inherits Label
ControlInstance Label5 Inherits Label
End Control
EventHandler Sub Open() DeviceManager = new WIADeviceManager1MBS if 0 = DeviceManager.Handle then MsgBox "Failed to initialize device manager." else end if End EventHandler
Sub AddItem(it as WIAItemMBS) dim p as WIAPropertyStorageMBS = it.PropertyStorage if p <> nil then dim v as Variant = p.Read(p.kDevicePropertyDevNameString) if v = nil then v = p.Read(p.kItemPropertyItemNameString) end if dim name as string = v System.DebugLog "Name: "+name if BitwiseAnd(it.ItemType,it.kTypeFolder)=it.kTypeFolder or BitwiseAnd(it.ItemType, it.kTypeHasAttachments)=it.kTypeHasAttachments then List.addfolder name else List.addrow name end if List.RowTag(List.LastIndex) = it end if End Sub
Sub EnumerateItems(root as WIAItemMBS) dim e as WIAItemEnumeratorMBS = Root.EnumerateChildItems System.DebugLog "EnumerateChildItems: "+str(root.Lasterror) if e <> Nil then dim it as WIAItemMBS = e.NextItem while it<>nil AddItem it it = e.NextItem wend end if End Sub
Sub ListDevices() List.DeleteAllRows PList.DeleteAllRows const WIA_DEVINFO_ENUM_LOCAL = &h10 dim e as WIADeviceInfoEnumeratorMBS = DeviceManager.EnumDeviceInfo(WIA_DEVINFO_ENUM_LOCAL) dim d as WIAPropertyStorageMBS = e.NextItem while d <> nil dim DeviceID as string = d.Read(d.kDevicePropertyDevIdString) System.DebugLog "DeviceID: "+DeviceID dim Device as WIAItemMBS = DeviceManager.CreateDevice(DeviceID) if Device = nil then Break else AddItem device end if d = e.NextItem wend End Sub
Sub ListProperties(it as WIAItemMBS) PList.DeleteAllRows dim p as WIAPropertyStorageMBS = it.PropertyStorage if p<>Nil then ListProperties p end if End Sub
Sub ListProperties(p as WIAPropertyStorageMBS) PList.DeleteAllRows dim e as WIAPropertyEnumeratorMBS = p.Enumerate if e<>nil then dim ps as WIAPropertyMBS = e.NextItem while ps<>Nil dim v as Variant = p.Read(ps) dim k as string = ps.Name if len(k)=0 then k = str(ps.ID) end if PList.AddRow k if v.Type = v.TypeObject then if v isa WIAGUIDMBS then dim g as WIAGUIDMBS = v PList.Cell(PList.LastIndex,1)=g.DisplayString else PList.Cell(PList.LastIndex,1)="? some object" end if else PList.Cell(PList.LastIndex,1)=v.StringValue end if ps = e.NextItem wend end if End Sub
Sub Transfer() dim v as Variant = List.RowTag(List.ListIndex) if v isa WIAItemMBS then dim it as WIAItemMBS = v dim p as WIAPropertyStorageMBS = it.PropertyStorage p.Write(p.kItemPropertyFormat, p.kImageFormatBMP) p.Write(p.kItemPropertyTymed, p.kTymedFile) dim t as WIADataTransferMBS = it.DataTransfer if t<>Nil then dim c as new MyWIADataCallbackMBS dim f as FolderItem = T.GetDataFile(c) if f=nil then MsgBox "Failed to get a path." else MsgBox "File saved to: "+f.AbsolutePath dim pic as Picture = Picture.Open(f) if pic=nil then MsgBox "Failed to load picture." else dim w as new PicWindow w.Backdrop = pic w.Title = f.name w.show end if end if else MsgBox "DataTransfer object not available." end if end if End Sub
Property DeviceManager As WIADeviceManager1MBS
End Class
MenuBar MenuBar1
MenuItem FileMenu = "&Ablage"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Bearbeiten"
MenuItem EditUndo = "&Rückgängig"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "&Ausschneiden"
MenuItem EditCopy = "&Kopieren"
MenuItem EditPaste = "&Einfügen"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "&Alles auswählen"
End MenuBar
Class MyWIADataCallbackMBS Inherits WIADataCallbackMBS
EventHandler Function BandedDataCallback(message as integer, Status as integer, PercentComplete as integer, Offset as integer, Length as integer, Buffer as memoryblock) As integer MainWindow.bar.value = PercentComplete End EventHandler
End Class
Class PicWindow Inherits Window
End Class
End Project

Feedback, Comments & Corrections

The items on this page are in the following plugins: MBS Win Plugin.




Links
MBS Xojo Plugins