プログラミング

むしろ、チラシの裏。

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;

タブの独自描画

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;

戻る