エクセルなどの表計算ソフトで「行と列の固定」という機能があるんですが、それをStringGridやVirtualTreeで実現したいと。そう思ったことがあります。
それを実現するためにコンポーネントを複数置いて、セルの移動ごとに左上の位置を同期してみたりと今まではやってました。
できないことはないんですが、どうも野暮ったい。結構ズレる。何とかスマートな方法はないものか。
そう思って出した妥協案がこちら（今回は列だけの固定）。
⇒ マウスドラッグでスクロールさせちゃえばそれっぽく見えね？
とりあえずCol,Rowのサイズを画面に表示される部分に限定しておいて、表示部分を移動させたければ表示部分をドラッグして移動しているように見せる。
という方法です。
これは某ソフトウェアがやっていたのを パク 参考にしたものです。
サイズを偽装（人聞きが悪い。。）しているのでスクロールバーが出ませんが、まぁ仕方がない。なんならスクロールバーコントロールを別途付けてそれっぽく見せる。という方法もあるかもしれません。
試してないので責任は持てませんが。
ソース
で、ソース。ユニット名はご自由に。
VirtualTree に関しては VirtualStringTree限定（それ以外使ったことがないので）。テストは VirtualStringTree で確認（StringGridでは未確認）。ソースに解説がなくてごめんなさい。
SetControl ではもっとうまい方法がないでしょうかね。今は与えられたコンポーネントについて１つ１つコントロールの確認を行ってイベントの設定を行ってるんですけど、これを一度にやりたい。
クラスの形をとっているのでインスタンスを作成して SetControl でコントロールをセット。
この際にイベントが同時にセットされます。
DivSpan プロパティはどれだけ移動したらセルが１つ移動するかという数値です。初期値は30にセットしてあります。ここはご随意に。
で、表示部は別に用意する必要があります。それはまた後述。
【ソース】
unit DumUnit;
interface
uses Vcl.Controls, System.Classes, Vcl.Grids,VirtualTrees
;
type
//=====================================================================
// ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
//=====================================================================
TNYFixedCol=class
private
FDragStartPos:integer;
FDragStartOfs:integer;
FLeftOfs :integer;
FDivSpan :integer;
FRefresh:boolean;
FControl:TControl;
procedure FOnMouseDown(Sender: TObject; Button: TMouseButton
; Shift: TShiftState; X, Y: Integer);
procedure FOnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FOnMouseUp(Sender: TObject; Button: TMouseButton
; Shift: TShiftState; X, Y: Integer);
public
constructor Create;
destructor Destroy; override;
function SetControl(Comp:TControl):boolean;
property RefreshMode:boolean read FRefresh write FRefresh;
property DivSpan:integer read FDivSpan write FDivSpan;
property LeftOfs:integer read FLeftOfs;
end;
implementation
//=====================================================================
// ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
//=====================================================================
constructor TNYFixedCol.Create;
begin
FDragStartPos:=-1;
FDragStartOfs:=0;
FDivSpan :=30;
FRefresh :=True;
end;
destructor TNYFixedCol.Destroy;
begin
inherited;
end;
function TNYFixedCol.SetControl(Comp:TControl):boolean;
begin
Result:=((Comp is TStringGrid) or (Comp is TVirtualStringTree));
if not Result then exit;
FControl:=Comp;
if FControl is TStringGrid then begin
with TStringGrid(FControl) do begin
OnMouseDown:=FOnMouseDown;
OnMouseMove:=FOnMouseMove;
OnMouseUp :=FOnMouseUp;
end;
end
else if FControl is TVirtualStringTree then begin
with TVirtualStringTree(FControl) do begin
OnMouseDown:=FOnMouseDown;
OnMouseMove:=FOnMouseMove;
OnMouseUp :=FOnMouseUp;
end;
end
;
end;
procedure TNYFixedCol.FOnMouseDown(Sender: TObject; Button: TMouseButton
; Shift: TShiftState; X, Y: Integer);
begin
if ssLeft in Shift then begin
FDragStartPos:=x;
FDragStartOfs:=FLeftOfs;
end;
end;
procedure TNYFixedCol.FOnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if FDragStartPos=-1 then exit;
FLeftOfs:=FDragStartOfs-((x-FDragStartPos)div FDivSpan);
if FRefresh then FControl.Refresh;
end;
procedure TNYFixedCol.FOnMouseUp(Sender: TObject; Button: TMouseButton
; Shift: TShiftState; X, Y: Integer);
begin
FDragStartPos:=-1;
end;
end.
表示部ほか
とりあえず設定部分から。
■ 宣言部の Private あたりでインスタンス用の変数を設定
FFixedCol:TNYFixedCol;
■ フォームの OnCreate と OnDestroy あたりで以下のコードを実行。
procedure TForm1.FormCreate(Sender: TObject); begin FFixedCol:=TNYFixedCol.Create; FFixedCol.SetControl(VirtualStringTree1); end; procedure TForm1.FormDestroy(Sender: TObject); begin FreeAndNil(FFixedCol); end;
で、表示部。VirtualStringTreeで。VirtualStringTreeなら OnGetTextイベントにて。参考まで。
procedure TForm1.VirtualStringTree1GetText( Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); begin if not Assigned(node) then exit; case Column of 0..2:CellText:=(Column+1).ToString; else CellText:=(FFixedCol.LeftOfs+Column).Tostring; end; end;
多分これでイケるはず。
固定部分は左側３列(Caseでいうところの 0..2)が１，２，３で固定されていて、マウスドラッグをするとそれ以降の数字がドラッグに応じて変わるという形になっています。
固定列を可変にしたいならcase文をやめて Column を if 文で判断するとよいでしょう。
これが実際の横位置
FFixedCol.LeftOfs+Column
表示領域のデータを位置で保存しているなら、上記式が Col の値。僕は
type TNYPos=Record Col:integer; Row:integer; end;
といったレコードを用意しておいて、
FGridVal:TDictionary<TNYPos,String>;
といった変数を用意してデータを保存します。
で、これを実行するにあたり、VirtualStringTree のカラムを設定しておく必要があります。
Header.Columns でカラムを追加しておいて下さい。さらに表示すべき行がないと表示できないので行も追加で。
ソースでやるならフォームの OnCreate 部に以下のコードを追加。
with VirtualStringTree1 do begin with Header.Columns do begin add; add; add; add; add; add; add; end; AddChild(nil); end;
まぁ超適当。
これでとりあえずは動くと思います。
※スクロールバーコンポーネントを別途追加してそれっぽく見せるなら、VirtualStringTree の OnGetText イベントのあたりをゴニョニョとすればできるかもしれませんね。今、記事を書いていてそう思いました。
