Please get out of my mind.
Please get out of my mind.
抜け殻になっちまうからさ。
Please get out of my mind.
Please get out of my mind.
何処かへ、消え失せてくれ。
THE STREET SLIDERS 「GET OUT OF MY MIND」より引用
そうだ。BYOD（Bring Your Own Device）環境があった。 カラー印刷の「紙」じゃなくて、「画像データ」、または「PDF文書」を、個人所有のタブレットに送信するんだ･･･。せっかく整備したBYOD環境の活用にもつながるし･･･。なにより「紙」を大量に消費するという、My Secret Weapon の最大の弱点も解消できる！
//TEditのonKeyPress イベント
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
//Enterキーで次のコントロールへ
if key = #13 then begin
keybd_event(VK_TAB,0,0,0);
Key := #0;
end;
//入力制限する場合 ここに記述する
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
//リターンキーで移動させる
if Key = #13 then
begin
SelectNext(ActiveControl, True, True);
Key := #0;
end;
end;
Private Sub CommandButton1_Click()
Dim PrintNo1 As Integer
Dim PrintNo2 As Integer
Dim i As Integer
'PDF出力用に追加
Dim Rng As Range
Dim fName As String
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"
'PDFにする範囲を指定
Set Rng = ActiveSheet.Range("B6:AB38")
'PDFファイル名
If i < 10 Then
fName = Range("C8") & "0" & Range("E8") & "_" & Range("G8")
Else
fName = Range("C8") & Range("E8") & "_" & Range("G8")
End If
'全角＆半角スペースを削除する
fName = Replace(fName, " ", "")
fName = Replace(fName, " ", "")
If Not CheckBox1.Value Then
'紙に印刷（テスト時にはここをコメント化する）
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Else
'PDF出力
Rng.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ActiveWorkbook.Path & "\" & fName & ".pdf"
End If
Next i
Range("A2").Select
End Sub
//手動でEmbeddable PythonへのPathを切り替え（存在の有無を調査）
AppDataDir:=ExtractFilePath(Application.ExeName)+'Python39-32';
//AppDataDir:=ExtractFilePath(Application.ExeName)+'Python39-64';
if DirectoryExists(AppDataDir) then
begin
end;
Traceback (most recent call last):
File "E:\採点プログラム\xxx.py", line 138, in <module>
model.load()
File "E:\採点プログラム\xxx.py", line 58, in load
self.interpreter = tflite.Interpreter(model_path=self.model_file)
File "E:\WPy64-3980\python-3.9.8.amd64\lib\site-packages\tensorflow\lite\python\interpreter.py", line 455, in __init__
_interpreter_wrapper.CreateWrapperFromFile(
ValueError: Could not open 'E:\採点プログラム\saved_model.tflite'.
[Finished in 5.174s]
implementation
uses
System.AnsiStrings;
//System.AnsiStringsは、起動Path中の全角文字の有無を調査するために追加
procedure TFormCollaboration.FormCreate(Sender: TObject);
var
i,j:integer;
･･･ 略 ･･･
//引数に指定した文字列が半角か全角かチェックする
function OnlySingleByte(const S: AnsiString): Boolean;
var
i: Integer;
begin
for i:=1 to Length(S) do
//System.SysUtilsのByteType関数（非推奨）が呼び出される
//if ByteType(S, i) <> mbSingleByte then
//usesにSystem.AnsiStringsが必要
if System.AnsiStrings.ByteType(S, i) <> mbSingleByte then
begin
Result := False;
Exit;
end;
Result := True;
end;
begin
//起動Path中の全角文字の有無を調査
//[dcc64 警告]データ損失の可能性がある文字列の暗黙のキャスト ('string' から
//'AnsiString')を表示しないようにAnsiString()で明示的に型キャストした
if not OnlySingleByte(AnsiString(Application.ExeName)) then
begin
MessageDlg('AC_Reader.exeへのPath中に全角文字が含まれていないか、'+
'確認してください。'+
'全角文字が含まれているとPythonEngineの初期化作業を行うことができません。'+#13#10+#13#10+
'全角文字を含まないPathに変更後、再度実行してください。',mtError,[mbOk],0);
//プログラムの終了
//Close; //止まらない！
Application.ShowMainForm:=False;
Application.Terminate; //停止するが、エラーが発生する
//halt; //停止するが、エラーが発生する
end else begin
//カーソルを待機状態にする
Screen.Cursor := crHourGlass;
･･･ 略 ･･･
end;
end;
contours = cv2.findContours(thresh, cv2.RETR_LIST, cv2.CHAIN_APPROX_SIMPLE)[0]
num = len(contours)
mylist = np.zeros((num, 4))
i = 0
# red = (0, 0, 255)
for cnt in contours:
x, y, w, h = cv2.boundingRect(cnt)
# 高さが小さい場合は無視（ここを調整すれば設問番号を無視できる）
#if h < '+cmbStrHeight.Text+': <- Delphi埋め込み用
if h < 30:
mylist[i][0] = 0
mylist[i][1] = 0
mylist[i][2] = 0
mylist[i][3] = 0
else:
mylist[i][0] = x
mylist[i][1] = y
mylist[i][2] = x + w
mylist[i][3] = y + h
#cv2.rectangle(img, (x, y), (x+w, y+h), red, 2)
i += 1
どうやら元画像の「色が薄い」 or 「画像の線が太い」と問題が発生する傾向が強い気がしてきた。僕はこの実験に「えんぴつ」を使ったが、普通、試験時解答に使うのはシャーペンだから線が太くなることはあまり考えられない、むしろ、なるべく濃く書くことを注意事項に入れるべきかもしれない。なお、幅が狭くなっているように見えるのは、画像を強制的に幅64×高さ63にリサイズしているためだ。
//リソースに読み込んだ初期化用ファイルを再生
//ファイルの位置を指定
strFileName:=ExtractFilePath(Application.ExeName)+'imgAuto\tmp\maru.png';
//ファイルの存在を確認
if not FileExists(strFilename) then
begin
//リソースを再生
with TResourceStream.Create(hInstance, 'pngImage_1', RT_RCDATA) do
begin
try
SaveToFile(strFileName);
finally
Free;
end;
end;
end;
次に、Python Engineそのものを初期化。
//embPythonの存在の有無を調査
AppDataDir:=ExtractFilePath(Application.ExeName)+'Python39-64';
if DirectoryExists(AppDataDir) then
begin
//フォルダが存在したときの処理
PythonEngine1.AutoLoad := True;
PythonEngine1.IO := PythonGUIInputOutput1;
PythonEngine1.DllPath := AppDataDir;
PythonEngine1.SetPythonHome(PythonEngine1.DllPath);
PythonEngine1.LoadDll;
//PythonDelphiVar1のOnSeDataイベントを利用する
PythonDelphiVar1.Engine := PythonEngine1;
PythonDelphiVar1.VarName := AnsiString('var1');
//初期化
PythonEngine1.Py_Initialize;
end else begin
//MessageDlg('Python実行環境が見つかりません！',mtInformation,[mbOk], 0);
PythonEngine1.AutoLoad := False;
end;
最後に初期化用画像を読み込んで、１回だけ自動採点を実行する。
//スプラッシュ画面を表示してPython Engineを初期化
try
theSplashForm.Show;
theSplashForm.Refresh
//Scriptを入れるStringList
strScrList := TStringList.Create;
//結果を保存するStringList
strAnsList := TStringList.Create;
try
strScrList.Add('import json');
･･･略（自動採点用のPythonスクリプトをStringListに作成）･･･
//０による浮動小数除算の例外をマスクする
MaskFPUExceptions(True);
//Execute
PythonEngine1.ExecStrings(strScrList);
//先頭に認識した文字が入っている
if GetTokenIndex(strAnsList[0],',',0)='○' then
begin
//ShowMessage('The Python engine is now on standby!');
theSplashForm.StandbyLabel.Font.Color:=clBlue;
theSplashForm.StandbyLabel.Caption:='The P_Engine is now on standby!';
theSplashForm.StandbyLabel.Visible:=True;
Application.ProcessMessages;
//カウントダウン
for j:= 2 downto 1 do
begin
theSplashForm.TimeLabel.Caption:=Format('起動まであと%d秒', [j]);
Application.ProcessMessages;
Sleep(1000);
end;
end else begin
ShowMessage('Unable to initialize python engine!');
MessageDlg('Auto-scoring is not available!'+#13#10+
'Please contact your system administrator.',mtInformation,[mbOk],0);
end;
finally
//StringListの解放
strAnsList.Free;
strScrList.Free;
end;
finally
theSplashForm.Close;
theSplashForm.Destroy;
end;
これで「自動採点GroupBox」内の「実行」ボタンをクリックした際の処理が、ほぼ待ち時間なしで行われるようになった。これをやっておくのと、おかないのとでは、プログラムの使用感がまったく異なってくる･･･。上記のプログラムの for j := 2 downto 1 do 部分を「ムダ」だと思う方もいらっしゃるかもしれませんが、「画像の使用権を購入」してまで表示したスプラッシュ画面なので、せめて２秒間だけ！必要以上に長く表示させてください･･･。
# 輝度反転
from PIL import Image
import numpy as np
from matplotlib import pylab as plt
for i in range(2898):
# 画像の読み込み
im = np.array(Image.open(r"X:\Path"+r"\a"+'{0:04d}'.format(i)+".png").convert('L'))
# 輝度反転
im = 255 - im[:,:]
# print(im.shape, im.dtype)
#保存
Image.fromarray(im).save(r"X:\Path"+r"\a"+'{0:04d}'.format(i)+".png")
様々に思い悩んだが、結局、新規に作成する文字データは、白 or 黒いずれかの色のみで構成すると決めたので、中途半端なシミや汚れは排除することにして、シミや汚れのある画像を徹底的に手動で削除。これは修行だと考えて、１万枚を超える画像を１枚ずつチェックしながら、一心不乱に作業した。せっせ、せっせ、せっせ、せっせ･･･
this is the example where you need to put the "MaskFPUExceptions(True);"
procedure TForm1.Button1Click(Sender: TObject);
begin
MaskFPUExceptions(True);
PythonEngine1.ExecStrings( Memo1.Lines );
end;
そもそも「FPU」なるモノは、「Floating-point number Processing Unit：浮動小数点数演算装置」の略称とのことで、その「Exceptions」＝例外の「Mask」だから、「浮動小数点例外のマスク」ということでMaskFPUExceptions。実に覚えやすい良い名前。
「著者： Embarcadero Japan Support 2021年11月09日」ってコトは ･･･
（へぇー！ DelphiでもMNISTできるんだ。知らなかったー！！）
（しかも、日付がどちらかと言えば 最近！）
急に興味関心が湧いて、しばらく記事を読んでみる。記事によれば、現在 TensorFlow LiteがDelphiで利用可能とのこと（気分的には TensorFlow Super Heavy の方がマッチするんだけど、残念ながらそれはないようだ）。４年前にPythonでやったのと同じ、マウスで画面に数字を書いて、それが０～９の何なのかを判定するプログラムの画像が掲載され、「プロジェクト全体をダウンロードしてテストすることができます。」とある。
function GetCommaText(aStr:String; aIndex:Integer):string;
var
subList:TStringList;
begin
subList := TStringList.Create;
subList.Delimiter := ',';
subList.DelimitedText := aStr;
Result := subList.Strings[aIndex];
subList.Free;
end;
function MyCustomSort(List: TStringList; Index1, Index2: Integer): Integer;
begin
case fStyle of
ssText:begin
Result:=CompareText(GetCommaText(List.Strings[Index1],
fIndex),
GetCommaText(List.Strings[Index2],fIndex));
end;
ssInteger:begin
//一重ソート
//Result:=StrToInt(GetCommaText(List.Strings[Index1],fIndex))
// -StrToInt(GetCommaText(List.Strings[Index2],fIndex));
//二重ソート
Result:=StrToInt(GetCommaText(List.Strings[Index1],fIndex))
-StrToInt(GetCommaText(List.Strings[Index2],fIndex));
if Result=0 then
//-1することで１番目の項目がソートキーになる
Result:=StrToInt(GetCommaText(List.Strings[Index1],fIndex-1))
-StrToInt(GetCommaText(List.Strings[Index2],fIndex-1));
if fAscending then
begin
Result:=Result*-1;
end else begin
Result:=Result*1;
end;
end;
else
//これを入れておかないとコンパイラが警告を表示する
Result:=0;
end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
i:integer;
begin
//行番号をLines[i]で取得
i:=StrToInt(LBRow.Caption)-1;
EditTF:= not EditTF;
if EditTF then
begin
BitBtn1.Caption:='編集中';
BitBtn1.Font.Color:=clRed;
Memo2.ReadOnly:=False;
btnSave.Enabled:=False;
//i行目の文字全てを選択状態にしたい場合
//先頭にカーソルをセット
Memo2.SelStart:=Memo2.Perform(EM_LINEINDEX, i, 0);
//全ての文字を選択
Memo2.SelLength:=Length(WideString(Memo2.Lines[i]));
//Memo2.Perform(WM_VSCROLL,SB_TOP,0); //先頭にスクロール
end else begin
BitBtn1.Caption:='編 集';
BitBtn1.Font.Color:=clBlack;
Memo2.ReadOnly:=True;
Memo2.SelStart:=SendMessage(Memo2.Handle,EM_LineIndex,i,0);
btnSave.Enabled:=True;
Memo2Click(Sender);
end;
//SetFocus
Memo2.SetFocus;
end;
Delete or Backspaceキーで不要なデータを削除すると同時に、Memoの行も削除する。で、ボタンを「編集」（＝意味的には「編集したい場合はクリックせよ」）に戻す。次のデータをラバーバンドで囲む。この一連の動作がすべて自動的に流れ作業で行われるように手続きを作成。
コードは次の通り。
procedure TForm1.Memo2KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var
LineNo:integer;
begin
//現在、カーソルがある行を取得
LineNo:=Memo2.Perform(EM_LINEFROMCHAR, UINT(-1), 0);
//空欄なら行を削除
if Memo2.Lines[LineNo]='' then
begin
Memo2.Lines.Delete(LineNo);
end;
//表示
GetLinePos;
if not EditTF then
begin
Memo2Click(Sender);
end else begin
BitBtn1Click(Sender);
end;
end;
procedure TForm1.GetLinePos;
var
CurPos,Line:Integer;
begin
with Memo2 do
begin
CurPos:=SelStart;
Line:=Perform(EM_LINEFROMCHAR, CurPos, 0);
//LBRowは現在フォーカスがある行番号を表示するラベル
LBRow.Caption:=Format('%d', [Line+1]);
LBRow2.Left:=LBRow.Left+LBRow.Width;
LBRow2.Caption:='行目';
end;
end;
procedure TForm1.Memo2Click(Sender: TObject);
var
i:integer;
p1,p2:TPoint;
function RemoveToken(var s:string;delimiter:string):string;
var
p:Integer;
begin
p:=Pos(delimiter,s);
if p=0 then Result:=s
else Result:=Copy(s,1,p-1);
s:=Copy(s,Length(Result)+Length(delimiter)+1,Length(s));
end;
function GetTokenIndex(s:string;delimiter:string;index:Integer):string;
var
i:Integer;
begin
Result:='';
for i:=0 to index do
Result:=RemoveToken(s,delimiter);
end;
begin
if not EditTF then
begin
//座標を取得
i:=Memo2.Perform(EM_LINEFROMCHAR, Memo2.SelStart, 0);
//エラー対策
if Memo2.Lines[i]='' then Exit;
x1:=StrToInt(GetTokenIndex(Memo2.Lines[i],',',0));
y1:=StrToInt(GetTokenIndex(Memo2.Lines[i],',',1));
x2:=StrToInt(GetTokenIndex(Memo2.Lines[i],',',2));
y2:=StrToInt(GetTokenIndex(Memo2.Lines[i],',',3));
if Assigned(plImage1) then begin
FreeAndNil(plImage1);
end;
//コンポーネントを生成し，イベントを定義し，位置を指定して画像を表示
plImage1:=TplResizeImage.Create(Self);
plImage1.Parent:=ScrollBox1;
plImage1.TransEvent:=True;
//クライアント座標をスクリーン座標へ変換
//GetSystemMetrics(SM_CYCAPTION) -> タイトルバーの高さ
//GetSystemMetrics(SM_CYFRAME) -> ウィンドウの枠幅
p1.X:=x1-(GetSystemMetrics(SM_CYFRAME) div 2);
p1.Y:=y1-GetSystemMetrics(SM_CYCAPTION)-(GetSystemMetrics(SM_CYFRAME) div 2);
p2.X:=x2-(GetSystemMetrics(SM_CYFRAME) div 2);
p2.Y:=y2-GetSystemMetrics(SM_CYCAPTION)-(GetSystemMetrics(SM_CYFRAME) div 2);
p1:=Image1.ClientToScreen(p1);
p2:=Image1.ClientToScreen(p2);
plImage1.SetBounds(p1.X, p1.Y, p2.X-p1.X, p2.Y-p1.Y);
//SelectedプロパティをTrueにするとラバーバンドとグラブハンドルが表示される
plImage1.Selected := True;
plImage1.BringToFront;
end;
end;
procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
var
StrText: string;
begin
//何かキーが押し下げられたら
if Msg.message = WM_KEYDOWN then
begin
try
if ActiveControl is TMemo then
begin
//キー操作を「通常動作」にするおまじない
case Msg.Message of
WM_USER + $0500:
Handled := True;
end;
end else begin
//上位ビットが1ならShiftキーが押されている
if GetKeyState(VK_SHIFT) and $8000 <> 0 then
begin
if plImage1.Visible then
begin
//右矢印キー
if Msg.wParam=VK_RIGHT then
begin
plImage1.Width := plImage1.Width + 1;
Msg.wParam:=0;
end;
//左矢印キー
if Msg.wParam=VK_LEFT then
begin
plImage1.Width := plImage1.Width - 1;
Msg.wParam:=0;
end;
//上矢印キー
if Msg.wParam=VK_UP then
begin
plImage1.Height := plImage1.Height - 1;
Msg.wParam:=0;
end;
//下矢印キー
if Msg.wParam=VK_DOWN then
begin
plImage1.Height := plImage1.Height + 1;
Msg.wParam:=0;
end;
end;
end else begin
//Shiftキーは押されていない
//対象を限定（どちらでも動いた）
//if TplResizeImage(ActiveControl).Visible then
if plImage1.Visible then
begin
//右矢印キー
if Msg.wParam=VK_RIGHT then
begin
plImage1.Left := plImage1.Left +1;
Msg.wParam:=0;
end;
//左矢印キー
if Msg.wParam=VK_LEFT then
begin
plImage1.Left := plImage1.Left -1;
Msg.wParam:=0;
end;
//上矢印キー
if Msg.wParam=VK_UP then
begin
plImage1.Top := plImage1.Top - 1;
Msg.wParam:=0;
end;
//下矢印キー
if Msg.wParam=VK_DOWN then
begin
plImage1.Top := plImage1.Top + 1;
Msg.wParam:=0;
end;
//Deleteキー
if Msg.wParam=VK_DELETE then
begin
//plImage1を解放
if Assigned(plImage1) then begin
FreeAndNil(plImage1);
end;
Msg.wParam:=0;
end;
end;
end;
end;
except
on E: Exception do
begin
StrText := E.ClassName + sLineBreak + E.Message;
Application.MessageBox(PChar(StrText), '情報', MB_ICONINFORMATION);
end;
end;
end;
end;
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;
