プログラミング

むしろ、チラシの裏。


32ビット形式のビットマップ

2016/12/21
GIMP でつくった32ビット形式のビットマップが Vcl.Graphics.TBitmap に読めたり読めなかったりするので調べた結果。

GIMP2.6 がつくるビットマップは BitmapVer,3 規格を拡張した独自のファイル。

もともと、Ver,3 ではアルファチャンネルをサポートしておらず、扱えるようになったのは Ver,4 から。誰が始めたのかはわからないけど、先走っちゃったらしい。あるいは、マイクロソフトが泥縄したのかも。
Delphi 2009 以降の TBitmap がサポートしているのはこの形式。

GIMP2.8 がつくるビットマップは BitmapVer,5 規格に基づいた正式なファイル。

なんだけど、32ビット形式のビットマップが読めるソフトは独自規格が対象で、正式なファイルは表示がおかしくなる。と、言うか、Ver,3 以降のビットマップを編集できるソフトが見つからなかった。GIMP 自体、2.6 と 2.8 で互換性が無いし。
TBitmap もこちらには未対応。

つまり、GIMP2.8 が作る32ビット形式のビットマップは、マイクロソフトの規格に従っているため、ほかのソフトは対応していない。

とりあえずは、TBitmap の対応待ち。まあ、みんなして様子見してるから、正式なフォーマットが復旧しないのかもしれないけど。


固定セルのリサイズ

2016/12/21
Vcl.Grids.TCustomGrid 継承コンポーネントの固定セルの幅と高さを実行時に使用者が変更する方法。

CalcSizingState プロテクトメソッドをオーバーライドする。

たとえば、先頭の固定セルの幅を変えるなら、


procedure TStringGrid.CalcSizingState(X, Y: Integer; var State: TGridState;
  var Index: Longint; var SizingPos, SizingOfs: Integer;
  var FixedInfo: TGridDrawInfo);
begin
  inherited;

  if (ColWidths[0] - 2 <= X) and (X <= ColWidths[0] + GridLineWidth + 2) and (Y <= RowHeights[0]) then
  begin
    State := gsColSizing;
    Index := 0;
    SizingPos := ColWidths[0];
    SizingOfs := ColWidths[0] - X;
  end;
end;
State はリサイズする方向。Index はセルのインデックス。SizingPos はセルの境界位置。SizingOfs はセル境界とカーソル位置の差。
Index, SizingPos, SizingOfs は、幅を変えるときは列、高さを変えるときは行を基準にした値を設定する。
これで、固定セルの境界上でカーソルの形状が変わり、ドラッグでサイズが変更できるようになる。

ただし、これだけだと ColWidth[0] の値がおかしくなるので、CalcFixedInfo もオーバーライドしてセルの幅を調整するのだけど……。
実際に幅の計算をしているらしい DrawInfo.Horz.GetExtent 引数の内容がどうなってるのかわからなかった。
仕方が無いので、MouseDown で ColWidth[0] の幅を記録し、MouseUp で書き戻してごまかす。

うん。いまいち。

タブの独自描画

2017/05/02
Vcl.ComCtrls.TTabSheet のタブの外観を変える方法。

結局は Vcl.ComCtrls.TPageControl をオーナードローするのだけど、OnDrawTab イベントではタブの見た目を変えられない(外枠を描画してしまう)ので、CN_DRAWITEM メッセージを処理する。
このとき、タブの範囲全体を描画できるよう、クリッピングリージョンを解除してから描画して、描き終わったらタブの枠を描けないようにリージョンのサイズをゼロにするのがコツ。


procedure Form1.SubWndProc(var Message: TMessage);
var
  TabCanvas: TCanvas;
  Region: HRGN;
begin
  FOlgWndProc(Message);

  case Message.Msg of
    CN_DRAWITEM:
    begin
      TabCanvas := TCanvas.Create;
      try
        TabCanvas.Handle := TWMDrawItem(Message).DrawItemStruct.hDC;
        SelectClipRgn(TabCanvas.Handle, 0); //クリッピングリージョンを解除。

        { 好きな形状で描画。
          タブの位置、インデックス、マルチラインを考慮して描き分ける。
          めちゃくちゃ長くなるので省略 }

        Region := CreateRectRgn(0, 0, 0, 0); //クリッピングリージョンのサイズをゼロに。
        try
          SelectClipRgn(TabCanvas.Handle, Region);
        finally
          DeleteObject(Region);
        end;
      finally
        TabCanvas.Free;
      end;
      Message.Result := 1;
    end;
  end;
end;
TPageControl のウィンドウプロシージャを差し替える形なら上のようになるけど、かなり手間。
ほかにも、スタイルフックを変更する方法もあるけど、手間なのは変わらない。
まずは、書き換えが必要かどうか吟味しないと余計な時間がかかる。と、いうか、かかった。

アクションツールバーにドロップダウンメニュー付きのボタンをつける

2023/11/04
Vcl.ActnMan.TActionClientItem を tbsDropDown 風に。

