ｙTakeです。
当方、DELPHI XE6 with FMXです。
TGridにTImageColumnを複数配置しています。（カラム数は可変です）
あるImageColumnセルをダブルクリックしたらそのセルを枠で囲む事を考えます。
Grid1DbClickで、
var
idx : Byte;
bRect : TRectF;
bBr : TStrokeBrush;
begin
idx := Grid1.ColumnIndex;
bRect := TRectF.Create( 0, 0, Grid1.Columns[ idx ].Width - 1, Grid1.Columns[ idx ].Height - 1 );
bBr := TStrokeBrush.Create( TBrushKind.Solid, TAlphaColors.Yellowgreen );
Grid1.Columns[ idx ].Canvas.BeginScene();
Grid1.Columns[ idx ].Canvas.DrawRect( bRect, 0, 0, ALLCORNERS, 1, bBr );
Grid1.Columns[ idx ].Canvas.EndScene();
end;
としてみましたが、Grid1のあるセルをダブルクリックすると枠は描画されますが、ダブルクリックされたセルを囲う様な枠ではなく、フレームの原点を起点とした枠になってしまいます。（枠の大きさは正しく描画出来ている様です）
また、セル数（カラム数）が多くGrid幅を超えている為、左右にスクロールしてセルを移動しダブルクリックします。この時ダブルクリックで表示された枠も当然スクロールに合わせて移動する様にしたいと思います。
現状のフレーム起点の枠はスクロールしても移動しません。
Column[idx]に帰属するCanvasに枠を描画させているつもりなのですが、フレーム起点で描画されてしまっている様です。
ご教示頂ければと思います。
試していませんが、枠の描画自体はOnDrawColumnCellイベントで行うのは、いかがですか？
igyさん
ありがとうございました。
OnDrawColumnCellですね。
早速、試してみました。
ほぼ思い通りにセルに枠を描けました。もちろん、スクロールと一緒に移動します。
ただ、シングルクリックでそのセル枠が表示されますが、ダブルクリックでは枠は表示されません。
更には、クリックの間が開いても２回目のクリックでセル枠は消えてしまいます。
onDrawColumnCellでは、
var
bBr : TStorokeBrush;
begin
bBr := TStrokeBrush.Create( TBrushKind.Solid, TAlphaColors.Yellowgreen );
if ( Grid1.ColumnIndex = Column.Index ) then
Canvas.DrawRect( Bounds, 0, 0, ALLCORNERS, 1, bBr );
end;
としていて、他には何も描画や処理は行なっていません。
２回目のセルクリックで枠が消えるのは何故でしょう？
onDrawColumnCellでは、
Column.indexを監視していて、クリックされたセル列を示すGrid１.ColumnIndexと現在描画中のセル行が一致する場合のみ、枠を描画しています。
一方で、Grid１Clickでは何も処理を行なっていません。
Grid１DbClickでもGrid1に関わる処理は行なっておりません。
気になっている点としては、Grid1Clickでブレイクポイントを設けて、Grid1.ColumnIndexを監視したのですが、１回目のクリックでGrid1Clickへ飛んでいます。その後たぶんonDrawColumnCellへも飛んで枠を描画します。２回目のクリックでもGrid1Clickへ飛びま。その後onDraeColumnCellへ飛んでいないのか、枠は描画されません。
更に、３回目のクリック以降は何故かGrid1Clickへも飛んでいません。
そこで、Grid1Clickで強制的にonDrawColumnCellが発生する様にGrid1.Repaintを読んでみましたが、状況は変わりません。
onDrawColumsCellの作法が理解出来ていない様に思いますが、ヘルプでも詳しくは記述されていない様で良く分かりません。
どこか確認すべき点があればご教示頂ければと思います。
次の様なやり方ではどうでしょう？
TGridコンポーネント上にTRectangleコンポーネントを乗っける方法です。
「構造」
Form1
┗Grid1
┣ImageColumn1
┣ImageColumn2
┣ImageColumn3
┣ImageColumn4
┣ImageColumn5
┗Rectangle1
「FMXコード」
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, System.Rtti, FMX.Grid, FMX.Layouts, FMX.Objects,
System.UIConsts;
type
TForm1 = class(TForm)
Grid1: TGrid;
ImageColumn1: TImageColumn;
ImageColumn2: TImageColumn;
ImageColumn3: TImageColumn;
ImageColumn4: TImageColumn;
ImageColumn5: TImageColumn;
Rectangle1: TRectangle;
procedure FormCreate(Sender: TObject);
procedure Grid1SelectCell(Sender: TObject; const ACol, ARow: Integer; var CanSelect: Boolean);
procedure Grid1ViewportPositionChange(Sender: TObject; const OldViewportPosition, NewViewportPosition: TPointF; const ContentSizeChanged: Boolean);
private
{ private 宣言 }
SelectCol : Integer; // 選択中の列
SelectRow : Integer; // 選択中の行
public
{ public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
// 最初の処理
procedure TForm1.FormCreate(Sender: TObject);
begin
// 選択中変数を初期化
SelectCol := -1;
SelectRow := -1;
// 枠を初期化 ( ここはオブジェクトインスペクタで設定しても良い )
Rectangle1.Fill.Kind := TBrushKind.None; // 塗り潰し無し
Rectangle1.Stroke.Color := claYellowGreen; // 枠の色
Rectangle1.Stroke.Thickness := 3; // 枠の太さ
Rectangle1.HitTest := FALSE; // クリックを透過させる
Rectangle1.Visible := FALSE; // 最初は表示OFF
end;
// セルを選択した時にする描画
procedure TForm1.Grid1SelectCell(Sender: TObject; const ACol, ARow: Integer; var CanSelect: Boolean);
begin
// セル番号を保存
SelectCol := ACol;
SelectRow := ARow;
// 枠を描画
Rectangle1.Position.X := Grid1.ColumnByIndex(ACol).Position.X;
Rectangle1.Position.Y := Grid1.RowHeight * ARow;
Rectangle1.Width := Grid1.Columns[ACol].Width;
Rectangle1.Height := Grid1.RowHeight;
Rectangle1.Visible := TRUE;
end;
// 列の幅を変更した時に実行
procedure TForm1.Grid1ViewportPositionChange(Sender: TObject; const OldViewportPosition, NewViewportPosition: TPointF; const ContentSizeChanged: Boolean);
var
CanSelect : Boolean;
begin
// 選択中？
if SelectCol > -1 then
begin
// 描画し直す
Grid1SelectCell(Grid1, SelectCol, SelectRow, CanSelect);
end;
end;
end.
「動作確認」
Delphi XE8
TRectangle(枠)がTGridの子なので、上下左右にスクロールさせてもちゃんと付いてきます。
列の幅を変更しても枠の大きさが変わります。
よくわかっていないのに、ソースコードを投稿することをお許しください。
FMXのTGridは使い方が難しいですね。
外していたらすいません。
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, System.Rtti,
FMX.Grid.Style, FMX.Grid, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo,
System.ImageList, FMX.ImgList;
type
TForm1 = class(TForm)
Grid1: TGrid;
procedure FormCreate(Sender: TObject);
procedure Grid1SetValue(Sender: TObject; const ACol, ARow: Integer;
const Value: TValue);
procedure FormDestroy(Sender: TObject);
procedure Grid1GetValue(Sender: TObject; const ACol, ARow: Integer;
var Value: TValue);
procedure Grid1DrawColumnCell(Sender: TObject; const Canvas: TCanvas;
const Column: TColumn; const Bounds: TRectF; const Row: Integer;
const Value: TValue; const State: TGridDrawStates);
procedure Grid1CellDblClick(const Column: TColumn; const Row: Integer);
private
{ private 宣言 }
pt:TPoint;
bmparr:array of array of TBitmap;
public
{ public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
procedure TForm1.FormCreate(Sender: TObject);
var imgc:TImageColumn;
c:Integer;
begin
Grid1.RowHeight:=40;
Grid1.RowCount:=40;
Grid1.Options:=
Grid1.Options+[{TGridOption.AlwaysShowEditor,} TGridOption.Editing];
pt:=Point(-1,-1);
for c := 0 to 9 do
begin
imgc:=TImageColumn.Create(Grid1);
imgc.Width:=40;
Grid1.AddObject(imgc);
end;
SetLength(bmparr,Grid1.ColumnCount);
for c := 0 to Grid1.ColumnCount-1 do
begin
SetLength(bmparr[c],Grid1.RowCount);
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var c,r:Integer;
begin
for c := Low(bmparr) to High(bmparr) do
for r := Low(bmparr[c]) to High(bmparr[c]) do
begin
if assigned(bmparr[c,r]) then
begin
FreeAndNil(bmparr[c,r]);
end;
end;
end;
procedure TForm1.Grid1CellDblClick(const Column: TColumn; const Row: Integer);
begin
pt.X:=Column.Index;
pt.Y:=Row;
end;
procedure TForm1.Grid1DrawColumnCell(Sender: TObject; const Canvas: TCanvas;
const Column: TColumn; const Bounds: TRectF; const Row: Integer;
const Value: TValue; const State: TGridDrawStates);
begin
if (pt.X=Column.Index) and (pt.Y=Row) then
begin
Canvas.Stroke.Thickness:=2;
Canvas.Stroke.Dash:=TStrokeDash.Solid;
Canvas.Stroke.Color:=TAlphaColors.Yellowgreen;
Canvas.DrawRect(Bounds,0,0,[],1);
end;
end;
procedure TForm1.Grid1GetValue(Sender: TObject; const ACol, ARow: Integer;
var Value: TValue);
begin
if assigned(bmparr[ACol,ARow]) then
Value:=bmparr[ACol,ARow];
end;
procedure TForm1.Grid1SetValue(Sender: TObject; const ACol, ARow: Integer;
const Value: TValue);
begin
if not assigned(bmparr[ACol,ARow]) then
begin
bmparr[ACol,ARow]:=TBitmap.Create;
end;
bmparr[ACol,ARow].Assign(TBitmap(Value.AsObject));
end;
end.
procedure TForm6.Grid2DrawColumnBackground(Sender: TObject;
const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF;
const Row: Integer; const Value: TValue; const State: TGridDrawStates);
var
idx : Byte;
bRect : TRectF;
bBr : TStrokeBrush;
begin
idx := Grid1.ColumnIndex;
bRect := TRectF.Create( 0, 0, Grid1.Columns[ idx ].Width - 1, Grid1.Columns[ idx ].Height - 1 );
bBr := TStrokeBrush.Create( TBrushKind.Solid, TAlphaColors.Yellowgreen );
bRect.Left := Bounds.Left;
bRect.Right := Bounds.Right;
Canvas.BeginScene();
Canvas.DrawRect( bRect, 0, 0, ALLCORNERS, 1, bBr );
Canvas.EndScene();
end;
かな？
AAAAさん、"よくわかっていないですが"さん、KONNOYAさん
ありがとうございます。
AAAAさん、残念ながらXE6では"onDrawColumnBackground"が実装されていない様子です。
"よくわかっていないですが"さん、まだ試せていません。TRectangleを試した後にやってみます。
KONNOYAさん、TRectangleを試しています。当初、うまくいっていたようですが、不可解な現象に直面しています。
Gridの列数が可変なのですが、起動時は１行５列になっています。この時は、希望通りにセル枠を描画している様に思いました。
５列での枠描画がうまくいった後、列数を増やして試したところ、ダブルクリックで指定したセルの次のセルに枠が描画されてしまいます。
この状態で、５列目以前の列を指定すると正しく指定したセルに枠が描画されます。
また、６列目以降にでは指定したセルの２つ又は３つ隣のセルに枠が表示される場合もあって、困惑しているところです。
原因究明中ですが、現状のご報告まで。
ああ、動的に列を追加する場合は想定しておりませんでした。すみません。
恐らく、TGridコンポーネントは配下の子コポーネントをTColumnとして見なしているでしょうから、
イレギュラーなTRectangleコンポーネントもカウントしているのでしょう。
そこで、列を追加する前に、TRectangleコンポーネントをどけてあげて、
列の追加後にTGridコンポーネントに戻してあげましょう。
procedure TForm1.Button1Click(Sender: TObject);
var
Column: TColumn;
begin
Rectangle1.Parent := nil;
Column := TStringColumn.Create(Grid1);
Column.Header := '新しい列';
Grid1.AddObject(Column);
Rectangle1.Parent := Grid1;
end;
子コポーネントありきのTGridの様なコンポーネントは、
この「乗っける」方式は他の場面でも問題が出るかもしれませんね。
ちなみに、Delphi 11.2では次の様にしたらできました。
「構造」
Form1
┗Grid1
┣ImageColumn1
┣ImageColumn2
┣ImageColumn3
┣ImageColumn4
┗ImageColumn5
「FMXコード」
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, System.StrUtils,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, System.Rtti, FMX.Grid.Style, FMX.Grid, FMX.Controls.Presentation, FMX.ScrollBox,
FMX.Objects;
type
TForm1 = class(TForm)
Grid1: TGrid;
ImageColumn1: TImageColumn;
ImageColumn2: TImageColumn;
ImageColumn3: TImageColumn;
ImageColumn4: TImageColumn;
ImageColumn5: TImageColumn;
procedure FormCreate(Sender: TObject);
procedure Grid1CellClick(const Column: TColumn; const Row: Integer);
procedure Grid1DrawColumnCell(Sender: TObject; const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF; const Row: Integer; const Value: TValue; const State: TGridDrawStates);
procedure Grid1DrawColumnBackground(Sender: TObject; const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF; const Row: Integer; const Value: TValue; const State: TGridDrawStates);
private
{ private 宣言 }
public
{ public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
procedure TForm1.FormCreate(Sender: TObject);
begin
// 選択中Row保存用
Grid1.Tag := -1;
// イベント設定
Grid1.OnCellClick := Grid1CellClick;
Grid1.OnDrawColumnBackground := Grid1DrawColumnBackground;
Grid1.OnDrawColumnCell := Grid1DrawColumnCell;
end;
procedure TForm1.Grid1CellClick(const Column: TColumn; const Row: Integer);
begin
Grid1.Tag := Row; // 選択されたRowを保存
Grid1.BeginUpdate;
Grid1.Repaint;
Grid1.EndUpdate;
end;
procedure TForm1.Grid1DrawColumnBackground(Sender: TObject; const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF; const Row: Integer; const Value: TValue; const State: TGridDrawStates);
var
bBr: TStrokeBrush;
begin
// カラム一致？
if Grid1.ColumnIndex = Column.Index then
begin
// ロウ一致？
if Grid1.Tag = Row then
begin
// ブラシ
bBr := TStrokeBrush.Create(TBrushKind.Solid, TAlphaColors.Yellowgreen);
bBr.Thickness := 3;
// 矩形描画
Canvas.BeginScene;
Canvas.DrawRect(Bounds, 0, 0, ALLCORNERS, 1, bBr);
Canvas.EndScene;
end;
end;
end;
procedure TForm1.Grid1DrawColumnCell(Sender: TObject; const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF; const Row: Integer; const Value: TValue; const State: TGridDrawStates);
var
bBr: TStrokeBrush;
A: TRectF;
begin
// カラム一致？
if Grid1.ColumnIndex = Column.Index then
begin
// ロウ一致？
if Grid1.Tag = Row then
begin
// ブラシ
bBr := TStrokeBrush.Create(TBrushKind.Solid, TAlphaColors.Yellowgreen);
bBr.Thickness := 3;
// 与えられたBoundsの矩形の大きさが異なるので調整
Bounds.Offset(-2, -2);
Bounds.Width := Bounds.Width + 4;
Bounds.Height := Bounds.Height + 4;
// 矩形描画
Canvas.BeginScene;
Canvas.DrawRect(Bounds, 0, 0, ALLCORNERS, 1, bBr);
Canvas.EndScene;
end;
end;
end;
end.
KONNOYAさん
ありがとうございます。
うまく動作する様になりました。
列を増やす際に、列以外のコンポーネントを外して、増やした後に戻すと言うやり方があるのですね。
それまで曲がりなりにも動作していたものが、急に範囲チェックエラーも出る様になり、列数は一見あっているのに、何故か分かりませんでした。
なるほど、コンポーネントのカウント間違いが発生していた言う事なのですね。
と言う事は、列を減らす必要があった場合にも、同様と言う事ですね。
ただ、根本的にコンポーネント自身のカウントに誤りが生じる以上、他に、何か影響が出る可能性があると言う事ですね。
今のところ、問題は無さそうですが、ご教示頂けた別の手法も検討してみます。
皆様、ありがとうございました。
もう１つの方法が、スタイルブックを使用する方法があります。
こちらは前の方法とは若干異なる表示になってしまいますが、似た様な事ができます。
Delphi XE6の環境が無く、Delphi XE8での話ですが。
(1) FormにTGridを配置
(2) TGirdを右クリックしてポップアップメニューを表示させ「カスタムスタイルの編集」を選択
※ 自動的にTStyleBookコンポーネントが追加され、スタイルブック編集画面に移行します。
(3) 下記の位置にRectangle1を追加
grid1style1
┗background
┗content
┣focus ← (5)で設定
┃┗rectangle1style ← (4)で設定
┗selection ← (6)で設定
※ ツールパレットからTRectangleをfocus項目の配下にドラッグ＆ドロップします。
(4) 追加したrectangle1style項目を選択して、下記のプロパティを設定します
Align = Contents
Fill.Kind = None
Stroke.Color = Yellowgreen
Stroke.Thickness = 3
Margins.Bottom = 2
Margins.Left = 2
Margins.Right = 1
Margins.Top = 1
(4) その１つ上のfocus項目を選択して、下記のプロパティを設定します
ClipChildren = True
Fill.Color = While
Stroke.Kind = None
(5) selection項目を選択して、下記のプロパティを設定します
Fill.Kind = None
Stroke.Kind = None