procedure TForm1.ToolBar1StartDock(Sender: TObject;
var DragObject: TDragDockObject);
begin
DragObject := TToolDockObject.Create(Sender as TToolBar);
end;
procedure TForm1.ControlBar1GetSiteInfo(Sender: TObject; DockClient: TControl;
var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
begin
if Not (DockClient is TToolBar) then
Candock := False;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
r:TRect;
begin
r.Left:=ScrollBox1.Width div 2;
r.Top:=ScrollBox1.Height div 2;
r.Right:=r.Left+ToolBar1.Width;
r.Bottom:=r.Top+ToolBar1.Height;
ToolBar1.ManualFloat(r);
end;
//手続きを記述
procedure TToolDockSite.WMSysCommand(var Msg: TWMSysCommand);
var
hBarHandle : HMENU;
begin
case Msg.CmdType of
SC_CLOSE: begin
//処理
MessageDlg('閉じるボタンを無効化しました！', mtInformation, [mbOk] , 0);
//閉じたい場合
//inherited;
//閉じたくない場合
//ハンドルを取得
hBarHandle := GetSystemMenu(Self.Handle,False);
if hBarHandle <> 0 then
begin
//閉じるボタンを無効化する
EnableMenuItem(hBarHandle, SC_CLOSE,
(MF_BYCOMMAND or MF_DISABLED or MF_GRAYED));
//グレイアウトして無効化されるが、削除はできない
//DeleteMenu(hBarHandle, SC_CLOSE,
// (MF_BYCOMMAND or MF_DISABLED or MF_GRAYED));
end;
DrawMenuBar(Self.Handle);
//メッセージは「なかった」ことにする
Msg.Result:=0;
end;
else
inherited;
end;
end;
で、FormCreate時に、ドッキングを制御するクラスを指定。
procedure TForm1.FormCreate(Sender: TObject);
begin
//ToolBarの閉じるボタンを無効化
ToolBar1.FloatingDockSiteClass:=TToolDockSite;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked then
begin
Image2.Visible := True;
end else begin
Image2.Visible := False;
end;
end;
procedure TForm1.CheckBox2Click(Sender: TObject);
begin
if CheckBox2.Checked then
begin
Image1.BringToFront;
end else begin
Image1.SendToBack;
end;
end;
procedure TForm1.CheckBox2Click(Sender: TObject);
begin
if CheckBox2.Checked then
begin
Image1.BringToFront;
end else begin
Image1.SendToBack;
end;
end;
implementation
uses
Vcl.GraphUtil;
//GraphUtilはFixedセルのセンタリング用に追加
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
i : integer;
begin
//Fixedセルをセンタリング
with StringGrid1 do
begin
if (gdFixed in State) then
begin
//usesにGraphUtilを追加（Vcl.GraphUtilではないことに注意！）
//->Vcl.GraphUtilとすると「未定義の識別子エラー」になる！
//GraphUtil.GradientFillCanvas(Canvas, GradientStartColor,
// GradientEndColor, Rect,gdVertical);
//Vcl.GraphUtilとusesした場合
//これは未定義の識別子エラーにならない
Vcl.GraphUtil.GradientFillCanvas(Canvas, GradientStartColor,
GradientEndColor, Rect,gdVertical);
//センタリング
DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]),
-1, Rect, DT_CENTER OR DT_VCENTER OR DT_SINGLELINE);
end;
end;
//セルの表示を制御
if not (gdFixed in state) then
begin
if StringGrid1.Cells[ACol,ARow] <> '' then
begin
//数値であるかどうかをCheck
if not TryStrToInt(StringGrid1.Cells[ACol,ARow],i) then Exit;
{数値である場合}
//背景色を白に設定
StringGrid1.Canvas.Brush.Color := clWhite;
//正負をチェック
if StrToInt(StringGrid1.Cells[ACol,ARow]) < 0 then
begin
StringGrid1.Canvas.Font.Color := clRed;
end else begin
StringGrid1.Canvas.Font.Color := clBlack;
end;
//セルを塗りつぶす
StringGrid1.Canvas.FillRect(Rect);
//数値は中央寄せで表示
{DrawText(StringGrid1.Canvas.Handle,
PChar(StringGrid1.Cells[ACol,ARow]),
//[+1]は数値描画位置の調整のため
Length(StringGrid1.Cells[ACol,ARow])+1,Rect,
DT_CENTER or DT_VCENTER or DT_SINGLELINE);}
//数値は右寄せで表示
DrawText(StringGrid1.Canvas.Handle,
PChar(StringGrid1.Cells[ACol,ARow]),
//[+1]は数値描画位置の調整のため
Length(StringGrid1.Cells[ACol,ARow])+1,Rect,
DT_RIGHT or DT_VCENTER or DT_SINGLELINE);
end;
end;
end;
ついでにIMEも設定（IME ONの列は任意指定）。まず、次のように宣言しておいて･･･
//Col毎のIMEの制御(制御内容はStringGrid1GetEditTextを参照)
type
_TGrid = class(TCustomGrid);
var
Form1: TForm1;
implementation
StringGrid1GetEditText手続きで、次のように設定。
procedure TForm1.StringGrid1GetEditText(Sender: TObject; ACol, ARow: Integer;
var Value: string);
begin
//IMEの制御
with TEdit(_TGrid(Sender).InplaceEditor) do
begin
case ACol of //最初のAColは「 0 」
2: ImeMode := imHira; //日本語入力ON
else
//ImeMode := imClose; //日本語入力OFF-> ×
ImeMode := imDisable; //日本語入力OFFは imDisable
end;
end;
end;
ここまでの設定で、実行時の画面は、こんな感じ。
某有名表計算ソフト風の画面が出現
Enterキーでフォーカスを移動するために、FormKeyPress手続きで、次のように設定。
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
//[Enter]キーでコントロールを移動
//StringGridは編集可能にFormCreateで設定しておく
//->忘れるとセルの移動にEnter×２回必要！
//この方法を使う時はKeyPreview:=True;をFormCreateで指定。
if Ord(Key) = VK_RETURN then
begin
if ActiveControl is TStringGrid then
begin
if TStringGrid(ActiveControl).EditorMode then
begin
//VK_TABではカーソルがレコードの項目を右へ移動。
//ActiveControl.Perform(WM_KEYDOWN,VK_TAB,0);
//VK_DOWNにすると同じ項目の次のレコードへ移動。
//if intStringGrid1ActiveRow < StringGrid1.RowCount-1 then
if TargetRow < StringGrid1.RowCount-1 then
begin
ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
end else begin
ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
end;
Key := #0;
end;
end else begin
SelectNext(ActiveControl,True,True);
Key := #0;
end;
end;
end;
さらに、列幅を自動調整したい場合は･･･
procedure TForm1.CheckBox1Click(Sender: TObject);
var
iCOL: Integer;
iROW: Integer;
MaxColWidth: Integer;
TmpColWidth: Integer;
begin
//DefaultColWidthを設定（これでCheck OFF時に元に戻る！）
StringGrid1.DefaultColWidth:=64;
//AutoAllColFit（全列幅の自動調整）
if CheckBox1.Checked then
begin
for iCOL := 0 to StringGrid1.ColCount-1 do begin
MaxColWidth := 0;
for iROW := 0 to StringGrid1.RowCount-1 do
begin
//数字は列幅の調整用
TmpColWidth := Canvas.TextWidth(StringGrid1.Cells[iCOL,iROW]) + 40;
if MaxColWidth < TmpColWidth then
MaxColWidth := TmpColWidth;
end;
StringGrid1.ColWidths[iCOL] := MaxColWidth;
end;
end;
end;
implementation
uses
Vcl.GraphUtil,
System.UITypes;
//GraphUtilはFixedセルのセンタリング用に追加
//System.UITypesはキーコードでBキー（=VKB）を指定するために追加
{$R *.dfm}
procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
//任意のキーの押し下げをキャッチ
if Msg.message = WM_KEYDOWN then
begin
//StringGridがアクティブだったら
if ActiveControl is TStringGrid then
begin
//StringGridが編集可能だったら
if TStringGrid(ActiveControl).EditorMode then
begin
//Bキー or ０キー押し下げでゼロを入力（入力値は10未満であることが前提）
if (Msg.wParam=VKB) or (Msg.wParam=VK0) then
begin
//keybd_event(VK_TAB,0,0,0);
//VK_TABではカーソルがレコードの項目を右へ移動。
//ActiveControl.Perform(WM_KEYDOWN,VK_TAB,0);
//VK_DOWNにすると同じ項目の次のレコードへ移動。
if TargetRow < StringGrid1.RowCount-1 then
begin
//アクティブなセルが最終行でない場合はフォーカスは下へ移動
StringGrid1.Cells[TargetCol, TargetRow]:='0';
ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
end else begin
//最終行ならフォーカスは上へ移動
StringGrid1.Cells[TargetCol, TargetRow]:='0';
ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
end;
//Msg.wParam:=#0; //エラーになる
Msg.wParam:=0;
end;
end;
end;
end;
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
i: integer;
str1, str2: string;
begin
･･･ 省略 ･･･
//セルの表示を制御（中央寄せ・負の数は赤で表示）
if not (gdFixed in state) then
begin
if StringGrid1.Cells[ACol,ARow] <> '' then
begin
//文字数が２文字なら実行
if Length(WideString(StringGrid1.Cells[ACol,ARow])) = 2 then
begin
//指定文字が入力されたら'-'に変換
str1 := LowerCase(Copy(StringGrid1.Cells[ACol,ARow],1,1));
str2 := Copy(StringGrid1.Cells[ACol,ARow],2,1);
if str1 = LowerCase(ComboBox1.Text) then
begin
StringGrid1.Cells[ACol,ARow] := '-'+str2;
end;
end;
if ACol = 1 then
begin
//「文字」はすべて'0'に変換
if not TryStrToInt(StringGrid1.Cells[ACol,ARow], i) then
begin
StringGrid1.Cells[ACol,ARow] := '0';
end;
end;
･･･ 省略 ･･･
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
i: integer;
str1, str2: string;
begin
･･･ 省略 ･･･
//セルの表示を制御（中央寄せ・負の数は赤で表示）
if not (gdFixed in state) then
begin
if StringGrid1.Cells[ACol,ARow] <> '' then
begin
//文字数が２文字なら実行 -> コメント化
{if Length(WideString(StringGrid1.Cells[ACol,ARow])) = 2 then
begin
//指定文字が入力されたら'-'に変換
str1 := LowerCase(Copy(StringGrid1.Cells[ACol,ARow],1,1));
str2 := Copy(StringGrid1.Cells[ACol,ARow],2,1);
if str1 = LowerCase(ComboBox1.Text) then
begin
StringGrid1.Cells[ACol,ARow] := '-' + str2;
end;
end;}
//文字数が２文字以上なら実行
if Length(WideString(StringGrid1.Cells[ACol,ARow])) >= 2 then
begin
//指定文字が入力されたら'-'に変換
str1 := LowerCase(Copy(StringGrid1.Cells[ACol,ARow],1,1));
//２桁以上の入力値に対応
str2 := StringReplace(
LowerCase(StringGrid1.Cells[ACol,ARow]),
str1, '', [rfReplaceAll, rfIgnoreCase]);
if str1=LowerCase(ComboBox1.Text) then
begin
StringGrid1.Cells[ACol,ARow] := '-'+str2;
end;
end;
if ACol = 1 then
begin
//「文字」はすべて'0'に変換
if not TryStrToInt(StringGrid1.Cells[ACol,ARow], i) then
begin
StringGrid1.Cells[ACol,ARow] := '0';
end;
end;
･･･ 省略 ･･･
そこで思い切って問題を単純化し、「高速入力モード」を作成して、それが ON の場合は入力値を０－９に限定し、ユーザーがそのことを理解した上で操作できるように工夫してみた。もし、各セルに対して10以上の値の入力がある場合は、「高速入力モード」は OFF で使用して貰い、Ｂキーが押された場合のみ、０（ゼロ）に変換して入力確定 ⇨ フォーカスを移動することにして、数字キーの０（ゼロ）の入力に対しては、直ちに入力の確定としないことにした。
あと、ついでだから、「高速入力モード」の名に恥じないよう、それが ON の場合は、０－９の数字キー押し下げで、直ちに入力確定、次のセルへフォーカスが移動する処理も追加してみた。以下、その実装。
CheckBox2を追加し、Captionを設定
procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
var
str1:string;
begin
//任意のキーの押し下げをキャッチ
if Msg.message = WM_KEYDOWN then
begin
//StringGridがアクティブだったら
if ActiveControl is TStringGrid then
begin
//StringGridが編集可能だったら
if TStringGrid(ActiveControl).EditorMode then
begin
//高速入力使用の有無で処理を切り替え
if not CheckBox2.Checked then
begin
//高速入力を使用しない場合の処理
//Bキー押し下げでゼロを入力
//0キー押し下げは無視
if (Msg.wParam=VKB) then
begin
//keybd_event(VK_TAB,0,0,0);
//VK_TABではカーソルがレコードの項目を右へ移動。
//ActiveControl.Perform(WM_KEYDOWN,VK_TAB,0);
//VK_DOWNにすると同じ項目の次のレコードへ移動。
if TargetRow < StringGrid1.RowCount-1 then
begin
//下のセルへ移動
StringGrid1.Cells[TargetCol, TargetRow]:='0';
ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
end else begin
//上のセルへ移動
StringGrid1.Cells[TargetCol, TargetRow]:='0';
ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
end;
//Msg.wParam:=#0; //エラーになる
Msg.wParam:=0;
end;
end else begin
//高速入力を使用する場合の処理
//Bキー押し下げでゼロを入力
//0キー押し下げにも対応
if (Msg.wParam=VKB) or (Msg.wParam=VK0) then
begin
//keybd_event(VK_TAB,0,0,0);
//VK_TABではカーソルがレコードの項目を右へ移動。
//ActiveControl.Perform(WM_KEYDOWN,VK_TAB,0);
//VK_DOWNにすると同じ項目の次のレコードへ移動。
if TargetRow < StringGrid1.RowCount-1 then
begin
//下のセルへ移動
StringGrid1.Cells[TargetCol, TargetRow]:='0';
ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
end else begin
//上のセルへ移動
StringGrid1.Cells[TargetCol, TargetRow]:='0';
ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
end;
//Msg.wParam := #0; //エラーになる
Msg.wParam := 0;
end;
//1-9の入力があった場合
if StringGrid1.Cells[TargetCol, TargetRow] <> '' then
begin
str1:=Copy(StringGrid1.Cells[TargetCol, TargetRow],1,1);
end else begin
str1 := '';
end;
//任意の１文字＋数字の入力を負の数に変換する処理用に追加
if (str1 <> '-') and (str1 <> ComboBox1.Text) then
begin
if (Msg.wParam = VK1) then
begin
//keybd_event(VK_TAB,0,0,0);
//VK_TABではカーソルがレコードの項目を右へ移動。
//ActiveControl.Perform(WM_KEYDOWN,VK_TAB,0);
//VK_DOWNにすると同じ項目の次のレコードへ移動。
//if intStringGrid1ActiveRow < StringGrid1.RowCount-1 then
if TargetRow < StringGrid1.RowCount-1 then
begin
//下のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '1';
ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
end else begin
//上のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '1';
ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
end;
//Msg.wParam := #0; //エラーになる
Msg.wParam := 0;
end;
if (Msg.wParam = VK2) then
begin
if TargetRow < StringGrid1.RowCount-1 then
begin
//下のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '2';
ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
end else begin
//上のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '2';
ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
end;
Msg.wParam := 0;
end;
if (Msg.wParam = VK3) then
begin
if TargetRow < StringGrid1.RowCount-1 then
begin
//下のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '3';
ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
end else begin
//上のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '3';
ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
end;
Msg.wParam := 0;
end;
if (Msg.wParam = VK4) then
begin
if TargetRow < StringGrid1.RowCount-1 then
begin
//下のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '4';
ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
end else begin
//上のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '4';
ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
end;
Msg.wParam := 0;
end;
if (Msg.wParam = VK5) then
begin
if TargetRow < StringGrid1.RowCount-1 then
begin
//下のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '5';
ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
end else begin
//上のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '5';
ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
end;
Msg.wParam := 0;
end;
if (Msg.wParam = VK6) then
begin
if TargetRow < StringGrid1.RowCount-1 then
begin
//下のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '6';
ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
end else begin
//上のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '6';
ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
end;
Msg.wParam := 0;
end;
if (Msg.wParam = VK7) then
begin
if TargetRow < StringGrid1.RowCount-1 then
begin
//下のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '7';
ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
end else begin
//上のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '7';
ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
end;
Msg.wParam := 0;
end;
if (Msg.wParam = VK8) then
begin
if TargetRow < StringGrid1.RowCount-1 then
begin
//下のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '8';
ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
end else begin
//上のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '8';
ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
end;
Msg.wParam := 0;
end;
if (Msg.wParam = VK9) then
begin
if TargetRow < StringGrid1.RowCount-1 then
begin
//下のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '9';
ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
end else begin
//上のセルに移動
StringGrid1.Cells[TargetCol, TargetRow] := '9';
ActiveControl.Perform(WM_KEYDOWN,VK_UP,0);
end;
Msg.wParam := 0;
end;
end;
end;
end;
end;
end;
end;
こんなことにならないよう、画像処理（その２）の手続きの最初に、先に述べたように、Image1.Enabled := True; と記述して強制的にエラー防止策をとるか、「TImageのEnabledプロパティがFalseで変更できません！」みたいなエラーメッセージが表示されるよう、if not Image1.Enabled then のようなエラー回避の処理を入れておくべきだったのだ。そうすれば、もっと早く間違いを発見できたと思うのだが、実際には、EnabledプロパティがFalse状態のTImageをクリックしても「何も起こらない」（もちろんエラーも起きない）ので、Enabledプロパティの設定が原因だと気づくまでに（なんでかなー？）っと、考えに考え、それなりに時間がかかってしまったのだ。
GDI+で書いた元々のプログラムは、ファイルとして存在する画像データをOpenDialogを使ってGDI+ビットマップに読み込み、SaveDialogでファイル名を含めて保存パスを指定して処理するものだった。だから、ビットマップ変換用の変数は必要なく、bmp:TGPBitmap; として、ビットマップデータを入れる変数を１つだけ var 宣言して、もちろん、読み込み時にも、書き込み時にも、それぞれの手続きで同じように、これをローカル変数として使用した。
【誤りのあるコード】
//指定された拡張子を付けて保存
if GetEncoderClsid('image/'+strExt, ImgGUID) >= 0 then
begin
bmp.Save(ChangeFileExt(SaveDialog1.FileName, dotExt), ImgGUID);
end;
【正しいコード】
//指定された拡張子を付けて保存
if GetEncoderClsid('image/'+strExt, ImgGUID) >= 0 then
begin
//bmp.Save(ChangeFileExt(SaveDialog1.FileName, dotExt), ImgGUID);
dstbmp.Save(ChangeFileExt(SaveDialog1.FileName, dotExt), ImgGUID);
end;
//コンポーネントを交換する関数
//usesにTypInfoの追加が必要
function ChangeComponent(Original: TComponent; NewClass: TComponentClass): TComponent;
var
New: TComponent;
Stream: TStream;
Methods: array of TMethod;
aPPropInfo: array of PPropInfo;
MethodCount, i: Integer;
begin
SetLength(aPPropInfo, 16379);
MethodCount := GetPropList(Original.ClassInfo, [tkMethod], @aPPropInfo[0]);
SetLength(Methods, MethodCount);
for i := 0 to MethodCount - 1 do
Methods[i] := GetMethodProp(Original, aPPropInfo[i]);
Stream := TMemoryStream.Create;
try
Stream.WriteComponent(Original);
New := NewClass.Create(Original.Owner);
if New is TControl then
TControl(New).Parent := TControl(Original).Parent;
Original.Free;
Stream.Position := 0;
Stream.ReadComponent(New);
finally
Stream.free
end;
for i := 0 to MethodCount - 1 do
SetMethodProp(New, aPPropInfo[i], Methods[i]);
Result := New;
end;
この関数を、FormCreate時に呼び出して、実行。
procedure TFormCollaboration.FormCreate(Sender: TObject);
begin
//コンポーネントを交換する関数を実行
StringGrid1:= TStringGrid(ChangeComponent(StringGrid1, TplDropStringGrid));
end;
ここまでが準備で、縦のアライメントの設定は、次のたった１行（赤字）を追加するのみ！
procedure TFormCollaboration.StringGrid1GetEditText(Sender: TObject; ACol,
ARow: Integer; var Value: string);
begin
//縦のアライメントを設定
TplDropStringGrid(StringGrid1).EditVertAlignment := vaCenter;
//IMEの制御
with TEdit(_TGrid(Sender).InplaceEditor) do
begin
//ImeMode := imClose; //日本語入力OFF-> ×
ImeMode := imDisable; //日本語入力OFFは imDisable
end;
//現在Activeな行番号を取得
intStringGrid1ActiveRow:=ARow;
end;
procedure TFormCollaboration.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
LDelta:Integer;
LWinCtrl:TWinControl;
LCurPos:TPoint;
//スクロール量の調整（SA:Scroll Amount）
intSA:integer;
begin
//マウスカーソルが TScrollBox の領域内にある時だけスクロールを可能にする
//（解答欄画像を表示しているTImageはTScrollBoxの上に配置）
LCurPos := ScrollBox1.Parent.ScreenToClient(MousePos);
if PtInRect(ScrollBox1.BoundsRect, LCurPos) then
begin
//スクロール量の調整
if not TryStrToInt(調整値1-10を設定するComboBoxの値, intSA) then
begin
intSA:=1;
end;
//心配なので、念のために設定その１
if 調整値1-10を設定するComboBoxの値 ='0' then
begin
intSA:=1;
end;
//心配なので、念のために設定その２
if StrToInt(調整値1-10を設定するComboBoxの値) < 0 then
begin
intSA:=1;
end;
//大きい数値を選ぶとスクロール量も大きくなるように設定
intSA:=11-intSA;
LDelta := WheelDelta div intSA;
if ssCtrl in Shift then
begin
ScrollBox1.HorzScrollBar.Position :=
ScrollBox1.HorzScrollBar.Position - LDelta;
end else begin
ScrollBox1.VertScrollBar.Position :=
ScrollBox1.VertScrollBar.Position - LDelta;
//StringGridも連動してスクロールさせる
if LDelta > 0 then
begin
StringGrid1.Perform(WM_VSCROLL, SB_LINEUP, 0);
end else begin
StringGrid1.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
end;
end;
end else begin
//マウス直下のコントロールを取得
LWinCtrl:=FindVCLWindow(MousePos);
//TStringGridの場合
if LWinCtrl is TStringGrid then
begin
if WheelDelta > 0 then
begin
LWinCtrl.Perform(WM_VSCROLL, SB_LINEUP, 0);
end else begin
LWinCtrl.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
end;
end;
end;
//この１行を忘れないこと！
Handled:=True;
end;
//正負をチェック
if StrToInt(StringGrid1.Cells[ACol,ARow])< 0 then
begin
StringGrid1.Canvas.Font.Color := clRed;
end else begin
StringGrid1.Canvas.Font.Color := clBlack;
end;
//Gridコントロールへの入力値がない場合は「何もしない」
procedure TFormCollaboration.StringGrid1DrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
var
･･･ 必要な変数を宣言 ･･･
//例
intValue : integer;
begin
// 以下、実際のプログラムコードから必要な部分のみ抜粋
if StringGrid1.Cells[ACol,ARow]<>'' then
begin
// 誤入力'00'があれば'0'に変換
if StringGrid1.Cells[ACol,ARow]='00' then
begin
StringGrid1.Cells[ACol,ARow]:='0';
end;
// 入力文字数が３文字以上なら'0'に変換
if Length(WideString(StringGrid1.Cells[ACol,ARow])) > 2 then
begin
StringGrid1.Cells[ACol,ARow]:='0';
end;
// 入力値が「数値」に変換できなかった場合はすべて'0'に変換
if not TryStrToInt(StringGrid1.Cells[ACol,ARow], intValue) then
begin
StringGrid1.Cells[ACol,ARow]:='0';
end;
//背景色を白に設定
StringGrid1.Canvas.Brush.Color:=clWhite;
//正負をチェック
if StrToInt(StringGrid1.Cells[ACol,ARow])< 0 then
begin
StringGrid1.Canvas.Font.Color:=clRed;
end else begin
StringGrid1.Canvas.Font.Color:=clBlack;
end;
//セルを塗りつぶす
StringGrid1.Canvas.FillRect(Rect);
//テキストを表示（中央寄せ）
DrawText(StringGrid1.Canvas.Handle,
PChar(StringGrid1.Cells[ACol,ARow]),
//[+1]は数値描画位置の調整のため
Length(StringGrid1.Cells[ACol,ARow])+1,Rect,
DT_CENTER or DT_VCENTER or DT_SINGLELINE);
end;
//Cellの値が0ではなかった場合の処理
if not (StringGrid1.Cells[ACol,ARow]='0') then
begin
//Cellの値が正だった場合（完全正答〇の処理）
if StrToInt(StringGrid1.Cells[ACol,ARow]) > 0 then
begin
//imgAnswerは答案画像を表示するTImage
//Windows APIのSetBkMode関数でTRANSPARENTを指定
SetBkMode(imgAnswer.Canvas.Handle, TRANSPARENT);
imgAnswer.Canvas.Font.Color := clRed;
imgAnswer.Canvas.Font.Size := StrToInt(FontSize指定用ComboBox.Text);
case RadioGroup4.ItemIndex of
0:begin
//cmbX, cmbYは表示位置調節用の値を入力するComboBox
imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
DestRect.Top+StrToInt(cmbY.Text), '○');
end;
1:begin
imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
DestRect.Top+StrToInt(cmbY.Text), StringGrid1.Cells[ACol,ARow]);
end;
2:begin
imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
DestRect.Top+StrToInt(cmbY.Text), '○'+StringGrid1.Cells[ACol,ARow]);
end;
end;
end else begin
//Cellの値が負だった場合（△）-> この部分を新規に追加
if StrToInt(StringGrid1.Cells[ACol,ARow]) < 0 then
begin
//Windows APIのSetBkMode関数でTRANSPARENTを指定
SetBkMode(imgAnswer.Canvas.Handle, TRANSPARENT);
imgAnswer.Canvas.Font.Color := clRed;
imgAnswer.Canvas.Font.Size := StrToInt(FontSize指定用ComboBox.Text);
case RadioGroup4.ItemIndex of
0:begin
imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
DestRect.Top+StrToInt(cmbY.Text), '△');
end;
1:begin
imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
DestRect.Top+StrToInt(cmbY.Text),
IntToStr(Abs(StrToInt(StringGrid1.Cells[ACol,ARow]))));
end;
2:begin
imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
DestRect.Top+StrToInt(cmbY.Text), '△'+
IntToStr(Abs(StrToInt(StringGrid1.Cells[ACol,ARow]))));
end;
end;
end;
end;
end else begin
//不正解の場合の処理（×）
//Windows APIのSetBkMode関数でTRANSPARENTを指定
SetBkMode(imgAnswer.Canvas.Handle, TRANSPARENT);
imgAnswer.Canvas.Font.Color := clRed;
imgAnswer.Canvas.Font.Size := StrToInt(FontSize指定用ComboBox.Text);
case RadioGroup4.ItemIndex of
0:begin
imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
DestRect.Top+StrToInt(cmbY.Text), '×');
end;
1:begin
imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
DestRect.Top+StrToInt(cmbY.Text), StringGrid1.Cells[ACol,ARow]);
end;
2:begin
//chkZeroはCaption「得点０は表示しない」のCheckBox
if not chkZero.Checked then
begin
imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
DestRect.Top+StrToInt(cmbY.Text), '×'+StringGrid1.Cells[ACol,ARow]);
end else begin
imgAnswer.Canvas.TextOut(DestRect.Left+StrToInt(cmbX.Text),
DestRect.Top+StrToInt(cmbY.Text), '×');
end;
end;
end;
end;
end;
var
i,j,k : integer;
begin
//合計点を入れる変数kを初期化
k := 0;
//合計点を計算
for i := 1 to StringGrid1.RowCount-1 do
begin
for j := 1 to StrToInt(解答欄数.Text) do
begin
if StringGrid1.Cells[j,i] <> '' then
begin
//△に非対応
//k := K + StrToInt(StringGrid1.Cells[j,i]);
//△は負の数で入力しているから絶対値で計算
k := K + Abs(StrToInt(StringGrid1.Cells[j,i]));
end;
end;
//合計点を保存（StringGrid.Cells[列, 行]）
StringGrid1.Cells[StrToInt(解答欄数.Text)+1, i] := IntToStr(k);
//合計点を初期化
k := 0;
end;
end;
Windows10になって、いちばん困ったのはプリンタの管理方法の変化だった。デフォルト設定で、最後に使ったプリンタが通常使うプリンタと見なされるようになってから、職場のあちこちで「印刷ができない！」という声が上がることが多くなった。駆け付けてみると、出力先プリンタはいつも「Microsoft Print to PDF」みたいな･･･。
procedure TForm1.Button1Click(Sender: TObject);
var
Ret:string;
begin
if InputQuery('InputQuery', '値を入力：', Ret) then
begin
//ＯＫボタンがクリックされた時
end else begin
//キャンセルボタンがクリックされた時（ESCキーで閉じた場合もFalseになる）
end;
end;
Private Sub CommandButton1_Click()
Dim PrintNo1 As Integer
Dim PrintNo2 As Integer
Dim i As Integer
If UserForm1.TextBox1.Text = "" Then
MsgBox ("開始番号を半角数字で入力してください。")
TextBox1.SetFocus
Exit Sub
End If
If UserForm1.TextBox2.Text = "" Then
MsgBox ("終了番号を半角数字で入力してください。")
TextBox2.SetFocus
Exit Sub
End If
PrintNo1 = UserForm1.TextBox1.Text
PrintNo2 = UserForm1.TextBox2.Text
i = PrintNo1
For i = PrintNo1 To PrintNo2
Range("A2").Select
ActiveCell.FormulaR1C1 = i
Range("B6:AB38").Select
ActiveSheet.PageSetup.PrintArea = "$B$6:$AB$38"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next i
Range("A2").Select
End Sub
Private Sub CommandButton2_Click()
'キャンセルボタンがクリックされた場合
Unload UserForm1
Exit Sub
End Sub
//Formのメンバーにはしていません。
//名前は MyInputQuery に変更
function MyInputQuery(const ACaption, APrompt: string;
var Value: string): Boolean;
var
Form: TForm;
Prompt: TLabel;
Edit: TEdit;
DialogUnits: TPoint;
ButtonTop, ButtonWidth, ButtonHeight: Integer;
function GetAveCharSize(Canvas: TCanvas): TPoint;
var
I: Integer;
Buffer: array[0..51] of Char;
begin
for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
Result.X := Result.X div 52;
end;
begin
Result := False;
Form := TForm.Create(Application);
with Form do begin
try
Canvas.Font := Font;
DialogUnits := GetAveCharSize(Canvas);
BorderStyle := bsDialog;
Caption := ACaption;
ClientWidth := MulDiv(180, DialogUnits.X, 4);
Position := poScreenCenter;
Prompt := TLabel.Create(Form);
with Prompt do
begin
Parent := Form;
Caption := APrompt;
Left := MulDiv(8, DialogUnits.X, 4);
Top := MulDiv(8, DialogUnits.Y, 8);
Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
WordWrap := True;
end;
Edit := TEdit.Create(Form);
with Edit do
begin
Parent := Form;
Left := Prompt.Left;
Top := Prompt.Top + Prompt.Height + 5;
Width := MulDiv(164, DialogUnits.X, 4);
MaxLength := 255;
Text := Value;
SelectAll;
//Password入力用にInputQueryを使用するための設定（Password Mask）
//EditコントロールではPasswordCharに設定した文字が
//入力した文字の代わりに表示される（デフォルトは'#0'）
//パスワードマスクするなら
//PasswordChar:= '*';
//これでマスクしなくなる（'#0'として文字列化しないこと）
PasswordChar := #0;
//Delphi2009からTEditにNumbersOnlyプロパティ（数字だけを入力可能にする）が
//実装されているそうなので、せっかくだからTrueにしてみた！
//全角文字の「１２３」も「数値である」と判断してくれます･･･
NumbersOnly := True;
//IMEは使用不可（この１行がどうしても書きたかった！）
ImeMode := imDisable;
//文字位置
//Alignment := taCenter;
Alignment := taLeftJustify;
//Alignment := taRightJustify;
end;
ButtonTop := Edit.Top + Edit.Height + 15;
ButtonWidth := MulDiv(50, DialogUnits.X, 4);
ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
with TButton.Create(Form) do
begin
Parent := Form;
Caption := 'OK';
ModalResult := mrOk;
Default := True;
SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
ButtonHeight);
end;
with TButton.Create(Form) do
begin
Parent := Form;
Caption := 'キャンセル';
ModalResult := mrCancel;
Cancel := True;
SetBounds(MulDiv(92, DialogUnits.X, 4), Edit.Top + Edit.Height + 15,
ButtonWidth, ButtonHeight);
Form.ClientHeight := Top + Height + 13;
end;
if ShowModal = mrOk then
begin
Value := Edit.Text;
Result := True;
end;
finally
Form.Free;
end;
end;
end;
このInputQueryをボタンクリックで呼び出します。
procedure TForm1.Button1Click(Sender: TObject);
var
Ret:string;
begin
if MyInputQuery('Dialog Caption', 'Please Enter the number:', Ret) then
begin
ShowMessage('Entered: '+ Ret);
end else begin
ShowMessage('False!');
end;
end;
var
i, j, k:integer;
begin
//初期化
k:=0;
//合計点を計算
for i := 1 to StringGrid1.RowCount-1 do
begin
for j := 1 to ( 解答欄の数 ) do
begin
if StringGrid1.Cells[j,i] <> '' then
begin
k := K + StrToInt(StringGrid1.Cells[j, i]);
end;
end;
//StringGrid.Cells[列, 行]
StringGrid1.Cells[( 解答欄の数 ) + 1, i]:= IntToStr(k);
//初期化
k:=0;
end;
実は少し工夫すれば100まできちんと表示できます。以前、どこかWeb上の情報で知ったのですが、Loopの中で増加する i の値をそのままProgressBarのPositionに代入せず、現在の i 値より「１大きな値をまず代入」し、その後、「１小さい値をセットしなおす」という技です。どなたが考えた技か知りませんが、これで100まできちんと表示できます。以下に、そのコードを示します（赤文字が追加するコード）。
procedure TForm1.Button1Click(Sender: TObject);
var
i, j:integer;
begin
//表示
StatusBar1.SimpleText:= '進捗状況：';
//ProgressBarの設定
ProgressBar1.Visible:=True;
ProgressBar1.Position:=0;
ProgressBar1.Max:=100;
//初期化
j:= 0;
for i:= 0 to 100 do
begin
//ProgressBar1.Position:= i; // -> MAXまで表示されない
// 100まで表示するコード
inc(j);
If ProgressBar1.Position < ProgressBar1.Max Then
begin
//目的の値より一つ大きくしてから、目的の値にする
ProgressBar1.Position:= j + 1;
ProgressBar1.Position:= j;
end else begin
//最大値にする時
//最大値を1つ増やしてから、元に戻す
ProgressBar1.Max:= 100 + 1;
ProgressBar1.Position:= j + 1;
ProgressBar1.Max:= 100;
ProgressBar1.Position:= j;
end;
Sleep(25);
Application.ProcessMessages;
end;
ProgressBar1.Visible:= False;
ShowMessage('Done!');
end;
StatusBar1DrawPanel手続きの if Panel=StatusBar.Panels[1] then 部分にもProgressBarに関する処理を追加します（赤文字の部分）。
if Panel=StatusBar.Panels[1] then
begin
//文字の表示(このPanel内のみ有効となるようだ)
StatusBar1.Canvas.Font.Color:= clBlack;
//背景色(このPanel内のみ有効となるようだ)
StatusBar1.Canvas.Brush.Color:= clBtnFace;
//矩形を取得
ARect:= Rect;
//表示位置(左寄せ)
DrawText(StatusBar1.Canvas.Handle, PChar(Panel.Text), -1, ARect,
DT_LEFT or DT_VCENTER or DT_SINGLELINE);
//ProgressBarの位置を設定
With ProgressBar1 do begin
Top:=Rect.Top;
Left:=Rect.Left;
Width:=Rect.Right - Rect.Left - 15;
Height:=Rect.Bottom - Rect.Top;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
w:integer;
begin
if not boolInfo then
begin
//制御用フラグを既読扱いに設定
boolInfo:=True;
StatusBar1.Panels[1].Text:= '最初の１回だけは表示したい案内';
//OKボタンを表示する位置を設定
w:= StatusBar1.Canvas.TextWidth('最初の１回だけは表示したい案内');
btnOK.SetBounds(
StatusBar1.Panels[0].Width + w + 5, 0, 40, StatusBar1.ClientHeight);
btnOK.Visible:=True;
StatusBar1.Refresh;
end;
end;
FormCreate手続きに追加する処理です。
procedure TForm1.FormCreate(Sender: TObject);
var
w:integer;
begin
･･･ 省略 ･･･
//案内表示の制御用フラグ
boolInfo:= False;
//OKボタン
btnOK.Parent:= StatusBar1;
btnOK.Visible:= False;
end;
StatusBar1DrawPanel手続きの中の if Panel=StatusBar.Panels[1] then の内容を次のように変更します。
if Panel=StatusBar.Panels[1] then
begin
//文字の表示(このPanel内のみ有効となるようだ)
if not boolInfo then
begin
StatusBar1.Canvas.Font.Color:= clBlack;
end else begin
StatusBar1.Canvas.Font.Color:= clBlue;
end;
//背景色(このPanel内のみ有効となるようだ)
if not boolInfo then
begin
StatusBar1.Canvas.Brush.Color:= clBtnFace;
end else begin
StatusBar1.Canvas.Brush.Color:= clAqua;
end;
･･･ 省略 ･･･
end;
