ホームページ＞開発ツール＞Xojo / Real Studio Trial and Error・CocoaのDeclareでポップアップメニューにイメージを付加する

　Xojo / Real Studio Trial and Error

CocoaのDeclareでポップアップメニューにイメージを付加する

はじめに
方針
Xojoでの実装
おわりに
お世話になったサイト
更新履歴

　はじめに

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

　Xojoは標準では、ポップアップメニュー（のメニュー）にイメージ（アイコン）を付加できないようなので、調べてみました。

　なお検証には、Xojo 2016 Release 3を用いています。（Mac mini mid 2010 + OS X 10.12.5 Sierra）

　方針

　Xojoのポップアップメニューは、MacではCocoaのNSPopupButton（を継承した？）クラスなので、メニュー項目はNSMenuItemとなり、イメージの付加は、setImage:メソッドを使って行うことになります。

　ただし、ポップアップメニューの配置とメニュー項目の生成は、（On The Flyでもない限り）Declareを使うこともないので、ここではIDE上で行うこととしました。
　その後、生成したメニューをNSMenuItemとして取得し直し、イメージを付加する、という手順を取ります。

　その他の仕様は以下の通りとしました。

付加するイメージについては、(1)OS標準のアイコン（注1）、(2)カラーチップ、とする。
カラーチップの方はクラス化して、再利用性を高める。
カラーチップはプリセットカラーと、カラーパネルを使った任意のカラーを、セットできるようにする。
カラーチップは、変更しないものについては、あらかじめ画像ファイルを作ってプロジェクトに追加しておく方法もあるが、任意のカラー対応が必要なことや、オーバーヘッドもさほど大きくないと考えられることから、ここでは、その都度NSImageを生成して塗りつぶす方法とする。

注1）利用にあたっては、例によって、以下のサイトを参考にさせて頂きました。
　参考サイト(1)：Fucking NSImage Syntax

　Xojoでの実装

　今回のサンプルは量が少ないので、二つ分をまとめて一つのプロジェクトとしています。

【ソースコードのコピー＆ペーストについて】
ソースコード（グレー背景部分の全文）をコピーし、指定のウィンドウ／クラスにペーストすると、（新規作成して名前等を個別にコピー＆ペーストしなくても）復元されます。
ただし、この方法は、メソッドでは問題ないようですが、イベント／アクション／プロパティでは不安定？なので、ペーストできない場合は、各項目のカッコ内を適用して下さい。

Xojoで新規プロジェクトを作成
新規クラス（名前は、ここでは「PopupColorChip」）を作成し、Superを「PopupMenu」にする。
PopupColorChipにイベント定義を追加し、イベント名を「Change」にする。

以下をPopupColorChipにペースト（できなければ、Sub - Endの間をChangeイベントに記述）

Sub Change() Handles Change
  
  // 最後の行が選択されたらカラーダイアログ表示
  if me.ListIndex=me.ListCount-1 then
    SetSelectedColor()
  end if
  
  // インスタンスに継承
  call Change()
  
End Sub

以下をPopupColorChipにペースト

Public Sub InitPopup()
  
  // メニュー生成（OSXファインダのカラー）
  me.AddRow "レッド"
  me.AddRow "オレンジ"
  me.AddRow "イエロー"
  me.AddRow "グリーン"
  me.AddRow "ブルー"
  me.AddRow "パープル"
  me.AddRow "グレイ"
  me.AddRow "その他..."
  
  // プリセットカラーのセット（OSXファインダのカラー）
  clrArray(0) = RGB(252,77,77)
  clrArray(1) = RGB(253,155,46)
  clrArray(2) = RGB(254,207,46)
  clrArray(3) = RGB(118,223,82)
  clrArray(4) = RGB(67,175,247)
  clrArray(5) = RGB(202,120,225)
  clrArray(6) = RGB(148,148,151)
  
  // メニューにカラーチップをセット
  SetColorChip()
  
  // 先頭を選択
  me.ListIndex=0
  
End Sub

以下をPopupColorChipにペースト