Vcl.ActnMenus.TActionMainMenuBar なら、アクションマネージャエディタから項目をドラッグアンドドロップで下位項目も作成できるけど、Vcl.ActnCtrls.TActionToolBar だとトップレベルの項目しか作成できないので、各項目の Items プロパティに下位項目を追加する。

具体的には、
1.フォームデザイナか構造ビューからドロップダウンメニューをつけたいボタン(TActionClientItem)を選択。
2.オブジェクトインスペクタで Items プロパティをダブルクリック。
3.ポップアップした編集ダイアログで下位項目を新規追加。
4.追加した項目の Action プロパティにアクションを割り当てる。
5.追加直後はボタンに反映されないので、Style プロパティを変更して元のスタイルに戻せば出来上がり。
ツリーノードに子ノードを追加する要領と同じなんだけど、専用のダイアログとかがないのでちょっと手間。

下位項目があるトップレベル項目は、TCustomDropDownButton 継承クラス、持たない場合は TCustomButtonControl 継承クラス、下位項目は TCustomMenuItem 継承クラスに結び付けられている。どの継承クラスになるかは TActionManager.Style 次第。
コードからメニューをドロップダウンするには、トップレベル項目の DropDownClick メソッドを使用する。


procedure TForm1.Action1Execute(Sender: TObject);
var
  Client: TActionClientItem;
  i: Integer;
begin
  for i := 0 to ActionToolBar1.ActionClient.Items.Count - 1 do
  begin
    Client := ActionToolBar1.ActionClient.Items.ActionClients[i];
    if Client.Action = Action1 then
      if Client.Control is TCustomDropDownButton then //なくてもいいはずだけど、一応。
      begin
        TCustomDropDownButton(Client.Control).DropDownClick;
        Break;
      end;
  end;
end;
大体こんな感じ。

リストビューとツリービューの更新タイミング

2019/04/30
テーマを変えるとフックが外れちゃうと思ったら、これが原因だったよ。

Vcl.ComCtrls.TListView.Items と TTreeView.Items の更新は、描写処理が行われるまで保留される。
このため、 Visible = False だと表示されるまで更新されず、この間は HandleAllocated = False, Items.Count = 0 で、画面オブジェクトハンドルが解放されたままになる。

フォームを非表示にしている間にデスクトップテーマが変わった場合、フォームを表示するまでリストビューとツリービューからアイテムが読み出せない。読み方によっては、アクセス違反を起こすかも。
また、アイテムが読めないので Item.Data にもアクセスできない。何らかの値を設定していた場合、この状態で終了するとメモリリークを起こす。
フォームを非表示で動作するタスクトレイ常駐型のプログラムで、動作設定にリストビューを使っていると、誤動作のもとになる。

表示されていない間は描写しないのはいいとしても、アイテムを読めないのは不具合のような……。Vcl.StdCtrls.TCheckBox とかは平気なんだし。

ともあれ、Items を読み出す前に HandleNeeded を呼んで更新しておけば、誤動作は防げる。
手っ取り早いところで、


interface

type
  TListView = class(Vcl.ComCtrls.TListView)
  private
    function GetItems: TListItems;
    procedure SetItems(Value: TListItems);
  published
    property Items: TListItems read GetItems write SetItems;
  end;

implementation

function TListView.GetItems: TListItems;
begin
  HandleNeeded;
  Result := inherited Items;
end;

procedure TListView.SetItems(Value: TListItems);
begin
  HandleNeeded;
  inherited Items := Value;
end;
というのをフォームの前に追加するのが楽かも。コピペで使いまわせるし。

ドッキング状態の復元

2021/12/31
Vcl.Controls.TWinControl.DockManager.LoadFromStream ではまったところ。

たとえば Panel1 のドッキング状態を保存するのは Panel1.DockManager.SaveToStream でできる。
バイナリ形式なんで読みずらいけど、System.Classes.BinToHex で変換すれば、一応はテキスト形式でも保存可能。

復元は Panel1.DockManager.LoadFromStream で元に戻せる。
ただし、 LoadFromStream 内で TWinControl.ReloadDockedControl を呼んでいるため、ドッククライアントはホストと同じオーナーでなければならない。
つまり、自動生成したフォームのオーナーは Application になるため、ドッキング状態が復元できない。
同じ理由で、クライアントの名前が未設定だと処理に失敗する。

LoadFromStream が動作しなかったので、ライブラリソースを追って行ってようやくわかったんだけど……どっかに書いてあったっけ?

それと、非表示状態でドッキングしているものはドッキング後に隠してくれるけど、逆に表示してドッキングというのはしてくれない。
ドッキング後に表示するとレイアウトが変わってしまうので、あらかじめ表示しておかないとならない。

さらに、Vcl.DockTabSet.TDockTabSet や Vcl.ComCtrls.TPageControl はドックマネージャーを使っていないので、いきなり DockTabSet1.DockManager.SaveToStream なんてやるとアクセス違反を起こす。
仮に割り当てたとしても、クライアントのホストと親が別になるこれらのコントロールは処理できないので、やっぱり保存・復元できない。
この辺りは、自力で保存・復元するか、対応したドックマネージャーを作るしか無そう。

