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/WIA Scan
This example is the version from Thu, 31th Jul 2019.
Project "WIA Scan.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
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.NativePath
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
The items on this page are in the following plugins: MBS Win Plugin.
