Xojo Conferences

Platforms to show: All Mac Windows Linux Cross-Platform

/Win/WIA/List items WIA 1
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/List items WIA 1
This example is the version from Sun, 5th Nov 2016.
Project "List items WIA 1.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
End Class
Class MainWindow Inherits Window
Control List Inherits Listbox
ControlInstance List Inherits Listbox
EventHandler Sub Change() if List.ListIndex>=0 then dim it as WIAItemMBS = List.CellTag(List.ListIndex,0) ListProperties it BevelButton3.Enabled=True else BevelButton3.Enabled=false PList.DeleteAllRows end if End EventHandler
EventHandler Sub ExpandRow(row As Integer) dim it as WIAItemMBS = List.CellTag(row,0) if it<>nil then EnumerateItems it end if End EventHandler
End Control
Control PList Inherits Listbox
ControlInstance PList Inherits Listbox
End Control
Control BevelButton1 Inherits BevelButton
ControlInstance BevelButton1 Inherits BevelButton
EventHandler Sub Action() List.DeleteAllRows if device<>Nil then AddItem Device end if End EventHandler
End Control
Control BevelButton2 Inherits BevelButton
ControlInstance BevelButton2 Inherits BevelButton
EventHandler Sub Action() 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 EventHandler
End Control
Control BevelButton3 Inherits BevelButton
ControlInstance BevelButton3 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() 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 = Device // 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
EventHandler Sub Open() DeviceManager = new WIADeviceManager1MBS if 0 = DeviceManager.Handle then MsgBox "Failed to initialize device manager." else dim it as WIAItemMBS = DeviceManager.SelectDeviceDialog(self, DeviceManager.kDeviceTypeDefault, DeviceManager.kSelectDeviceNoDefault) if it<>Nil then AddItem it device = it BevelButton2.Enabled=true end if end if End EventHandler
Sub AddItem(it as WIAItemMBS) dim p as WIAPropertyStorageMBS = it.PropertyStorage dim name as string = p.Read(p.kItemPropertyItemNameString) 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.CellTag(List.LastIndex,0)=it End Sub
Sub EnumerateItems(root as WIAItemMBS) dim e as WIAItemEnumeratorMBS = Root.EnumerateChildItems if e<>Nil then dim it as WIAItemMBS = e.NextItem while it<>nil AddItem it it = e.NextItem wend end if End Sub
Sub ListProperties(it as WIAItemMBS) PList.DeleteAllRows dim p as WIAPropertyStorageMBS = it.PropertyStorage if p<>Nil then 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 if End Sub
Protected Sub Transfer() dim it as WIAItemMBS = List.CellTag(List.ListIndex,0) 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 = f.OpenAsPicture 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 Sub
Property DeviceManager As WIADeviceManager1MBS
Property device As WIAItemMBS
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

See also:

Feedback, Comments & Corrections

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

MBS Xojo Plugins