StringGrid Enterキーでセル移動(横・縦）
StringGridのOptionsプロパティの goEditing=Trueにしたとき
StringGridのColorプロパティをclWindow以外の色にすれば編集状態時にセル位置が見やすくなります
[Shift+Enter]で逆方向に移動するようにしたものです。
//StringGridのOnKeyDownイベント
procedure TForm1.StringGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key=VK_RETURN then begin
with TStringGrid(Sender) do begin
if SpBtnRight.Down then
//------------------------------------- {[→]横移動}
if Shift=[ssShift] then begin {Shift+Enter 左移動}
if Col > FixedCols then
Col:=Col-1
else
if Row > FixedRows then begin
Col:=ColCount-1;
Row:=Row-1;
end else begin
Col:=ColCount-1;
Row:=RowCount-1;
end
end
else begin {Enter 右移動}
if Col < ColCount-1 then
Col:=Col+1
else
if Row < RowCount-1 then begin
Col:=FixedCols;
Row:=Row+1;
end else begin
Col:=FixedCols;
Row:=FixedRows;
end;
end
else
//------------------------------------- [↓]縦移動
if Shift=[ssShift] then begin {Shift+Enter 上移動}
if Row > FixedRows then
Row:=Row-1
else
if Col > FixedCols then begin
Row:=RowCount-1;
Col:=Col-1;
end else begin
Col:=ColCount-1;
Row:=RowCount-1;
end
end
else
begin {Enter 下移動}
if Row < RowCount-1 then
Row:=Row+1
else
if Col < ColCount-1 then begin
Col:= Col +1;
Row:=FixedRows;
end else begin
Col:=FixedCols;
Row:=FixedRows;
end;
end;
end;{with}
end;
end;
StringGridで右寄せ表示・書式設定
//StringGridのOnDrawCellイベント
procedure TForm1.StringGrid1DrawCell(Sender: TObject;
ACol, ARow: Longint;
Rect: TRect; State: TGridDrawState);
begin
StringGrid1.Canvas.FillRect(Rect);
Rect.Top := Rect.Top + 2;
DrawText(StringGrid1.Canvas.Handle,
PChar(StringGrid1.Cells[ACol,ARow]),
Length(StringGrid1.Cells[ACol,ARow]),
Rect, DT_RIGHT); // DT_RIGHT=右寄せ
end;
// 応用編
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
var
SGrid :TStringGrid;
S :String;
DTdraw :Integer;
begin
SGrid:=TStringGrid(Sender);
if (ARow>0)and(ACol=6) then
SGrid.Canvas.Brush.Color:=$00DAFECF; {7列目の背景色を変更}
SGrid.Canvas.FillRect(Rect);
Rect.Left:= Rect.Left + 3;
S:=SGrid.Cells[Acol,Arow];
if (ARow=0) then DTdraw:=DT_CENTER else {1行目は、中央揃え}
case ACol of
0,4:DTdraw:=DT_CENTER; {1,5列目は、中央揃え}
1,3:DTdraw:=DT_RIGHT; {2,4列目は、右揃え}
5,6:begin {6,7列目は、右揃えで桁区切り}
DTdraw:=DT_RIGHT;
S:=FormatFloat('#,###',StrToFloatDef(S,0));{表示のみ変更}
end
else DTdraw:=DT_LEFT; {その他は、左揃え}
end;
DrawText(SGrid.Canvas.Handle,
PChar(S),
Length(S),
Rect, DTdraw or DT_VCENTER or DT_SINGLELINE);{縦は中央揃え}
end;StringGrid 行を削除する
procedure GridLineDel(var SGrid:TStringGrid; DeleteFix:Boolean=True);
var
ACol,ARow: Integer;
begin
with SGrid do begin
//1行全てを削除して行を繰上げる
if DeleteFix then begin
for ARow:= Row to RowCount -1 do
Rows[ARow].Assign(Rows[ARow+1]);
Rows[RowCount -1].Clear; //最終行
// if RowCount-1 > FixedRows then RowCount:=RowCount-1; //表の最終行を減らす場合
end else
//FixedCellを残して削除する
begin
for ARow:= Row to RowCount -1 do
for ACol:= FixedCols to ColCount -1 do
Cells[ACol,ARow]:=Cells[ACol,ARow +1];
for ACol:= FixedCols to ColCount -1 do //最終行
Cells[ACol,RowCount -1]:='';
end;
end;
end;
呼出しはPopUpMenuとかでするのがよいでしょう。 以下の例では、選択範囲の行を削除しています。
var ARow:Integer;
begin
with StringGrid1 do begin
for ARow:=1 to Selection.Bottom-Selection.Top+1 do
// GridLineDel(StringGrid1); //1行全てを削除して行を繰上げる場合
GridLineDel(StringGrid1,False);//FixedCellを残して現在行を削除する
Selection:= TGridRect(Rect( Col,Row,Col,Row)); //選択解除
end;
end;
StringGrid 行を挿入する
procedure GridLineIns(var SGrid:TStringGrid; InsertFix:Boolean=True);
var
ACol,ARow :Integer;
begin
with SGrid do begin
//1行挿入
if InsertFix then begin
// RowCount:=RowCount+1; //行を増やす場合
if Row < RowCount-1 then
for ARow:=RowCount-1 downto Row+1 do
Rows[ARow].Assign(Rows[ARow-1]);
Rows[Row].Clear;
end else
//FixedCellは残す
begin
if Row < RowCount-1 then
for ARow:=RowCount-1 downto Row+1 do
for ACol:=FixedCols to ColCount-1 do
Cells[ACol,ARow]:=(Cells[ACol,ARow-1]);
for ACol:=FixedCols to ColCount-1 do
Cells[ACol,Row]:='';
end;
end;
end;
以下の例では、選択範囲の行数分を挿入しています。
var ARow:Integer;
begin
with StringGrid1 do begin
for ARow:=1 to Selection.Bottom-Selection.Top+1 do
// GridLineIns(StringGrid1); //1行挿入
GridLineIns(StringGrid1,False); //FixedCellを残して行を挿入する
Selection:= TGridRect(Rect( Col,Row,Col,Row));
end;
end;
StringGridで特定のセルを編集可・不可にする
//StringGridのOnSelectCellイベント
procedure TForm1.StringGrid1SelectCell(Sender: TObject;
ACol, ARow: Integer; var CanSelect: Boolean);
begin
with TStringGrid(Sender) do begin
if ACol = 2 {1列目のAColは0}
then Options := Options - [goEditing] {3列目を編集不可}
else Options := Options + [goEditing]; {編集可}
end;
end;
（注）編集可にすると、複数セルの選択ができなくなります。
StringGridですべての列幅を自動調整する
procedure SGridAutoFit(SGrid: TStringGrid);
var
ARow, ACol, tmpColWidth, maxColWidth: Integer;
begin
for ACol := 0 to SGrid.ColCount-1 do begin
maxColWidth := SGrid.DefaultColWidth;
for ARow := 0 to SGrid.RowCount-1 do begin
tmpColWidth := SGrid.Canvas.TextWidth(SGrid.Cells[ACol,ARow]);
if tmpColWidth > maxColWidth then maxColWidth := tmpColWidth;
end;
SGrid.ColWidths[ACol] := maxColWidth + 10;
end;
end;
StringGridでソートする （複数キーに対応）
GridSort(対象StringGrid, キー列, [true=数値 False=文字列]);
複数キーで、ソートする場合は、下位キーから順番に実行して下さい。
例： GridSort(StringGrid1, 2); 3列目文字ｷｰ
GridSort(StringGrid1, 0, True); 1列目数値ｷｰ
数値を文字列キーにする場合は、桁あわせ（0で埋める)が必要ですが、
StringGrid1.Cells[1,1]:=IntToStr(数値) Ｘ
StringGrid1.Cells[1,1]:= FormatFloat('000',数値) Ｏ
第3引数をTrueにすれば実数でソートします
procedure GridSort(SGrid:TStringGrid; ACol:Integer; KeyIsNum:Boolean=False);
procedure MergeSort(Buffer: TStringList; ARow, Count: Integer);
var I, J, Center : Integer;
Temp: TStringList;
Hikaku: Boolean;
begin
if Count = 1 then Exit;
Center := Count div 2;
MergeSort(Buffer, ARow, Center);
MergeSort(Buffer, ARow + Center, Count - Center);
I:=0; J:=0;
Temp := TStringList.Create;
try
while (I < Center) and (J < Count - Center) do begin
if KeyIsNum then
Hikaku:=( StrToFloatDef(Buffer[ARow+I],0) > StrToFloatDef(Buffer[ARow+Center+J],0) )
else
Hikaku:=( CompareStr(Buffer[ARow+I],Buffer[ARow+Center+J]) >0 );
if Hikaku then begin
Temp.AddObject(Buffer[ARow + Center + J], Buffer.Objects[ARow + Center + J]);
Inc(J);
end else begin
Temp.AddObject(Buffer[ARow + I], Buffer.Objects[ARow + I]);
Inc(I);
end;
end;
if I = Center then
while J < Count - Center do begin
Temp.AddObject(Buffer[ARow + Center + J], Buffer.Objects[ARow + Center + J]);
Inc(J);
end
else
while I < Center do begin
Temp.AddObject(Buffer[ARow + I], Buffer.Objects[ARow + I]);
Inc(I);
end;
for I:=0 to Count-1 do begin
Buffer[ARow + I] := Temp[I];
Buffer.Objects[ARow + I] := Temp.Objects[I];
end;
finally
Temp.Free;
end;
end;
var
ARow: Integer;
Buffer: TStringList;
begin
with SGrid do begin
Buffer := TStringList.Create;
try //Buffer に key とそれに対応する Rows を格納する
for ARow:=FixedRows to RowCount-1 do begin
Buffer.AddObject(Cells[ACol, ARow], TStringList.Create);
TStringList(Buffer.Objects[ARow - FixedRows]).Assign(Rows[ARow]);
end;
//Buffer を実際にソートする
MergeSort(Buffer, 0, RowCount - FixedRows); //Buffer.Sort; と置き換え
//ソートしたデータを Grid に書き戻す
for ARow := FixedRows to RowCount - 1 do begin
Rows[ARow].Assign(TStringList(Buffer.Objects[ARow - FixedRows]));
TStringList(Buffer.Objects[ARow - FixedRows]).Free;
end;
finally
Buffer.Free;
end;
end;
end;
StringGridのデータをExcelに書き出す
usesに ComObj を追加して下さい。
procedure ExportToExcel(SGrid:TStringGrid);
var
MsExcel : Variant;
MsApplication: Variant;
WBook : Variant;
WSheet : Variant;
iCol,iRow : integer;
function columnToA1(clm:Integer) :string ;
begin // カラム数 ==> Ａ１参照形式へ変換
if (clm-1) div 26 > 0 then
Result:=Chr(64+ (clm-1) div 26)
else
Result:='';
Result:=Result+ chr(65 + (clm-1) mod 26);
end;
begin
//Excel起動
MsExcel := CreateOleObject('Excel.Application');
MsApplication := MsExcel.Application;
MsApplication.Visible := True;
WBook := MsApplication.WorkBooks.Add ;
WSheet :=WBook.ActiveSheet;
//Excelにデータ出力
WSheet.Rows[1].Font.Bold:= 'True'; //タイトル行を太字にする
for iRow:=0 to SGrid.RowCount-1 do begin
for iCol:=0 to SGrid.ColCount-1 do begin
WSheet.Cells[iRow+1,iCol+1].Value:=SGrid.Cells[iCol,iRow];
end;
end;
WSheet.Columns['A:'+columnToA1(SGrid.ColCount)].AutoFit; //列幅自動調整
end;
StringGridのデータをFILEに書き出す
テキストの区切りにTABを使用
procedure GridSave(SGrid:TStringGrid; fName: String);
var stList :TStringList;
ARow,ACol :Integer;
S :String;
begin
stList:=TStringList.Create;
try
for ARow:=0 to SGrid.RowCount-1 do begin
S:= '';
for ACol:=0 to SGrid.ColCount-1 do
S:= S + SGrid.Cells[ACol,ARow]+ Chr(VK_TAB);
stList.Add (S);
end;
stList.SaveToFile(fName);
// stList.SaveToFile(fName,TEncoding.Unicode); //Delphi2009
finally
stList.Free;
end;
end;
//SaveDialogでの使用例
procedure TForm1.Button1Click(Sender: TObject);
begin
SaveDialog1.DefaultExt:='TXT';
SaveDialog1.Filter:= 'Text files (*.txt)|*.TXT';
if SaveDialog1.Execute then
GridSave(StringGrid1,SaveDialog1.FileName);
end;
テキストの区切りに','を使用(CSV)
procedure GridSaveCSV(SGrid:TStringGrid; fName: String);
var stList :TStringList;
ARow :Integer;
begin
stList:=TStringList.Create;
try
for ARow:=0 to SGrid.RowCount-1 do
stList.Add(SGrid.Rows[ARow].CommaText);
stList.SaveToFile(fName);
// stList.SaveToFile(fName,TEncoding.Unicode); //Delphi2009
finally
stList.Free;
end;
end;
//SaveDialogでの使用例
procedure TForm1.Button1Click(Sender: TObject);
begin
SaveDialog1.DefaultExt:='CSV';
SaveDialog1.Filter:= 'CSV files (*.csv)|*.CSV';
if SaveDialog1.Execute then
GridSaveCSV(StringGrid1,SaveDialog1.FileName);
end;
StringGridのデータをFILEから読込む
TABで区切ったtextFileの読込み
procedure GridLoad(SGrid:TStringGrid; fName:string);
var stList: TStringList;
ARow,ACol: Integer;
tmpS: string;
FldSeparator: Char;
begin
stList:=TStringList.Create;
try
FldSeparator:= Char(VK_TAB);
stList.LoadFromFile(fName);
SGrid.RowCount:= stList.Count;
SGrid.ColCount:= SGrid.FixedCols;
for ARow:=0 to stList.Count-1 do begin
ACol:= 0;
tmpS:= stList[ARow];
while Pos(FldSeparator,tmpS) > 0 do begin
if ACol > SGrid.ColCount-1 then SGrid.ColCount:= ACol+1;
SGrid.Cells[ACol,ARow]:= Copy(tmpS,1,Pos(FldSeparator,tmpS)-1);
Delete(tmpS,1,Pos(FldSeparator,tmpS));
Inc(ACol);
end;
end;
finally
stList.Free;
end;
end;
CSVFileからStringGridへ読込み
procedure GridLoadCSV(SGrid:TStringGrid; fName:string);
var stList: TStringList;
ARow: Integer;
begin
stList:=TStringList.Create;
try
stList.LoadFromFile(fName);
SGrid.RowCount:= stList.Count;
for ARow:=0 to stList.Count-1 do
SGrid.Rows[ARow].CommaText:= stList[ARow];
finally
stList.Free;
end;
end;
選択範囲をクリップボードにコピー
usesに ClipBrd を追加して下さい。
//第2パラメータ、[Select=True]で選択範囲、Falseで全範囲
procedure CopyFromStringGrid(SGrid:TStringGrid;Select:Boolean=True);
var
S :String;
GRect :TGridRect;
ACol,ARow :Integer;
begin
if Select
then GRect:=SGrid.Selection
else GRect:=TGridRect(Rect(0,0,SGrid.ColCount-1,SGrid.RowCount-1));
S:='';
for ARow:=GRect.Top to GRect.Bottom do begin
for ACol:=GRect.Left to GRect.Right do begin
if ACol= GRect.Right
then S:=S+SGrid.Cells[ACol,ARow]
else S:=S+SGrid.Cells[ACol,ARow]+#9;
end;
S:=S+#13#10;
end;
ClipBoard.AsText:= S;
end;
セル位置にクリップボードから貼付け（範囲指定は考慮していません）
usesに ClipBrd を追加して下さい。
//第2パラメータ、[Select=True]で選択位置、Falseで左上(0,0)に貼付けます
procedure PasteToStringGrid(SGrid:TStringGrid; Select:Boolean=True);
var
S,tmpS :String;
ARow,ACol :Integer;
begin
if Select then ARow:= SGrid.Row-1
else ARow:= -1;
S:=ClipBoard.AsText;
while Pos(#13,S) > 0 do begin
Inc(ARow);
if Select then ACol:= SGrid.Col-1
else ACol:= -1;
tmpS:= Copy(S,1,Pos(#13,S));
while Pos(#9,tmpS) > 0 do begin
Inc(ACol);
if (ACol <= SGrid.ColCount-1) and (ARow <= SGrid.RowCount-1) then
SGrid.Cells[ACol,ARow]:= Copy(tmpS,1,Pos(#9,tmpS)-1);
Delete(tmpS,1,Pos(#9,tmpS));
end;
if (ACol <= SGrid.ColCount-1) and (ARow <= SGrid.RowCount-1) then
SGrid.Cells[ACol+1,ARow]:= Copy(tmpS,1,Pos(#13,tmpS)-1);
Delete(S,1,Pos(#13,S));
if Copy(S,1,1)=#10 then Delete(S,1,1);
end;
end;
ページトップ
