ホームページ開発ツール>Xojo / Real Studio Trial and Error・CocoaのDeclareでアプリアイコン付フォルダーアイコンを作る

 Xojo / Real Studio Trial and Error

CocoaのDeclareでアプリアイコン付フォルダーアイコンを作る

目次
 はじめに

 以下は、Xojo Cocoaビルドについての話題です。

 アプリケーションのアイコンを埋め込んだフォルダーアイコンを作る方法について、調べてみました。

 なお検証には、Xojo 2022 Release 4.1を用いています。(Mac mini 2018 + macOS 13.1 Ventura)


 方針

 OSが標準で用意しているフォルダーには、画像が埋め込まれています。
S Shot1
 ユーザーが自分で作るフォルダーにも、このような画像が付けられると視認性が高まり、判別しやすくなります。

 フォルダーごとカスタマイズする方法はよく知られていますが、(使用中のOSの)フォルダーアイコンをベースに別の画像を貼り付ける方法は、(探し方が悪かったのか)見つけられませんでした。
 なので、自作した方が手っ取り早そうだったので、試してみました。
 なお、ここでは特定のアプリケーション(以下、アプリ)の書類用とするため、アプリのアイコンを画像として貼り付けることを考えます。

 さて、再びOS標準フォルダーを見直すと、図柄の部分は単色でフォルダーより暗く、上辺に影/下辺にハイライト(即ちエンボス加工)が入っていることが分かります。
 手始めに、アプリのアイコンを直接エンボス加工してみましたが、一般にアイコンは(OS標準フォルダーの図柄に比べて)細密で、総天然色(!)のため、凹む処とそうでないところが分かれてしまって、何が描かれているのか分からない、となってしまいました。

 そこで、アプリアイコンの輪郭のみ抽出してエンボス加工してみたところ、いい感じになりました。
 ただし、輪郭だけでは分かりずらいので、そこにオリジナルアイコンを半透明化して乗せると、かなりいい感じになりました。

 その後もいくつか試行錯誤を繰り返しましたが、結局以下で行くことにしました。
  1. フォルダーアイコン画像を取得
  2. アプリアイコン画像を取得
  3. アプリアイコン画像の輪郭を保持した単色画像を生成
  4. 単色画像にエンボス加工
  5. フォルダー、エンボス加工、半透明化したオリジナルアイコンの各画像を合成
  6. 合成画像を書き出し
 以下、各ステップの詳細を見ていきます。

 フォルダーアイコン画像は、OSのバージョンによって取得方法を変えます。
 Catalina迄は、以前やった方法で抽出します。Big Sur以降ではシステムアイコンの扱いが変更になり、従来の場所からは取得できなくなった(正確には、取得はできるが旧OS用になる)ので、(いくつか方法はあるようですが、今回は)UTType(のIdentifier)を指定して取り込みます。

 参考サイト(1):System-Declared Uniform Type Identifiers
本稿では使用しないが、Applicationsフォルダー等のカスタムフォルダーは参考サイト(1)には載っていないため、Identifierを別途探し出す必要があるが、/System/Library/CoreServices/CoreTypes.bundle/Contents/Info.plistを調べればよさそう。
(Xcodeで開いてXML形式で書き出し後(または、以下のサイトから)、旧OSでのicnsファイル名をキーに検索すれば見つかる筈。)
参考サイト(2):jGridstart/test.lsregister0001.dump at master · wvengen/jGridstart · GitHub
 アプリアイコン画像は、icnsファイルがあればそちらを優先し、なければAssets.carから取得します。
 Assets.carからは、NSBundleimageForResource:でイメージ群を取得できそうだというところまでは辿り着き、名前に何を指定するかで停滞したものの、Info.plistのCFBundleIconNameを使えば可能であることを確認しました。

 輪郭を保持した単色画像の生成は、(1) Pictureを作成してベタ塗り、(2) アイコン画像からマスクを抜き出す、(3) Pictureにマスクをセット、で行います。
 ベタ塗りのカラーは、次で行うエンボス加工のシェーディング用画像のものが適用されるため、なんでも良いので、白としておきます。

 エンボス加工は、以下のサイトを参考にさせて頂きました。CIFilterは以前やっているので、それをベースにします。

 参考サイト(3):Realistic Text Emboss Effect in iOS - blog.

 影やハイライトは、当初は光源位置を指定して付けるのかと思ったら、シェーディング用の画像で決まるようです。それだけでなく、(前述の通り)エンボス部のカラーにもこの画像が反映されるため、それらを(最低限?)満足する画像を自作しました。

 CIFilterのパラメーター(CIHeightFieldFromMaskのRadius、CIShadedMaterialのScale)は、変えると単独でも違いが出ますし、組み合わせれば尚更です。
 透明度は、上げるとエンボス感は強調されるが視認性は落ち、下げると逆に、視認性は上がるがOS標準との統一感やエンボス感が失われてしまいます。
 それぞれ微妙な加減があるので、微調整できるよう外部から指定ができて、その場で結果を確認できるようにしておきます。

 以上を踏まえ、(残りの)仕様は以下の通りとしました。

 Xojoでの実装
