Platforms to show: All Mac Windows Linux Cross-Platform
Required plugins for this example: MBS MacBase Plugin, MBS MacCG Plugin, MBS Mac64bit Plugin, MBS MacCloud Plugin, MBS Main Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Mac64bit/Photos/Photos
This example is the version from Sat, 24th Apr 2020.
Project "Photos.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
EventHandler Sub Open()
Dim authorizationStatus As Integer = PHPhotoLibraryMBS.authorizationStatus
Select Case authorizationStatus
Case PHPhotoLibraryMBS.PHAuthorizationStatusAuthorized
'MsgBox "Authorized"
Start
Case PHPhotoLibraryMBS.PHAuthorizationStatusDenied
MsgBox "Denied"
Case PHPhotoLibraryMBS.PHAuthorizationStatusNotDetermined
'MsgBox "NotDetermined"
PhotoLibrary.requestAuthorization AddressOf AuthorizationCompleted
Case PHPhotoLibraryMBS.PHAuthorizationStatusRestricted
MsgBox "Restricted"
End Select
End EventHandler
Sub AuthorizationCompleted(Status as Integer, tag as Variant)
Select Case Status
Case PHPhotoLibraryMBS.PHAuthorizationStatusAuthorized
'MsgBox "Authorized"
Start
Case PHPhotoLibraryMBS.PHAuthorizationStatusDenied
MsgBox "Denied"
Case PHPhotoLibraryMBS.PHAuthorizationStatusNotDetermined
MsgBox "NotDetermined"
Case PHPhotoLibraryMBS.PHAuthorizationStatusRestricted
MsgBox "Restricted"
End Select
End Sub
Sub Start()
PhotoLibrary = new PHPhotoLibrary
MainWindow.show
End Sub
Property PhotoLibrary As PHPhotoLibraryMBS
End Class
Class MainWindow Inherits Window
Control List Inherits Listbox
ControlInstance List Inherits Listbox
EventHandler Function CellTextPaint(g As Graphics, row As Integer, column As Integer, x as Integer, y as Integer) As Boolean
Dim v As Variant = Me.RowTag(row)
If v IsA PHAssetMBS Then
Dim asset As PHAssetMBS = v
// load picture as needed
If list.CellTag(List.LastIndex,0) = Nil Then
Dim pic As Picture = LoadAssetPicture(asset)
list.CellTag(List.LastIndex,0) = pic
end if
End If
Dim p As Picture = Me.CellTag(row, 0)
If p <> Nil Then
Dim faktor As Double = g.Height / p.Height
// Calculate new size
Dim w As Integer = p.Width * faktor
Dim h As Integer = p.Height * faktor
// draw picture in the new size
g.DrawPicture p, 0, 0, w, h, 0, 0, p.Width, p.Height
Return True
End If
End EventHandler
EventHandler Sub Change()
If Me.ListIndex >= 0 Then
Dim v As Variant = Me.RowTag(Me.ListIndex)
If v IsA PHAssetMBS Then
Dim p As PHAssetMBS = v
If CurrentAsset <> p Then
LoadAsset p
End If
End If
End If
End EventHandler
EventHandler Sub ExpandRow(row As Integer)
Dim v As Variant = Me.RowTag(row)
If v IsA PHFetchResultMBS Then
Dim folders As PHFetchResultMBS = v
AddFetchResult folders
Elseif v IsA PHCollectionListMBS Then
Dim c As PHCollectionListMBS = v
Dim r As PHFetchResultMBS = PHCollectionMBS.fetchCollectionsInCollectionList(c)
If r <> Nil Then
AddFetchResult r
End If
Elseif v IsA PHAssetCollectionMBS Then
Dim c As PHAssetCollectionMBS = v
Dim r As PHFetchResultMBS = PHAssetMBS.fetchAssetsInAssetCollection(c)
If r <> Nil Then
AddFetchResult r
End If
Else
Break
End If
End EventHandler
End Control
Control Output Inherits Canvas
ControlInstance Output Inherits Canvas
EventHandler Sub Paint(g As Graphics, areas() As REALbasic.Rect)
If pic <> Nil Then
Dim faktor As Double = Min( g.Height / Pic.Height, g.Width / Pic.Width)
// Calculate new size
Dim w As Integer = Pic.Width * faktor
Dim h As Integer = Pic.Height * faktor
Dim dx As Integer = (g.Width - w)/2
Dim dy As Integer = (g.Height - h)/2
// draw picture in the new size
g.DrawPicture Pic, dx, dy, w, h, 0, 0, Pic.Width, Pic.Height
End If
End EventHandler
End Control
Control LivePhotoControl Inherits PHLivePhotoControlMBS
ControlInstance LivePhotoControl Inherits PHLivePhotoControlMBS
End Control
EventHandler Sub Open()
// put the LivePhotoControl where the Canvas is without making one parent of other
LivePhotoControl.Visible = False
LivePhotoControl.top = Output.top
LivePhotoControl.Left = Output.Left
LivePhotoControl.Width = Output.Width
LivePhotoControl.Height = Output.Height
ImageManager = New PHImageManagerMBS
AddCollectionList PHCollectionListMBS.TypeFolder, PHCollectionListMBS.SubtypeRegularFolder, "Folders"
AddCollectionList PHCollectionListMBS.TypeSmartFolder, PHCollectionListMBS.SubtypeSmartFolderEvents, "Events"
AddCollectionList PHCollectionListMBS.TypeSmartFolder, PHCollectionListMBS.SubtypeSmartFolderFaces, "Faces"
AddCollectionList PHCollectionListMBS.TypeMomentList, PHCollectionListMBS.SubtypeAny, "Moments"
AddAssetCollections PHAssetCollectionMBS.TypeAlbum, PHAssetCollectionMBS.SubtypeAny, "Albums"
AddAssetCollections PHAssetCollectionMBS.TypeSmartAlbum, PHAssetCollectionMBS.SubtypeAny, "Smart Albums"
AddAssetCollections PHAssetCollectionMBS.TypeMoment, PHAssetCollectionMBS.SubtypeAny, "Moments"
// look for those holding live photos, so we can show a few
AddAssetCollections PHAssetCollectionMBS.TypeSmartAlbum, PHAssetCollectionMBS.SubtypeSmartAlbumLivePhotos, "Live Photos"
Dim Folders As PHFetchResultMBS = PHCollectionListMBS.fetchTopLevelUserCollections
If folders <> Nil Then
list.AddFolderWithTag "Collections", folders
End If
End EventHandler
Sub AddAssetCollections(type as integer, subtype as integer, label as string)
Dim Folders As PHFetchResultMBS = PHAssetCollectionMBS.fetchAssetCollectionsWithType(type, subtype)
If folders <> Nil And folders.count > 0 Then
list.AddFolderWithTag label, folders
End If
End Sub
Sub AddCollectionList(type as integer, subtype as integer, label as string)
Dim Folders As PHFetchResultMBS = PHCollectionListMBS.fetchCollectionListsWithType(type, subtype)
If folders <> Nil And folders.count > 0 Then
list.AddFolderWithTag label, folders
End If
End Sub
Sub AddFetchResult(folders As PHFetchResultMBS)
Dim List As listbox = Self.List
Dim values() As Variant = folders.allObjects
For Each value As Variant In values
If value IsA PHCollectionListMBS Then
Dim p As PHCollectionListMBS = value
Dim t As String = p.localizedTitle
If t.Len = 0 Then
t = p.localIdentifier
End If
list.AddFolderWithTag t, p
Elseif value IsA PHAssetCollectionMBS Then
Dim p As PHAssetCollectionMBS = value
Dim t As String = p.localizedTitle
If t.Len = 0 Then
t = p.localIdentifier
End If
list.AddFolderWithTag t, p
Elseif value IsA PHCollectionMBS Then
Dim p As PHCollectionMBS = value
Dim t As String = p.localizedTitle
If t.Len = 0 Then
t = p.localIdentifier
End If
list.AddFolderWithTag t, p
Elseif value IsA PHAssetMBS Then
Dim p As PHAssetMBS = value
Dim t As String = p.localIdentifier
list.AddRowWithTag t, p
Else
Break
End If
Next
End Sub
Sub LoadAsset(p as PHAssetMBS)
if p = CurrentAsset then return // ignore
// don't need old one
If CurrentRequestID <> 0 Then
ImageManager.cancelImageRequest CurrentRequestID
CurrentRequestID = 0
End If
title = "Loading..."
CurrentAsset = p
Dim contentMode As Integer = ImageManager.ContentModeAspectFit
Dim targetSize As New CGSizeMBS(output.Width * 2, Output.Height * 2)
If PHLivePhotoRequestOptionsMBS.available And BitwiseAnd(p.mediaSubtypes, p.MediaSubtypePhotoLive) <> 0 Then
// live photo
Dim Handler As PHImageManagerMBS.RequestLivePhotoForAssetCompletedMBS = AddressOf requestLivePhotoForAssetCompleted
Dim options As New PHLivePhotoRequestOptionsMBS
// due to download, the handler is called twice, frist small, second large picture
options.NetworkAccessAllowed = True
CurrentRequestID = ImageManager.RequestLivePhotoForAsset(p, targetSize, ContentMode, options, Handler, Nil)
Else
// normal photo
Dim Handler As PHImageManagerMBS.RequestImageForAssetCompletedMBS = AddressOf requestImageForAssetCompleted
Dim options As New PHImageRequestOptionsMBS
// due to download, the handler is called twice, frist small, second large picture
options.Synchronous = False
options.NetworkAccessAllowed = True
CurrentRequestID = ImageManager.RequestImageForAsset(p, targetSize, ContentMode, options, Handler, Nil)
End If
End Sub
Function LoadAssetPicture(p as PHAssetMBS) As Picture
Dim contentMode As Integer = ImageManager.ContentModeAspectFit
Dim options As New PHImageRequestOptionsMBS
Dim targetSize As New CGSizeMBS(128,32)
// due to download, the handler is called twice, frist small, second large picture
options.Synchronous = true
options.NetworkAccessAllowed = True
options.DeliveryMode = options.DeliveryModeFastFormat
Dim info As Dictionary
Dim image As NSImageMBS = ImageManager.RequestImageForAssetSync(p, targetSize, ContentMode, options, info)
If image <> Nil Then
Return image.CopyPicture
End If
End Function
Sub requestImageForAssetCompleted(asset as PHAssetMBS, options as PHImageRequestOptionsMBS, result as NSImageMBS, info as Dictionary, tag as Variant)
System.DebugLog CurrentMethodName+ " "+asset.localIdentifier
Dim error As NSErrorMBS = info.Lookup(PHImageManagerMBS.PHImageErrorKey, Nil)
Dim IsDegrated As Boolean = info.Lookup(PHImageManagerMBS.PHImageResultIsDegradedKey, False)
Dim isCanceled As Boolean = info.Lookup(PHImageManagerMBS.PHImageCancelledKey, False)
If isCanceled Then
// exit on cancel
Return
Elseif error <> Nil Then
MsgBox error.LocalizedDescription
CurrentRequestID = 0
Return
Elseif IsDegrated Then
Title = "Loaded preview."
Else
Title = "Loaded full picture"
End If
If result <> Nil Then
System.DebugLog "size: "+Str(result.width)+"x"+Str(result.height)
pic = result.CopyPicture
output.Invalidate
output.Visible = True
LivePhotoControl.Visible = False
End If
CurrentRequestID = 0
End Sub
Sub requestLivePhotoForAssetCompleted(asset as PHAssetMBS, options as PHImageRequestOptionsMBS, livePhoto as PHLivePhotoMBS, info as Dictionary, tag as Variant)
System.DebugLog CurrentMethodName+ " "+asset.localIdentifier
Dim error As NSErrorMBS = info.Lookup(PHImageManagerMBS.PHImageErrorKey, Nil)
Dim IsDegrated As Boolean = info.Lookup(PHImageManagerMBS.PHImageResultIsDegradedKey, False)
Dim isCanceled As Boolean = info.Lookup(PHImageManagerMBS.PHImageCancelledKey, False)
If isCanceled Then
// exit on cancel
Return
Elseif error <> Nil Then
MsgBox error.LocalizedDescription
CurrentRequestID = 0
Return
Elseif IsDegrated Then
Title = "Loaded preview."
Else
Title = "Loaded full picture"
End If
If livePhoto <> Nil Then
pic = Nil
output.Visible = False
LivePhotoControl.LivePhoto = livePhoto
LivePhotoControl.Visible = True
LivePhotoControl.startPlayback LivePhotoControl.PlaybackStyleFull
End If
CurrentRequestID = 0
End Sub
Property CurrentAsset As PHAssetMBS
Property CurrentRequestID As Integer
Property ImageManager As PHImageManagerMBS
Property Untitled As Integer
Property pic As Picture
Property preview As Picture
End Class
MenuBar MainMenuBar
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem EditSeparator1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem EditSeparator2 = "-"
MenuItem EditSelectAll = "Select &All"
End MenuBar
Module Utils
Sub AddFolderWithTag(extends list as Listbox, text as string, ref as Variant)
List.AddFolder Text
List.RowTag(List.LastIndex) = ref
End Sub
Sub AddRowWithTag(extends list as Listbox, text as string, ref as Variant)
List.AddRow Text
List.RowTag(List.LastIndex) = ref
End Sub
End Module
Class PHPhotoLibrary Inherits PHPhotoLibraryMBS
EventHandler Sub DidBecomeUnavailable()
System.DebugLog CurrentMethodName
End EventHandler
EventHandler Sub DidChange(changes as PHChangeMBS)
System.DebugLog CurrentMethodName
End EventHandler
End Class
ExternalFile info
End ExternalFile
End Project
The items on this page are in the following plugins: MBS Mac64bit Plugin.