Protected Function MakeColorChip(rgb As Color) as Ptr
  
  // 文字列を指定してクラスオブジェクトを取得する。最初に一回宣言しておけばよい。
  Declare Function NSClassFromString Lib "Cocoa" (aClassName As CFStringRef) As Ptr
  
  Dim cc As Ptr
  Declare Sub setColor Lib "Cocoa" selector "set" (class_id As Ptr)
  Dim bezie As Ptr = NSClassFromString("NSBezierPath")
  
  // NSImageの初期化
  Dim image1 As Ptr = NSClassFromString("NSImage")
  Declare Function alloc Lib "Cocoa" selector "alloc" (receiver As Ptr) As Ptr
  Declare Function initWithSize Lib "Cocoa" Selector "initWithSize:" (receiver As Ptr, name As NSSize) As Ptr
  image1 = initWithSize(alloc(image1), NSMakeSize(24,17))
  
  // ロックフォーカス
  Declare Sub lockFocus Lib "Cocoa" selector "lockFocus" (class_id As Ptr)
  lockFocus(image1)
  
  // 塗りつぶし色（指定色）
  cc = RGBtoNSColor(rgb)
  setColor(cc)
  
  // 塗りつぶし描画
  Declare Sub fillRect Lib "Cocoa" selector "fillRect:" (class_id As Ptr, rect As NSRect)
  fillRect(bezie, NSMakeRect(0.5,2.5,23,12))  // 滲みを消すために0.5足している（効果薄い？）
  
  // 外枠色（グレー）
  cc = RGBtoNSColor(RGB(154,154,154))
  setColor(cc)
  
  // 外枠描画
  Declare Sub strokeRect Lib "Cocoa" selector "strokeRect:" (class_id As Ptr, rect As NSRect)
  strokeRect(bezie, NSMakeRect(0.5,2.5,23,12))  // 滲みを消すために0.5足している
  
  // アンロックフォーカス
  Declare Sub unlockFocus Lib "Cocoa" selector "unlockFocus" (class_id As Ptr)
  unlockFocus(image1)
  
  // イメージを返す
  return image1
  
End Function

以下をPopupColorChipにペースト

Protected Function RGBtoNSColor(rgb As Color) as Ptr
  Dim r, g, b As Single
  
  // 0〜255 を 0.0〜1.0 にマッピング
  r=rgb.Red/255
  g=rgb.Green/255
  b=rgb.Blue/255
  
  // 文字列を指定してクラスオブジェクトを取得する。最初に一回宣言しておけばよい。
  Declare Function NSClassFromString Lib "Cocoa" (aClassName As CFStringRef) As Ptr
  
  // カラーの取得
  Dim clr As Ptr = NSClassFromString("NSColor")
  
  // RGB値からカラーを生成
  Declare Function colorWithCalibrate Lib "Cocoa" Selector "colorWithCalibratedRed:green:blue:alpha:" _
  (receiver As Ptr, red As Single, green As Single, blue As Single, alpha As Single) As Ptr
  clr = colorWithCalibrate(clr, r, g, b, 1.0)  // alpha値は常に1.0
  
  // カラーを返す
  return clr
  
End Function

以下をPopupColorChipにペースト

Protected Sub SetColorChip()
  Declare Function itemAtIndex Lib "Cocoa" Selector "itemAtIndex:" (receiver As Integer, idx As Integer) As Ptr
  Declare Sub setImage Lib "Cocoa" Selector "setImage:" (receiver As Ptr, image As Ptr)
  Dim pnt1, image1 As Ptr
  Dim i As Integer
  
  // 行数分繰り返す
  for i=0 to 7
    
    // 行（MenuItem）の取得
    pnt1 = itemAtIndex(me.Handle, i)
    
    // カラーチップ生成
    image1 = MakeColorChip(clrArray(i))
    
    // カラーチップセット
    setImage(pnt1, image1)
    
    // clean up
    Declare Sub release Lib "Cocoa" Selector "release" (receiver As Ptr)
    release(image1)
    
  next
  
End Sub

注）初出時、clean upのステップをループの外に置いていたが、内に置くようにした。（Leaksではどちらもリークを確認できなかったが、趣旨からすると内の方が良さそう。）

以下をPopupColorChipにペースト

