Platforms to show: All Mac Windows Linux Cross-Platform
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 Thu, 31th Jul 2019.
Project "List items WIA 1.xojo_binary_project"
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.NativePath
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:
The items on this page are in the following plugins: MBS Win Plugin.