なんか、中途半端。


ドッキングタブセットのドッククライアント

2021/11/01
常に Vcl.DockTabSet.TDockTabSet.DockClientCount = 0 になるけど?

ドッキングタブセットにドッキングしたクライアントは、ドッキングタブセットが動的に生成した TTabDockPanel というパネルに乗っている。
正確には、クライアントを表示したときに作成して乗せるので、それまではクライアントの親は nil になるけど。
クライアントがドッキングタブセットに乗っているわけではないので、DockClientCount = 0 になるのは正しいと言えなくもない。

と、いう理屈はひねり出せるけど、単純にプロパティの再設定を忘れてるだけなんだろうなぁ。

対策として、クラスヘルパを使ってプライベート変数を読み出す方法を試すうち、Delphi 10.4 では直っていることに気が付いた。あ、あれ?
いつだったか調べたときはゼロしか返らなかったのを憶えているし、ライブラリソースを見る感じ、修正した様子はないけど……Community Edition には古いソースが入ってるのかも。
ともあれ、Delphi をバージョンアップすればいいことが分かった。

と、いうか、ここ、消しちゃってもいいかも。


ドッククライアントのリサイズ

2021/10/13
ドッキングしているコントロールの幅・高さをコード上で変更する方法。

ドッククライアントの位置とサイズは Vcl.Controls.TDockZone が管理しており、横並びなら幅、縦なら高さを TDockZone.ZoneLimit で指定できる。
正確には、ZoneLimit の値はクライアントの実寸ではなく、ドッククライアントのクライアント領域の幅か高さにグラバーやスプリッターのサイズを加えた、ホスト上の領域になるけど。
そして、TDockZone は Vcl.Controls.TDockTree.TopZone 以下に二重連結リストツリーに似た形で保管されており、TDockTree が実装している Vcl.Controls.IDockManager インターフェースが Vcl.Controls.TWinControl.DockManager に設定される。

つまり、ドッキングマネージャプロパティからドッキングマネージャ本体の機能を呼べない。
直接は呼べなくても、作成したドッキングツリーを変数に保存して、それをドッキングマネージャに割り当てれば、変数から間接的に呼ぶことはできる。

たとえば、Form1.Panel1 に Form2 と From3 を縦並びでドッキングし、From2 の高さを Panel1 の四分の一で起動するならこんな感じ。


type
  TDockTreeHacker = class(TDockTree);  //プロテクトメンバアクセスクラス。

//DockTree が管理している Control の TDockZone を返す。
//TDockTree.FindControlZone というのがあるけど、プライベートメンバなので作り直し。
function FindVisibleControlZone(DockTree: TDockTree; Control: TControl): TDockZone;

  function TraverseTree(StartZone: TDockZone): TDockZone;
  begin
    Result := nil;
    if Assigned(StartZone) then
    begin
      if StartZone.ChildControl = Control then
        Result := StartZone;
      if Result = nil then
        Result := TraverseTree(StartZone.NextVisible);
      if Result = nil then
        Result := TraverseTree(StartZone.FirstVisibleChild);
    end;
  end;

begin
  Result := nil;
  if Assigned(DockTree) and Assigned(Control) then
    Result := TraverseTree(TDockTreeHacker(DockTree).TopZone);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Tree: TDockTree;  //本来なら TForm1 に持たせるべきだけど、とりあえず。
  Zone: TDockZone;
begin
  //ドッキングマネージャを設定。
  //いったん設定したドッキングマネージャを変更するとグラバーが反応しなくなるので、使用しない状態で起動してから設定すること。
  Tree := DefaultDockTreeClass.Create(Panel1);
  Panel1.DockManager := Tree;
  Panel1.UseDockManager := True;              //オブジェクトインスペクタでは False にする。
  DockTabSet1.DestinationDockSite := Panel1;  //ドッキングタブセットで使うならここで割り当てる。

  //From2 をドッキング。
  Form2 := TForm2.Create(Self);  //Panel1.DockManager.LoadFromStream を使う場合。
  Form2.Show;
  Form2.ManualDock(Panel1);

  //Form3 をドッキング。
  Form3 := TForm3.Create(Self);  //Panel1.DockManager.LoadFromStream を使う場合。
  Form3.Show;
  Form3.ManualDock(Panel1, nil, alBottom);

  //サイズを変更。
  //調節は先頭から行われ、末尾のサイズは計算結果で決まる。この場合 Form3 のサイズは設定できない。
  Zone := FindVisibleControlZone(Tree, Form2);
  Zone.ZoneLimit := Panel1.Height div 4;
  TDockTreeHacker(Tree).ResetBounds(True);  //最後に呼んで更新する。
end;
DockManager プロパティの型が TDockTree になってればよかったのに。あと、柔軟な変更も。

戻る