【ソースコードのコピー&ペーストについて】
・ソースコード(グレー背景部分の全文)をコピーし、指定のオブジェクトにペーストすると、(新規作成して名前等を個別にコピー&ペーストしなくても)復元されます。
・ペーストはオブジェクトに行って下さい。オブジェクト内のEvent Handlers/Methods/Properties等にペーストしても、うまくいかない場合があります。
・それでもペーストできない場合は、各項目のカッコ内を適用して下さい。
  1. Xojoで新規プロジェクトを作成(Window1のWidthを710、Heightを740に変更)
  2. Window1に、Canvas(Name:Canvas1, Width:512, Height:512)、Label5個(Name:Label1, Text:CIHeightFieldFromMask、Name:Label2, Text:Radius:、Name:Label3, Text:CIShadedMaterial、Name:Label4, Text:Scale:、Name:Label5, Text:Transparency)、ListBox(Name:ListBox1)、PushButton2個(Name:PushButton1, Caption:Redraw、Name:PushButton2, Caption:Export)、TextField3個(Name:TextField1、Name:TextField2、Name:TextField3)を置く
  3. 以下をCanvas1にペースト(できなければ、Sub - Endの間をDropObjectイベントに記述)
    Sub DropObject(obj As DragItem, action As Integer) Handles DropObject
      if obj.FolderItemAvailable then  // フォルダーアイテムなら
        if GetIcnsFile(obj.FolderItem) then  // ファイルを取得できれば
          GetListAndSelect()  // アイコン画像のリストを作って、所望のサイズがあれば取得
          return
        end if
      end if
      
      MessageBox "File not Available."
    End Sub
    
  4. 以下をCanvas1にペースト(できなければ、Sub - Endの間をOpenイベントに記述)
    Sub Open() Handles Open
      Me.AcceptFileDrop("")  // 空でも機能してしまう
    End Sub
    
  5. 以下をCanvas1にペースト(できなければ、Sub - Endの間をPaintイベントに記述)
    Sub Paint(g As Graphics, areas() As REALbasic.Rect) Handles Paint
      DrawCanvas(g)
    End Sub
    
  6. 以下をListBox1にペースト(できなければ、Sub - Endの間をChangeイベントに記述)
    Sub Change() Handles Change
      if me.ListIndex>=0 then
        UpdateIconPicture()  // アイコン画像の更新
      end if
    End Sub
    
  7. 以下をPushButton1にペースト(できなければ、Sub - Endの間をActionイベントに記述)
    Sub Action() Handles Action
      if Listbox1.ListIndex>=0 then
        UpdateIconPicture()  // アイコン画像の更新
      end if
    End Sub
    
  8. 以下をPushButton2にペースト(できなければ、Sub - Endの間をActionイベントに記述)
    Sub Action() Handles Action
      ExportPNG()  // アイコン画像の書き出し
    End Sub
    
  9. 以下をWindow1にペースト
    Sub Open() Handles Open
      // 処理の元となる画像(フォルダー、シェーディング用)の取得
      InitBasicPicture()
      
      // ウィンドウのTop補正(Big Sur以降の場合)
      me.Top=me.Top+8
    End Sub
    
  10. 以下をWindow1にペースト
    Private Function ConvPicToCIImg(pic As Picture) As Ptr
      // 元画像が空なら戻る
      if pic=nil then
        return nil
      end if
      
      // 文字列を指定してクラスオブジェクトを取得する。最初に一回宣言しておけばよい。
      Declare Function NSClassFromString Lib "Cocoa" (aClassName As CFStringRef) As Ptr
      
      // 元画像をCGImageRefに変換
      Dim originImage As Ptr = pic.CopyOSHandle(Picture.HandleType.MacCGImage)
      
      // CGImageRefからCIImageを生成する
      Dim originImage2 As Ptr = NSClassFromString("CIImage")
      Declare Function alloc Lib "Cocoa" Selector "alloc" (receiver As Ptr) As Ptr
      Declare Function initWithCGImage Lib "Cocoa" Selector "initWithCGImage:" (receiver As Ptr, img As Ptr) As Ptr
      originImage2 = alloc(originImage2)
      originImage2 = initWithCGImage(originImage2, originImage)
      
      // CIImageを返す
      return originImage2
    End Function
    
  11. 以下をWindow1にペースト
    Protected Sub DrawCanvas(g As Graphics)
      // 背景描画(白)
      g.ForeColor=RGB(255,255,255)
      g.FillRect 0,0,Canvas1.Width,Canvas1.Height
      
      // フォルダー画像があって、アイコン合成画像がなければ、フォルダー画像のみ描画
      if pPicFolder<>nil and pPicIcon=nil then
        g.DrawPicture(pPicFolder,0,0)
      end if
      
      // アイコン合成画像があれば、画像を描画
      if pPicIcon<>nil then
        g.DrawPicture(pPicIcon,0,0)
      end if
      
      // 枠線枠線(黒)
      g.ForeColor=RGB(0,0,0)
      g.DrawRect 0,0,Canvas1.Width,Canvas1.Height
    End Sub
    
  12. 以下をWindow1にペースト
    Protected Sub ExportPNG()
      // 画像が作られていなかったら戻る
      if pPicIcon=nil then
        MessageBox "Icon Picture not made."
        return
      end if
      
      // ダイアログ表示
      Var dlg As SaveFileDialog
      Var f As FolderItem
      dlg = New SaveFileDialog
      dlg.SuggestedFileName="Untitled.png"
      f=dlg.ShowModal
      if f=nil then
        return
      end if
      
      // PNG形式で出力
      pPicIcon.Save(f,Picture.Formats.PNG)
    End Sub
    
  13. 以下をWindow1にペースト
    Protected Function ExtractExtention(f As FolderItem) As String
      // 引数がFolderItemなのは、pathがAbsolutePathの場合でも利用できるようにするため。
      
      Declare Function NSClassFromString Lib "Cocoa" (aClassName As CFStringRef) As Ptr
      Dim nsstr As Ptr = NSClassFromString("NSString")
      
      Declare Function stringWithString Lib "Cocoa" Selector "stringWithString:" (receiver As Ptr, string As CFStringRef) As Ptr
      Declare Function pathExtension Lib "Cocoa" Selector "pathExtension" (receiver As Ptr) As CFStringRef
      return pathExtension(stringWithString(nsstr, f.NativePath))
    End Function
    
  14. 以下をWindow1にペースト
    Private Function FloatToNSNumber(vv As CGFloat) As Ptr
      // 文字列を指定してクラスオブジェクトを取得する。最初に一回宣言しておけばよい。
      Declare Function NSClassFromString Lib "Cocoa" (aClassName As CFStringRef) As Ptr
      
      // NSNumberクラスを取得
      Dim num As Ptr = NSClassFromString("NSNumber")
      
      #if Target32Bit
        Declare Function numberWithReal Lib "Cocoa" Selector "numberWithFloat:" (receiver As Ptr, num As Single) As Ptr
      #endif
      #if Target64Bit
        Declare Function numberWithReal Lib "Cocoa" Selector "numberWithDouble:" (receiver As Ptr, num As Double) As Ptr
      #endif
      
      // 実数をNSNumber型に変換
      num = numberWithReal(num, vv)
      
      // NSNumber型で返す
      return num
    End Function
    
  15. 以下をWindow1にペースト
    Private Function GenHFieldSMaterialPict(vv1 As CGFloat, vv2 As CGFloat, picMono As Picture) As Picture
      Dim pnt As Ptr
      
      // 文字列を指定してクラスオブジェクトを取得する。最初に一回宣言しておけばよい。
      Declare Function NSClassFromString Lib "Cocoa" (aClassName As CFStringRef) As Ptr
      
      Declare Function alloc Lib "Cocoa" Selector "alloc" (receiver As Ptr) As Ptr
      Declare Function filterWithName Lib "Cocoa" Selector "filterWithName:" (receiver As Ptr, fnam As CFStringRef) As Ptr
      Declare Sub setValue Lib "Cocoa" Selector "setValue:forKey:" (receiver As Ptr, val As Ptr, key As CFStringRef)
      Declare Function outputImage Lib "Cocoa" Selector "outputImage" (receiver As Ptr) As Ptr
      
      // CIHeightFieldFromMask処理に用いるピクチャーが空なら戻る
      if picMono=nil then
        return nil
      end if
      
      // CIShadedMaterial処理に用いるピクチャーが空なら戻る
      if pPicShd=nil then
        return nil
      end if
      
      // CIHeightFieldFromMask
      // CIFilterにフィルターをセット
      Dim filter1 As Ptr = NSClassFromString("CIFilter")
      filter1 = filterWithName(filter1, "CIHeightFieldFromMask")
      
      // インプット画像をセット
      Dim inputImage1 as Ptr = ConvPicToCIImg(picMono)
      setValue(filter1, inputImage1, "inputImage")
      
      // Radiusをセット
      pnt = FloatToNSNumber(vv1)  // 実数をNSNumber型に変換
      setValue(filter1, pnt, "inputRadius")
      
      // フィルター後の画像(CIImage)を取得
      Dim filteredImage1 As Ptr = outputImage(filter1)
      
      // CIShadedMaterial
      // CIFilterにフィルターをセット
      Dim filter2 As Ptr = NSClassFromString("CIFilter")
      filter2 = filterWithName(filter2, "CIShadedMaterial")
      
      // インプット画像をセット
      setValue(filter2, filteredImage1, "inputImage")
      
      // Scaleをセット
      pnt = FloatToNSNumber(vv2)  // 実数をNSNumber型に変換
      setValue(filter2, pnt, "inputScale")
      
      // ShadingImageをセット
      Dim ShadingImage2 As Ptr = ConvPicToCIImg(pPicShd)
      setValue(filter2, ShadingImage2, "inputShadingImage")
      
      // フィルター後の画像(CIImage)を取得
      Dim filteredImage2 As Ptr = outputImage(filter2)
      
      
      // ciContextを生成する
      Dim ciContext As Ptr = NSClassFromString("CIContext")
      Declare Function contextWithOptions Lib "Cocoa" Selector "contextWithOptions:" (receiver As Ptr, opt As Ptr) As Ptr
      ciContext = contextWithOptions(ciContext, nil)
      
      // ciContextを使ってCIImageからCGImageRefを生成する
      Declare Function extent Lib "Cocoa" Selector "extent" (receiver As Ptr) As CGRect
      Declare Function createCGImage Lib "Cocoa" Selector "createCGImage:fromRect:" (receiver As Ptr, opt As Ptr, opt2 As CGRect) As Ptr
      Dim imageRef As Ptr = createCGImage(ciContext, filteredImage2, extent(inputImage1))
      
      // CGImageRefからNSImageを生成する
      Dim outputImage As Ptr = NSClassFromString("NSImage")
      Declare Function initWithCGImageSize Lib "Cocoa" Selector "initWithCGImage:size:" (receiver As Ptr, opt As Ptr, opt2 As NSSize) As Ptr
      outputImage = alloc(outputImage)
      outputImage = initWithCGImageSize(outputImage, imageRef, NSMakeSize(picMono.Width,picMono.Height))
      
      // NSImageをNSDataに変換する
      Declare Function TIFFRepresentation Lib "Cocoa" Selector "TIFFRepresentation" (receiver As Ptr) As Ptr
      Dim data2 As Ptr = TIFFRepresentation(outputImage)
      
      // clean up
      Declare Sub release Lib "Cocoa" Selector "release" (receiver As Ptr)
      release(inputImage1)
      release(ShadingImage2)
      release(outputImage)
      
      // NSDataのデータ長を取得
      Declare Function length Lib "Cocoa" Selector "length" (receiver As Ptr) As Integer
      Dim lng As Integer = length(data2)
      
      // NSDataからバイト列を抽出
      Declare Function bytes Lib "Cocoa" Selector "bytes" (receiver As Ptr) As Ptr
      Dim bstream As Ptr = bytes(data2)
      
      // バイト列をXojo.Core.MemoryBlockに格納後、MemoryBlockに変換
      Dim xmb As new Xojo.Core.MemoryBlock(bstream, lng)
      Dim temp As MemoryBlock = xmb.Data
      Dim mb As New MemoryBlock(xmb.Size)
      mb.StringValue(0, mb.Size) = temp.StringValue(0, mb.Size)
      
      // MemoryBlockからPictureを生成して返す
      return Picture.FromData(mb)
    End Function
    
  16. 以下をWindow1にペースト
    Protected Function GenMaskedPict(picSrc As Picture) As Picture
      // 空なら戻る
      if picSrc=nil then
        return nil
      end if
      
      // 元画像からマスクを抽出
      Var maskPic As Picture = picSrc.CopyMask()
      
      // 全面白色の画像を生成
      Var whitePic As New Picture(picSrc.Width,picSrc.Height)
      whitePic.VerticalResolution=picSrc.VerticalResolution
      whitePic.HorizontalResolution=picSrc.HorizontalResolution
      whitePic.Graphics.DrawingColor = &cffffff
      whitePic.Graphics.FillRectangle(0,0,me.Width,me.Height)
      
      // マスクをセット(描いた後にセットしないと機能しない?)
      whitePic.ApplyMask(maskPic)
      
      // 元画像のマスクを適用したベタ画像を返す
      return whitePic
    End Function
    
  17. 以下をWindow1にペースト
    Protected Function GetFolderIcon() As Picture
      // 文字列を指定してクラスオブジェクトを取得する。最初に一回宣言しておけばよい。
      Declare Function NSClassFromString Lib "Cocoa" (aClassName As CFStringRef) As Ptr
      
      // フォルダーのUTTypeを取得
      Dim type As Ptr = NSClassFromString("UTType")
      Declare Function typeWithIdentifier Lib "Cocoa" Selector "typeWithIdentifier:" (receiver As Ptr, idnt As CFStringRef) As Ptr
      type = typeWithIdentifier(type, "public.folder")  // GenericFolderIcon
      
      // フォルダー画像を取得
      Dim wspace As Ptr = NSClassFromString("NSWorkspace")
      Declare Function sharedWorkspace Lib "Cocoa" Selector "sharedWorkspace" (receiver As Ptr) As Ptr
      wspace = sharedWorkspace(wspace)
      Declare Function iconForContentType Lib "Cocoa" Selector "iconForContentType:" (receiver As Ptr, type As Ptr) As Ptr
      Dim folderImage As Ptr = iconForContentType(wspace, type)
      if folderImage=nil then return nil
      
      // NSImageをNSDataに変換する
      Declare Function TIFFRepresentation Lib "Cocoa" Selector "TIFFRepresentation" (receiver As Ptr) As Ptr
      Dim data2 As Ptr = TIFFRepresentation(folderImage)
      
      // NSDataのデータ長を取得
      Declare Function length Lib "Cocoa" Selector "length" (receiver As Ptr) As Integer
      Dim lng As Integer = length(data2)
      
      // NSDataからバイト列を抽出
      Declare Function bytes Lib "Cocoa" Selector "bytes" (receiver As Ptr) As Ptr
      Dim bstream As Ptr = bytes(data2)
      
      // バイト列をXojo.Core.MemoryBlockに格納後、MemoryBlockに変換
      Dim xmb As new Xojo.Core.MemoryBlock(bstream, lng)
      Dim temp As MemoryBlock = xmb.Data
      Dim mb As New MemoryBlock(xmb.Size)
      mb.StringValue(0, mb.Size) = temp.StringValue(0, mb.Size)
      
      // MemoryBlockからPictureを生成
      Dim pic As Picture = Picture.FromData(mb)
      
      // 512x512にリサイズ
      Dim pic2 As New Picture(512,512)
      pic2.VerticalResolution=72
      pic2.HorizontalResolution=72
      pic2.Graphics.DrawPicture(pic,0,0,512,512,0,0,pic.Width,pic.Height)
      
      return pic2
    End Function
    
  18. 以下をWindow1にペースト
    Protected Function GetFolderIconOld() As Picture
      // OS標準アイコンを納めたicnsファイルを取得
      Dim f As FolderItem = GetFolderItem("/System/Library/CoreServices/CoreTypes.bundle/Contents/Resources/GenericFolderIcon.icns",3)
      if f=nil or f.Exists=false then
        return nil  // ファイルが取得できなければ戻る
      end if
      
      // ファイルからイメージ群を取得
      Dim bitmapImages As Ptr = GetImageFromFile(f)
      
      // 群の要素数を取得
      Declare Function myCount Lib "Cocoa" Selector "count" (receiver As Ptr) As Integer
      Dim cnt As Integer = myCount(bitmapImages)
      
      // 要素のループ
      Declare Function objectAtIndex Lib "Cocoa" Selector "objectAtIndex:" (receiver As Ptr, path As Integer) As Ptr
      Declare Function mySize Lib "Cocoa" Selector "size" (receiver As Ptr) As NSSize
      Declare Function pixelsWide Lib "Cocoa" Selector "pixelsWide" (receiver As Ptr) As Integer
      Declare Function pixelsHigh Lib "Cocoa" Selector "pixelsHigh" (receiver As Ptr) As Integer
      Declare Function bytesPerRow Lib "Cocoa" Selector "bytesPerRow" (receiver As Ptr) As Integer
      Dim bitmapImageRep As Ptr
      Dim k, bpr, ww, hh As Integer
      Dim iconSize As NSSize
      
      // 各サイズの画像の情報を取得して
      for k=0 to cnt-1
        
        bitmapImageRep = objectAtIndex(bitmapImages, k)
        iconSize = mySize(bitmapImageRep)
        ww = pixelsWide(bitmapImageRep)
        hh = pixelsHigh(bitmapImageRep)
        bpr = bytesPerRow(bitmapImageRep)
        
        // 想定する規格(サイズ:512x512、解像度:72)のアイコンがあれば取得して返す
        if iconSize.Width=512 and ww=512 then
          Dim pic As Picture = GetIconPicture(f,k)
          return pic
        end if
        
      next
      
      // 想定する規格のアイコンがなければ空を返す
      return nil
    End Function
    
  19. 以下をWindow1にペースト
    Protected Function GetIcnsFile(f As FolderItem) As Boolean
      Dim f2 As FolderItem
      Dim name As String
      
      // ファイルから拡張子を取得
      Dim extn As String = ExtractExtention(f)
      
       // 拡張子がappでなければ戻る
      if extn<>"app" then
        return false
      end if
      
      // 文字列を指定してクラスオブジェクトを取得する。最初に一回宣言しておけばよい。
      Declare Function NSClassFromString Lib "Cocoa" (aClassName As CFStringRef) As Ptr
      
      Declare Function objectForInfoDictionaryKey Lib "Cocoa" Selector "objectForInfoDictionaryKey:" (receiver As Ptr, path As CFStringRef) As CFStringRef  // 
      
      // 当該アプリケーションのバンドルを取得
      Dim bndl As Ptr = NSClassFromString("NSBundle")
      Declare Function bundleWithPath Lib "Cocoa" Selector "bundleWithPath:" (receiver As Ptr, path As CFStringRef) As Ptr  // Return NSBundle
      bndl = bundleWithPath(bndl, f.NativePath)
      
      // アイコンファイル名を取得
      name = objectForInfoDictionaryKey(bndl, "CFBundleIconFile")
      if name<>"" then  // 取得できたら、まずはicnsファイルであるか確認
        
        // 拡張子が付いていなければ付加
        if InStrB(name,"icns")=0 then
          name=name+".icns"
        end if
        
        // icnsファイルを探す
        f2 = f.Child("Contents").Child("Resources").Child(name)
        if f2<>nil and f2.Exists then  // 存在すれば
          pIcnsFile=f2  // icnsファイルを保持
          return true
        end if
        
      end if
      
      // icnsファイルを取得できなければ、Assets.carを探す
      f2=f.Child("Contents").Child("Resources").Child("Assets.car")
      if f2<>nil and f2.Exists then  // 存在すれば
        
        // アイコンファイル名を取得
        name = objectForInfoDictionaryKey(bndl, "CFBundleIconName")
        
        // 本来はファイルの中身を検証すべきだが、ここでは名前が取得できればよしとする
        if name<>"" then
          pIcnsFile=f  // Assets.carの場合は、アプリ本体を保持
          return true
        end if
        
      end if
      
      return false
    End Function
    
  20. 以下をWindow1にペースト
    Protected Function GetIconPicture(f As FolderItem, idx As Integer) As Picture
      // ファイルが取得できなければnilを返す
      if f=nil or f.Exists=false then
        return nil
      end if
      
      // 文字列を指定してクラスオブジェクトを取得する。最初に一回宣言しておけばよい。
      Declare Function NSClassFromString Lib "Cocoa" (aClassName As CFStringRef) As Ptr
      
      // ファイルからイメージ群を取得
      Dim bitmapImages As Ptr = GetImageFromFile(f)
      
      // 指定されたサイズのアイコンを取得
      Dim bitmapImageRep As Ptr
      Declare Function objectAtIndex Lib "Cocoa" Selector "objectAtIndex:" (receiver As Ptr, path As Integer) As Ptr
      bitmapImageRep = objectAtIndex(bitmapImages, idx)
      
      // falseをNSNumber形式に変換
      Dim numb As Ptr = NSClassFromString("NSNumber")
      Declare Function numberWithBool Lib "Cocoa" Selector "numberWithBool:" (receiver As Ptr, path As Boolean) As Ptr
      numb = numberWithBool(numb, false)
      
      // PNG用オプションのセット
      Dim dict As Ptr = NSClassFromString("NSDictionary")
      Declare Function dictionaryWithObject Lib "Cocoa" Selector "dictionaryWithObject:forKey:" (receiver As Ptr, objt As Ptr, key As CFStringRef) As Ptr
      dict = dictionaryWithObject(dict, numb, "NSImageInterlaced")
      
      // PNG出力(NSPNGFileType = 4)
      Declare Function representationUsingType Lib "Cocoa" Selector "representationUsingType:properties:" (receiver As Ptr, type As Integer, prop As Ptr) As Ptr
      Dim pngData As Ptr = representationUsingType(bitmapImageRep, 4, dict)
      
      // PNGデータの長さを取得
      Declare Function length Lib "Cocoa" Selector "length" (receiver As Ptr) As Integer
      Dim lng As Integer = length(pngData)
      
      // バイト列の抽出
      Declare Function bytes Lib "Cocoa" Selector "bytes" (receiver As Ptr) As Ptr
      Dim bstream As Ptr = bytes(pngData)
      
      // バイト列をXojo.Core.MemoryBlockに格納後、MemoryBlockに変換
      Dim xmb As new Xojo.Core.MemoryBlock(bstream, lng)
      Dim temp As MemoryBlock = xmb.Data
      Dim mb As New MemoryBlock(xmb.Size)
      mb.StringValue(0, mb.Size) = temp.StringValue(0, mb.Size)
      
      // MemoryBlockを使ってPictureを生成
      Dim pic As Picture = Picture.FromData(mb)
      
      return pic
    End Function
    
  21. 以下をWindow1にペースト
    Protected Function GetImageFromFile(f As FolderItem) As Ptr
      // 文字列を指定してクラスオブジェクトを取得する。最初に一回宣言しておけばよい。
      Declare Function NSClassFromString Lib "Cocoa" (aClassName As CFStringRef) As Ptr
      
      // icnsかAssets.carかで取得方法を変える
      Dim image As Ptr = NSClassFromString("NSImage")
      if ExtractExtention(f)="icns" then
        
        // 指定された.icnsファイルへのパスからイメージを取得
        Declare Function alloc Lib "Cocoa" Selector "alloc" (receiver As Ptr) As Ptr
        image = alloc(image)
        Declare Function initWithContentsOfFile Lib "Cocoa" Selector "initWithContentsOfFile:" (receiver As Ptr, path As CFStringRef) As Ptr
        image = initWithContentsOfFile(image, f.NativePath)
        
      else
        
        // 当該アプリケーションのバンドルを取得
        Dim bndl As Ptr = NSClassFromString("NSBundle")
        Declare Function bundleWithPath Lib "Cocoa" Selector "bundleWithPath:" (receiver As Ptr, path As CFStringRef) As Ptr  // Return NSBundle
        bndl = bundleWithPath(bndl, f.NativePath)
        
        // アイコンファイル名を取得
        Declare Function objectForInfoDictionaryKey Lib "Cocoa" Selector "objectForInfoDictionaryKey:" (receiver As Ptr, path As CFStringRef) As CFStringRef
        Dim name As String = objectForInfoDictionaryKey(bndl, "CFBundleIconName")
        
        // Assets.carから指定された名前のイメージを取得
        Declare Function imageForResource Lib "Cocoa" Selector "imageForResource:" (receiver As Ptr, name As CFStringRef) As Ptr  // 
        image = imageForResource(bndl, name)
        
      end if
      
      // TIFF形式でアイコン群を取得
      Declare Function TIFFRepresentation Lib "Cocoa" Selector "TIFFRepresentation" (receiver As Ptr) As Ptr
      Dim pnt1 As Ptr = TIFFRepresentation(image)
      Dim bitmapImages As Ptr = NSClassFromString("NSBitmapImageRep")
      Declare Function imageRepsWithData Lib "Cocoa" Selector "imageRepsWithData:" (receiver As Ptr, path As Ptr) As Ptr
      bitmapImages = imageRepsWithData(bitmapImages, pnt1)
      
      // clean up
      if ExtractExtention(f)="icns" then  // allocしているicnsのみ対象
        Declare Sub release Lib "Cocoa" Selector "release" (receiver As Ptr)
        release(image)
      end if
      
      // アイコン群を返す
      return bitmapImages
    End Function
    
  22. 以下をWindow1にペースト
    Protected Sub GetListAndSelect()
      // アイコンリストを生成
      MakeList(pIcnsFile)
      
      // 想定する規格(サイズ:256x256、解像度:144。ただし、解像度は後で72に変更する)のアイコンを探す
      Listbox1.ListIndex=-1
      for i As Integer = 0 to ListBox1.ListCount-1
        if Listbox1.Cell(i,0)="128 x 128" and Listbox1.Cell(i,1)="256 x 256" then
          Listbox1.ListIndex=i
          exit
        end if
      next
      
      // あれば、アイコン画像を更新
      if Listbox1.ListIndex>=0 then
        UpdateIconPicture()
      end if
    End Sub
    
  23. 以下をWindow1にペースト
    Protected Function GetTranslucentPict(trans As CGFloat, picSrc As Picture) As Picture
      // 空なら戻る
      if picSrc=nil then
        return nil
      end if
      
      // 元画像から半透明画像を生成
      Var transPic As New Picture(picSrc.Width,picSrc.Height)
      transPic.VerticalResolution=picSrc.VerticalResolution
      transPic.HorizontalResolution=picSrc.HorizontalResolution
      transPic.Graphics.Transparency=trans  // 85.0  // 0.0 ~ 100.0  100.0が透明
      transPic.Graphics.DrawPicture(picSrc,0,0)
      
      // 半透明画像を返す
      return transPic
    End Function
    
  24. 以下をWindow1にペースト
    Protected Sub InitBasicPicture()
      // フォルダーアイコン画像の取得(OSのバージョンによって、取得場所を変える)
      if System.Version.MajorVersion>=11 then  // Big Sur以降
        // UTTypeを指定して取得
        pPicFolder = GetFolderIcon()
      else
        // OS標準アイコンを納めたフォルダーから取得
        pPicFolder = GetFolderIconOld()
      end if
      
      // フィルター処理で使うシェーディング用画像を取得(下段でいける筈だが、ダメなら上段で置き換え)
      'Dim f2 As FolderItem = GetFolderItem(App.ExecutableFile.NativePath,3).Parent.Parent.Child("Resources").Child("Gradation.png")
      Dim f2 As FolderItem = SpecialFolder.Resource("Gradation.png")
      
      pPicShd = Picture.Open(f2)
    End Sub
    
  25. 以下をWindow1にペースト
    Protected Sub MakeIconPicture(v1 As CGFloat, v2 As CGFloat, v3 As CGFloat, idx As Integer)
      Const kDeltaY As Integer = 25  // アイコン画像描画時のY方向オフセット
      
      // アイコン画像の取得
      Dim picSrc As Picture = GetIconPicture(pIcnsFile,idx)
      
      // 256x256にリサイズ
      picSrc.VerticalResolution=72  // まず、ソースの解像度を72に統一
      picSrc.HorizontalResolution=72
      Dim picSrc2 As New Picture(256,256)
      picSrc2.VerticalResolution=72
      picSrc2.HorizontalResolution=72
      picSrc2.Graphics.DrawPicture(picSrc,0,0,256,256,0,0,picSrc.Width,picSrc.Height)
      
      // アイコン画像からフィルター処理で使う白ベタ画像を生成
      Dim picMono As Picture = GenMaskedPict(picSrc2)
      
      // フィルター(凹み=エンボス)処理
      Dim picOut As Picture = GenHFieldSMaterialPict(v1,v2,picMono)
      
      // 半透明化
      Dim picTrans As Picture = GetTranslucentPict(v3,picSrc2)
      
      // 新規ピクチャーを、ベースとなるフォルダー画像のスペックで生成
      Var pic As New Picture(pPicFolder.Width,pPicFolder.Height)
      pic.VerticalResolution=pPicFolder.VerticalResolution
      pic.HorizontalResolution=pPicFolder.HorizontalResolution
      
      // ベースとなるフォルダー画像の描画
      pic.Graphics.DrawPicture(pPicFolder,0,0)
      
      // 凹み画像の描画
      pic.Graphics.DrawPicture(picOut,(pPicFolder.Width-picOut.Width)/2,(pPicFolder.Height-picOut.Height)/2+kDeltaY)
      
      // 半透明化したアイコン画像の描画
      pic.Graphics.DrawPicture(picTrans,(pPicFolder.Width-picTrans.Width)/2,(pPicFolder.Height-picTrans.Height)/2+kDeltaY)
      
      // 完成画像を保持
      pPicIcon=pic
    End Sub
    
  26. 以下をWindow1にペースト
    Protected Sub MakeList(f As FolderItem)
      // ファイルが取得できなければ戻る
      if f=nil or f.Exists=false then
        return
      end if
      
      // ファイルからイメージ群を取得
      Dim bitmapImages As Ptr = GetImageFromFile(f)
      
      // 群の要素数を取得
      Declare Function myCount Lib "Cocoa" Selector "count" (receiver As Ptr) As Integer
      Dim cnt As Integer = myCount(bitmapImages)
      
      // 要素のループ
      Declare Function objectAtIndex Lib "Cocoa" Selector "objectAtIndex:" (receiver As Ptr, path As Integer) As Ptr
      Declare Function mySize Lib "Cocoa" Selector "size" (receiver As Ptr) As NSSize
      Declare Function pixelsWide Lib "Cocoa" Selector "pixelsWide" (receiver As Ptr) As Integer
      Declare Function pixelsHigh Lib "Cocoa" Selector "pixelsHigh" (receiver As Ptr) As Integer
      Declare Function bytesPerRow Lib "Cocoa" Selector "bytesPerRow" (receiver As Ptr) As Integer
      Dim bitmapImageRep As Ptr
      Dim k, bpr, ww, hh As Integer
      Dim iconSize As NSSize
      Dim idx As Integer = -1
      
      // 各サイズの画像の情報を取得してリスト表示
      Listbox1.DeleteAllRows  // まず全行削除
      for k=0 to cnt-1
        
        bitmapImageRep = objectAtIndex(bitmapImages, k)
        iconSize = mySize(bitmapImageRep)
        ww = pixelsWide(bitmapImageRep)
        hh = pixelsHigh(bitmapImageRep)
        bpr = bytesPerRow(bitmapImageRep)
        Listbox1.AddRow str(iconSize.Width)+" x "+str(iconSize.Height)
        Listbox1.Cell(Listbox1.ListCount-1,1)=str(ww)+" x "+str(hh)
        Listbox1.Cell(Listbox1.ListCount-1,2)=str(bpr)
        
        // 以下の情報はPictureを取得しないと得られないので、冗長だが実行(情報が不要なら削除可)
        Dim pic As Picture = GetIconPicture(f,k)
        Listbox1.Cell(Listbox1.ListCount-1,3)=str(pic.Width)+" x "+str(pic.Height)
        Listbox1.Cell(Listbox1.ListCount-1,4)=str(pic.VerticalResolution)+" x "+str(pic.HorizontalResolution)
        
      next
    End Sub
    
  27. 以下をWindow1にペースト
    Protected Sub UpdateIconPicture()
      // パラメーター
      Dim v1 As CGFloat = Val(TextField1.Text)  // Radius
      Dim v2 As CGFloat = Val(TextField2.Text)  // Scale
      Dim v3 As CGFloat = Val(TextField3.Text)  // Transparency
      Dim v4 As Integer = ListBox1.ListIndex  // Icon Size Index
      
      // フォルダーとアイコンを合成した画像を生成
      MakeIconPicture(v1,v2,v3,v4)
      
      // 画像の再描画
      Canvas1.Refresh
    End Sub
    
  28. 以下をWindow1にペースト(できなければPropertyに、Name:pIcnsFile、Type:FolderItem、を追加)
    Protected Property pIcnsFile As FolderItem
    
  29. 以下をWindow1にペースト(できなければPropertyに、Name:pPicFolder、Type:Picture、を追加)
    Protected Property pPicFolder As Picture
    
  30. 以下をWindow1にペースト(できなければPropertyに、Name:pPicIcon、Type:Picture、を追加)
    Protected Property pPicIcon As Picture
    
  31. 以下をWindow1にペースト(できなければPropertyに、Name:pPicShd、Type:Picture、を追加)
    Protected Property pPicShd As Picture
    
  32. 他に、CGPointMake/NSMakePoint/NSMakeRange/NSMakeRect/NSMakeSize(メソッド)、CGPoint/CGRect/CGSize/NSSize(構造体)が必要ですが、それらはmacoslibからコピーさせて頂きました。(別途モジュールを用意してコピーする。)
    注)macoslibではメソッドの引数、構造体のメンバーの型に、Singleが割り当てられているものがあるが、それらはCGFloatに書き換える。

  33. プロジェクト左ペインのBuild Settings>macOS上で右クリックし、Add to "Build Settings">Build Step>Copy Filesを選択
  34. InspectorのDestinationにResources Folderを指定
  35. 中央ペインに、Gradation.png(以下を予めダウンロードして、任意の場所に置いておく)をドラッグ&ドロップ
    S Shot1
    Gradation.png
 実行してみたところ、アプリアイコンを埋め込んだフォルダーアイコンを作成し、書き出せることを確認しました。
S Shot2

 書き出した画像をフォルダーに貼り付けた結果は、以下の通りです。
S Shot3

 おわりに

 フォルダー画像は、OSのバージョンによって変わることがあるので、その度に作り直すのは煩わしいという面はあります。
 本件のようなスタティックな方法でなく、ダイナミックに行う(既に割り当てられているフォルダーアイコンに、リアルタイムに別画像を貼り付ける)ことが可能であればいいのでしょうが、そんな方法があるのかは、よく分かりません。

 あと、シェーディング画像には改良の余地がありますが、画像上の変更が直接反映される訳ではないので、合わせ込んでいくのは結構大変です。


 お世話になったサイト

 貴重な情報をご提供頂いている皆様に、お礼申し上げます。(以下、順不同)

 参考サイト(1):System-Declared Uniform Type Identifiers
 参考サイト(2):jGridstart/test.lsregister0001.dump at master · wvengen/jGridstart · GitHub
 参考サイト(3):Realistic Text Emboss Effect in iOS - blog.


 更新履歴

 2023.01.20 新規作成


[Home]  [MacSoft]  [Donation]  [History]  [Privacy Policy]  [Affiliate Policy]