Protected Sub SetSelectedColor()
  
  // カラーダイアログ表示
  Dim cc as Color
  Dim ret as Boolean
  ret=SelectColor(cc,"")
  if not ret then  // キャンセルが押されたら戻る
    return
  end if
  
  // 行（MenuItem）の取得
  Declare Function itemAtIndex Lib "Cocoa" Selector "itemAtIndex:" (receiver As Integer, idx As Integer) As Ptr
  Dim pnt As Ptr = itemAtIndex(me.Handle, 7)
  
  // カラーチップ生成
  Declare Function imageNamed Lib "Cocoa" Selector "imageNamed:" (receiver As Ptr, name As CFStringRef) As Ptr
  Dim image As Ptr = MakeColorChip(cc)
  
  // カラーチップセット
  Declare Sub setImage Lib "Cocoa" Selector "setImage:" (receiver As Ptr, image As Ptr)
  setImage(pnt, image)
  
  // clean up
  Declare Sub release Lib "Cocoa" Selector "release" (receiver As Ptr)
  release(image)
  
  // カラーを保持
  clrArray(7)=cc
  
End Sub

以下をPopupColorChipにペースト（できなければプロパティに、名前：clrArray(7)、データ型：Color、を追加）
```
Public Property clrArray(7) as Color = &c000000
```
Window1にPopupMenu（PopupMenu1）を置き、Superを「PopupColorChip」にする。
以下をPopupMenu1にペースト（できなければ、Sub - Endの間をOpenイベントに記述）
```
Sub Open() Handles Open
  // クラスの初期化
  me.InitPopup() 
End Sub
```
Window1にPopupMenu（PopupMenu2）を置く。

以下をPopupMenu2にペースト（できなければ、Sub - Endの間をOpenイベントに記述）

Sub Open() Handles Open
  
  // 文字列を指定してクラスオブジェクトを取得する。最初に一回宣言しておけばよい。
  Declare Function NSClassFromString Lib "Cocoa" (aClassName As CFStringRef) As Ptr
  
  // メニュー生成
  me.AddRow "グリーン"
  me.AddRow "イエロー"
  me.AddRow "レッド"
  
  // 行（MenuItem）の取得
  Declare Function itemAtIndex Lib "Cocoa" Selector "itemAtIndex:" (receiver As Integer, idx As Integer) As Ptr
  Dim pnt1 As Ptr = itemAtIndex(me.Handle, 0)
  Dim pnt2 As Ptr = itemAtIndex(me.Handle, 1)
  Dim pnt3 As Ptr = itemAtIndex(me.Handle, 2)
  
  // 標準イメージの取得
  Dim image1 As Ptr = NSClassFromString("NSImage")
  Dim image2 As Ptr = NSClassFromString("NSImage")
  Dim image3 As Ptr = NSClassFromString("NSImage")
  Declare Function imageNamed Lib "Cocoa" Selector "imageNamed:" (receiver As Ptr, name As CFStringRef) As Ptr
  image1 = imageNamed(image1, "NSStatusAvailable")
  image2 = imageNamed(image2, "NSStatusPartiallyAvailable")
  image3 = imageNamed(image3, "NSStatusUnavailable")
  
  // イメージの設定
  Declare Sub setImage Lib "Cocoa" Selector "setImage:" (receiver As Ptr, image As Ptr)
  setImage(pnt1, image1)
  setImage(pnt2, image2)
  setImage(pnt3, image3)
  
  // 先頭を選択
  me.ListIndex=0
  
End Sub

他に、NSMakeSize（メソッド）、NSSize（構造体）が必要ですが、それらはmacoslibからコピーさせて頂きました。（上記PopupColorChipか、汎用で使いたい場合は適当なモジュールに、コピーする。）

　実行してみたところ、イメージが付加されることを確認しました。
S Shot1

　おわりに

　プリセットカラーはクラス内で設定していますが、より汎用性を持たせたい場合は、InitPopup()の引数で渡す等すればいいでしょう。
　また、任意指定したカラーはクラス内のclrArray(7)が保持していますので、必要なら再利用することもできます。

　なお、今回も仕組みを理解するために、極力シンプルな書き方を心懸けています。

　Leaksによるチェックでは、カラーパネル表示時にリークが検出されましたが、これはXojoのSelectColor()メソッドを使うと発生するもののようで、ユーザレベルでの対応は難しそうです。

　お世話になったサイト

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

　参考サイト(1)：Fucking NSImage Syntax

　更新履歴

　2017.06.17　SetColorChip()を改訂し、おわりに、にLeaksの項を追加。
　2017.06.15　新規作成

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