Xojo Conferences
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Win/WIA/List items WIA 2
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/List items WIA 2
This example is the version from Sun, 5th Nov 2016.
Project "List items WIA 2.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
EventHandler Sub Open() DeviceManager = new WIADeviceManager2MBS 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() // Vista and above dim it as WIAItemMBS = List.CellTag(List.ListIndex,0) dim p as WIAPropertyStorageMBS = it.PropertyStorage p.Write(p.kItemPropertyFormat, p.kImageFormatBMP) dim t as WIATransferMBS = it.Transfer if t<>Nil then dim c as new MyWIATransferCallbackMBS t.Download(c) MsgBox "File saved to desktop." else MsgBox "Transfer object not available." end if End Sub
Property DeviceManager As WIADeviceManager2MBS
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 MyWIATransferCallbackMBS Inherits WIATransferCallbackMBS
EventHandler Function GetNextStream(ItemName as string, FullItemName as string) As WIAStreamMBS dim f as FolderItem = SpecialFolder.Desktop.Child(ItemName) dim s as new WIAStreamMBS(WIAStreamMBS.kModeWrite + WIAStreamMBS.kModeCreate, f) Return s End EventHandler
EventHandler Function TransferCallback(w as WIATransferParamsMBS) As integer dim p as integer = W.PercentComplete MainWindow.bar.Value = p 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.




Links
MBS FileMaker blog