Xojo Developer Conference
25/27th April 2018 in Denver.
MBS Xojo Conference
6/7th September 2018 in Munich, Germany.

Platforms to show: All Mac Windows Linux Cross-Platform

Required plugins for this example: MBS MacCG Plugin, MBS Picture Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Picture/MakeIcon/MakeIcon
This example is the version from Fri, 17th Nov 2016.
Project "MakeIcon.rbp"
Filetype special/any
End FileTypes
MenuBar Menu
MenuItem UntitledMenu4 = ""
MenuItem UntitledMenu2 = "File"
MenuItem FileChoosefile = "Choose file..."
MenuItem UntitledMenu3 = "-"
MenuItem FileQuit = "Quit"
MenuItem UntitledMenu0 = "Edit"
MenuItem EditUndo = "Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Cut"
MenuItem EditCopy = "Copy"
MenuItem EditPaste = "Paste"
MenuItem EditClear = "Clear"
MenuItem AppleAbout = "About this application..."
End MenuBar
Class App Inherits Application
EventHandler Sub EnableMenuItems() FileChoosefile.Enable End EventHandler
EventHandler Sub NewDocument() dim f as FolderItem f=GetOpenFolderItem("special/any") if f<>nil then OpenDocument f end if End EventHandler
EventHandler Sub OpenDocument(item As FolderItem) process item End EventHandler
Function FileChoosefile() As Boolean NewDocument Return true End Function
Sub AddIcon(f as folderitem, p as picture, m as picture) dim i as IconFamilyMBS dim n as Integer i=NewIconFamilyMBS i.dither=true // For Mac OS X i.Thumbnail32BitData=p i.Thumbnail8BitMask=m i.Huge1BitData=p i.Huge1BitMask=m i.Huge32BitData=p i.Huge4BitData=p i.Huge8BitData=p i.Huge8BitMask=m i.Small1BitData=p i.Small1BitMask=m i.Small32BitData=p i.Small4BitData=p i.Small8BitData=p i.Small8BitMask=m // For Mac OS 9: i.Large8BitData=p i.Large1BitMask=m i.Large1BitData=p i.Large4BitData=p i.Large32BitData=p i.Large8BitMask=m n=f.AddCustomIconMBS(i,true) if n<>0 then MsgBox "Add icon returnd error code "+str(n)+"." end if End Sub
Function GetFileContent(f as folderitem) As picture dim n,n4 as string n=f.Name // File extension, Acrobat Reader as creator or PDF type if Right(n,4)=".pdf" or f.MacCreator="CARO" or f.MacType="PDF " then Return GetPDFContent(f) end if Return GetPictureContent(f) Exception End Function
Function GetPDFContent(f as folderitem) As picture dim r as CGRectMBS dim g as CGContextMBS dim p as Picture dim pdf as CGPDFDocumentMBS pdf=f.OpenAsCGPDFDocumentMBS // Let's get it in 400% of the size. =288 dpi if pdf<>nil then r=pdf.MediaBox(1) r=CGMakeRectMBS(0,0,r.Width*4,r.Height*4) p = New Picture(r.Width,r.Height,32) p.Graphics.DrawCGPDFDocumentMBS pdf,r,1 Return p end if Exception End Function
Function GetPictureContent(f as folderitem) As picture Return f.OpenAsPicture End Function
Sub ResizePicture(byref pp as picture, byref mm as picture) dim pi,mi as Picture dim po,mo as Picture dim x,y,h,w,ww,hh as integer dim fh,fw,f as Double // input pi=pp po = New Picture(128,128,32) mo = New Picture(128,128,32) ww=pi.Width hh=pi.Height fw=128.0/ww fh=128.0/hh f=min(fw,fh) w=ww*f h=hh*f x=(128-w)/2.0 y=(128-h)/2.0 // make a mask mo.Graphics.ForeColor=rgb(0,0,0) mo.Graphics.FillRect x,y,w,h po.Graphics.DrawPicture pi,x,y,w,h,0,0,ww,hh // output pp=po mm=mo End Sub
Sub process(f as folderitem) dim p,m as Picture p=GetFileContent(f) if p=nil then MsgBox "Failed to get a picture from file """+f.DisplayName+"""." else ResizePicture p,m AddIcon f,p,m end if End Sub
End Class
End Project

Feedback, Comments & Corrections

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

MBS Xojo Plugins