procedure TForm1.RestartApplication;
var
FileName: string;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
begin
FileName := ParamStr(0);
ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
StartupInfo.cb := SizeOf(StartupInfo);
ZeroMemory(@ProcessInfo, SizeOf(ProcessInfo));
if CreateProcess(PChar(FileName), nil, nil, nil, False, 0, nil, nil, StartupInfo, ProcessInfo) then
begin
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
end;
Application.Terminate;
end;
以上のように手続き・関数を準備して、FormCreate 時の設定。
procedure TForm1.FormCreate(Sender: TObject);
begin
//チェックボックスの状態をロード中に OnClick イベントがトリガーされるのを防止する
IsLoading:=False;
LoadCheckCMS_State(CheckCMS); //Checked プロパティを復元
if IsRestarting then
ClearRestartFlag; //再起動フラグをクリア
end;
最後に、いちばん肝心な CheckCMSClick 手続き。実際は、ここからすべてが始まる。
procedure TForm1.CheckCMSClick(Sender: TObject);
var
strMsg: string;
begin
//再起動状態でなければ実行
if not IsLoading then
begin
SaveCheckCMS_State(CheckCMS); //Checked プロパティを保存
//最初はコレでいいかと思ったんだけれど・・・あまりにも乱暴な気が。
//strMsg:='設定はプログラムの再起動後に有効になります。'+#13#10+
// 'OKで再起動します。';
//Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
//RestartApplication;
//操作の取り消しができるように修正
strMsg:='設定はプログラムの再起動後に有効になります。'+#13#10+
'再起動してよろしいですか?';
if Application.MessageBox(PChar(strMsg), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
begin
//[はい]が選ばれた時
RestartApplication;
end else begin
//[いいえ]が選ばれた時
//メッセージを表示せず、チェックボックスの状態のみ変更
if CheckCMS.Checked then
begin
CheckCMS.OnClick := nil; //OnClickイベントを一時的に無効にする
CheckCMS.Checked := False;
CheckCMS.OnClick := CheckCMSClick; //OnClickイベントを再度設定
end else begin
CheckCMS.OnClick := nil; //OnClickイベントを一時的に無効にする
CheckCMS.Checked := True;
CheckCMS.OnClick := CheckCMSClick; //OnClickイベントを再度設定
end;
end;
end;
end;
ちなみに LLM は(今回、初めて知った!のですが)、自然言語処理( Natural Language Processing :NLP )のタスク※に使用される大規模言語モデル( Large Language Model )の略で、膨大な量のテキストデータを使って訓練された人工知能のモデルを意味するそうです。
※ 自然言語処理のタスク:「コンピュータがヒトの言語を理解し、生成し、処理する上での特定の課題や目的」のこと。すなわち、文章の生成、分類、翻訳、応答、人名・地名・組織名等の特定の名称認識( Named Entity Recognition:NER )、音声認識、要約など、実に様々な「タスク」があるようです。
調べてみると実にたくさんの LLM があり、果たしてどのモデルを選べばよいのか(例えば、日本語が得意で、プログラミングに適したモデルはどれなのか?)がわからず、当初、たいへん困りましたが、いくつかの Web サイトの情報を参考に、ここでは「 Gemma 2 」と「 Llama-3-ELYZA-JP-8B 」をダウンロードして使ってみました。
いくつかの Web サイトを参照して、まず「Gemma(ジェマ)」という LLM を試してみようかと思いました。正直、専門的なことは「チンプンカンプン」で「まったくわからない」私ですが、様々なサイトで「高性能」と評価されていたこと、そして何より、インストールがとても簡単そうだったのがいちばんの理由です。
C:\Users\ユーザー名>ollama create elyza:jp8b -f Modelfile
Error: open C:\Users\ユーザー名\Modelfile: The system cannot find the file specified.
( Modelfile が見えません・・・ あっ☆)
そこで次のようにしてカレントディレクトリを .ollama に変更。
C:\Users\ユーザー名>cd .ollama
もう一度、上記のモデル作成のコマンドを実行。
C:\Users\ユーザー名\.ollama>ollama create elyza:jp8b -f Modelfile
transferring model data 100%
using existing layer sha256:91553c45080b11d95be21bb67961c9a5d2ed7556275423efaaad6df54ba9beae
creating new layer sha256:8ab4849b038cf0abc5b1c9b8ee1443dca6b93a045c2272180d985126eb40bf6f
creating new layer sha256:c0aac7c7f00d8a81a8ef397cd78664957fbe0e09f87b08bc7afa8d627a8da87f
creating new layer sha256:bc526ae2132e2fc5e7ab4eef535720ce895c7a47429782231a33f62b0fa4401f
writing manifest
success
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
strMsg: string;
//Excelのプロセスが実行中であるか、どうかを調査する関数
function IsExcelRunning: Boolean;
var
Snapshot: THandle;
ProcessEntry: TProcessEntry32;
begin
Result := False;
Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if Snapshot = INVALID_HANDLE_VALUE then Exit;
ProcessEntry.dwSize := SizeOf(TProcessEntry32);
if Process32First(Snapshot, ProcessEntry) then
begin
repeat
if SameText(ProcessEntry.szExeFile, 'EXCEL.EXE') then
begin
Result := True;
Break;
end;
until not Process32Next(Snapshot, ProcessEntry);
end;
CloseHandle(Snapshot);
end;
//プロセスのリストを取得し、特定のプロセスを終了する関数
function TerminateExcelProcesses: Boolean;
var
Snapshot: THandle;
ProcessEntry: TProcessEntry32;
ProcessHandle: THandle;
begin
Result := False;
Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if Snapshot = INVALID_HANDLE_VALUE then Exit;
ProcessEntry.dwSize := SizeOf(TProcessEntry32);
if Process32First(Snapshot, ProcessEntry) then
begin
repeat
if SameText(ProcessEntry.szExeFile, 'EXCEL.EXE') then
begin
ProcessHandle := OpenProcess(PROCESS_TERMINATE, False, ProcessEntry.th32ProcessID);
if ProcessHandle <> 0 then
begin
if TerminateProcess(ProcessHandle, 0) then
begin
Result := True;
end;
CloseHandle(ProcessHandle);
end;
end;
until not Process32Next(Snapshot, ProcessEntry);
end;
CloseHandle(Snapshot);
end;
begin
if IsExcelRunning then
begin
//Excelのプロセスを終了させる
strMsg:='Excelのプロセスが実行中です。'+#13#10+#13#10+
'終了してもよろしいですか?';
if Application.MessageBox(PChar(strMsg), PChar('警告'), MB_YESNO or MB_ICONWARNING) = mrYes then
begin
//[はい]が選ばれた時
if TerminateExcelProcesses then
begin
strMsg:='Excelプロセスを終了しました。';
Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
end else begin
strMsg:='実行中のExcelプロセスは見つかりませんでした。';
Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
end;
end else begin
//[いいえ]が選ばれた時
strMsg:='Ctrl+Alt+Delキーを同時に押してタスクマネージャーを起動し、実行中の'+
'Excelのプロセスを必ず終了してください。';
Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
end;
end else begin
strMsg:='Excelは実行されていません。';
Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
//Excelのプロセスが実行中であるか、どうかを調査する関数
function IsExcelRunning: Boolean;
var
Snapshot: THandle;
ProcessEntry: TProcessEntry32;
begin
Result := False;
Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if Snapshot = INVALID_HANDLE_VALUE then Exit;
ProcessEntry.dwSize := SizeOf(TProcessEntry32);
if Process32First(Snapshot, ProcessEntry) then
begin
repeat
if SameText(ProcessEntry.szExeFile, 'EXCEL.EXE') then
begin
Result := True;
Break;
end;
until not Process32Next(Snapshot, ProcessEntry);
end;
CloseHandle(Snapshot);
end;
//プロセスのリストを取得し、特定のプロセスを終了する関数
function TerminateExcelProcesses: Boolean;
var
Snapshot: THandle;
ProcessEntry: TProcessEntry32;
ProcessHandle: THandle;
begin
Result := False;
Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if Snapshot = INVALID_HANDLE_VALUE then Exit;
ProcessEntry.dwSize := SizeOf(TProcessEntry32);
if Process32First(Snapshot, ProcessEntry) then
begin
repeat
if SameText(ProcessEntry.szExeFile, 'EXCEL.EXE') then
begin
ProcessHandle := OpenProcess(PROCESS_TERMINATE, False, ProcessEntry.th32ProcessID);
if ProcessHandle <> 0 then
begin
if TerminateProcess(ProcessHandle, 0) then
begin
Result := True;
end;
CloseHandle(ProcessHandle);
end;
end;
until not Process32Next(Snapshot, ProcessEntry);
end;
CloseHandle(Snapshot);
end;
begin
//Excelのプロセスが実行中である限りLoopさせ、完全にExcelのプロセスを終了させる。
While IsExcelRunning do
begin
TerminateExcelProcesses;
Application.ProcessMessages;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
//CSVファイルの読み込み
CSVFileName: string;
CsvFile:TextFile;
CsvRowStr: string;
i: Integer;
strMsg: string;
//列幅の調整
iCOL: Integer;
MaxColWidth: Integer;
iROW: Integer;
TmpColWidth: Integer;
begin
//表示設定
StringGrid1.Visible:=False;
//列数
StringGrid1.ColCount:=7;
//OpenDialogのプロパティはExecuteする前に設定しておくこと
With OpenDialog1 do begin
//表示するファイルの種類をcsvに設定
Filter:='CSVファイル(*.csv)|*.csv';
//データの読込先フォルダを指定
InitialDir:=ExtractFilePath(Application.ExeName)+'sName';
end;
//ダイアログ呼び出し
if OpenDialog1.Execute then
begin
CsvFileName:=OpenDialog1.FileName;
AssignFile(CsvFile, CsvFileName);
Reset(CsvFile);
end else begin
strMsg:='ユーザーによる処理のキャンセル';
Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
Exit;
end;
//フィールド名が必要なCSVファイルなら記述する
//StringGrid1.Rows[0].CommaText:=
// '通し番号,氏名,よみがな,年齢,生年月日,性別,血液型';
//Fixed Colが1列あって、そこに行番号を設定する場合
// ',通し番号,氏名,よみがな,年齢,生年月日,性別,血液型';
//読込み開始行を指定(FixedRowがある場合 -> ない場合は[0]にする)
i:=0;
try
while not EOF(CsvFile) do
begin
//CSVファイルを1行読み込み、その1行分を文字列として代入する。
Readln(CsvFile, CsvRowStr);
//グリッドの行数が読み込み行数より少なければ、グリッドの行数を追加する。
if StringGrid1.RowCount <= i then StringGrid1.RowCount := i + 1;
//グリッドの指定行目に読み込み行を代入
//[0]列はFixedCol-> 行番号を設定したい場合
//StringGrid1.Rows[i].CommaText:=IntToStr(i)+','+CsvRowStr;
StringGrid1.Rows[i].CommaText:=CsvRowStr;
i := i + 1;
end;
finally
//行番号を設定した場合
//StringGrid1.Cells[0,0]:='行番号';
CloseFile(CsvFile);
end;
//列幅の自動調整
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]) + 10;
if MaxColWidth < TmpColWidth then
MaxColWidth := TmpColWidth;
end;
StringGrid1.ColWidths[iCOL] := MaxColWidth;
end;
//表示設定
StringGrid1.Visible:=True;
end;
//データを出力
//Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);
//数値データは右揃えで出力する
if TryStrToInt(Fields[j], intValue) then
begin
//数値である -> 右揃えで出力する
Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),
Format('%3d', [strToInt(Fields[j])]));
end else begin
//数値でない -> 左揃えで出力する
Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);
end;
【実行結果】
追記(20240819)ここまで
2ページ目以降も先頭行にフィールド名を表示
先頭行にフィールド名を表示する部分は、いちばん悩んだところ。 最終的に変数eNum(LoopのEndNumber)から印刷に必要なページ数を取得し、StringListに格納した印刷データの0番目の要素をコピーして、これをStringListの51、101、151のように、eNumの現在の値( i * 50)+1番目に挿入して行く方法が計算的にも、処理的にも、いちばんラクなのではないか?・・・と考え、このアルゴリズムでプログラムを作成。
eNum:=StringList.Count div 50;
//51,101,151,201,251,301・・・番目にフィールド名を挿入
//0番目の要素をコピー
myFieldElement:=StringList[0];
//要素を追加
if eNum<>0 then
begin
for i := 1 to eNum do
begin
StringList.Insert((50*i)+1, myFieldElement);
end;
end;
for intLoop := 0 to eNum do
begin
k:=0;
iPlus:=0;
for i := LowNum to HighNum do
begin
for j := 0 to Fields.Count - 1 do
begin
//フィールド名に「備考」を追加する
if i=0 then
begin
if j=Fields.Count-1 then
begin
Fields[j]:=Fields[j]+' 備考';
end;
end;
//データを出力
Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);
end;
inc(iPlus);
end;
//大きさを指定
MyRect.Top:=0;
MyRect.Left:=0;
MyRect.Bottom:= Trunc((Printer.PageWidth / Image1.Picture.Width) * Image1.Picture.Height);
MyRect.Right:= Printer.PageWidth;
//ファイルを描画
StretchDrawBitmap(Printer.Canvas, MyRect, Image1.Picture.Bitmap);
Application.ProcessMessages;
end; //intLoopの終わり
procedure TForm1.btnPrintASheetClick(Sender: TObject);
var
i, j: Integer;
strMsg: string;
PrintALL: Boolean;
intLoopNum: Integer;
rect:TRect;
StrCaption:String;
StrPrompt:String;
StrValue1, StrValue2:String;
Chr : array [0..255] of char;
// ビットマップ用印刷ルーチン
procedure StretchDrawBitmap(Canvas:TCanvas; // 描画先キャンバス
r : TRect; // 描画先範囲
Bitmap:TBitmap); // ビットマップ
・・・省略・・・
begin
if PrinterSetupDialog1.Execute then
begin
//背景を塗りつぶす
Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;
Image1.Picture.Bitmap.Canvas.FillRect(rect(0, 0, 827, 1169)); //エラーになる部分
//Info
strMsg:='全員分印刷しますか?'+#13#10+'(個別印刷は「いいえ」)';
if Application.MessageBox(PChar(strMsg), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
begin
PrintALL:=True;
end else begin
PrintALL:=False;
end;
//全部印刷
if PrintAll then
begin
//先頭のデータを表示
btnFirstClick(Sender);
for i := 1 to ListBox1.Items.Count do
begin
//まず現在のImageを印刷
with Printer do
begin
if i=1 then
begin
BeginDoc;
end else begin
NewPage;
end;
//大きさを指定
rect.Top:=0;
rect.Left:= 0;
rect.Bottom:= Trunc(( PageWidth / Image1.Picture.Width) * Image1.Picture.Height);
rect.Right:= PageWidth;
//TImageのBitmapをPrinterのCanvasに描画
StretchDrawBitmap(Printer.Canvas, rect, Image1.Picture.Bitmap);
if i=ListBox1.Items.Count then
begin
EndDoc;
end;
end;
//次を表示
btnNextClick(Sender);
end;
・・・
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
LDelta:Integer;
//追加
LWinCtrl:TWinControl;
LCurPos:TPoint;
begin
{
//TScrollBox のマウスホイールによるスクロール
//マウスがTScrollBoxの外にあってもスクロールする・・・ならこちら☆
LDelta:=WheelDelta div 5;
if ssCtrl in Shift then
begin
ScrollBox1.HorzScrollBar.Position:=ScrollBox1.HorzScrollBar.Position-LDelta;
end else begin
ScrollBox1.VertScrollBar.Position:=ScrollBox1.VertScrollBar.Position-LDelta;
end;
Handled:=True;
}
//マウスカーソルが TScrollBox の領域内にある時だけスクロールを可能にする
LCurPos := ScrollBox1.Parent.ScreenToClient(MousePos);
if PtInRect(ScrollBox1.BoundsRect, LCurPos) then
begin
LDelta := WheelDelta div 3;
if ssCtrl in Shift then
begin
ScrollBox1.HorzScrollBar.Position := ScrollBox1.HorzScrollBar.Position - LDelta;
end else begin
ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position - LDelta;
//Memoも連動してスクロールさせる
{
if LDelta > 0 then
begin
Memo2.Perform(WM_VSCROLL, SB_LINEUP, 0);
end else begin
Memo2.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;
//この1行を忘れないこと!
Handled:=True;
end;
1列あたりの行数・全列数・選択肢の形式と選択肢数を「行・列・選択肢」順に並べています。 R は Row (=行)、すなわち1列 25 行より成ること、 C は Column (=列)、すなわち4列あること、 D は Double 型、すなわち複数マーク対応で、1行あたりの選択肢数は 19 個。 (ここが S の場合は Single 型、複数マーク不可)
Word や Excel で作成したマークシートを、同じインクジェットプリンタで印刷して使用しているので、試験を実施する度にテンプレートを登録する必要はないはずなのですが、筆者はなんとなく不安で、毎回新しくテンプレートを登録し直して作業しています・・・
これまでのマークシートは Word で作成していたので、今回も Word を利用。・・・と言うか、本当は印刷設定の自由度が大きい Excel を使いたいのだが、Excel で縦楕円の丸囲み数字を上手に作成する方法がわからない。そこで縦楕円の丸囲み数字が簡単に作成できる Word を利用した・・・というのが正直なところ。
ちなみに Word で縦楕円の丸囲み数字(=「囲い文字」というらしい)を作成する方法は・・・
Word なら、Font は「メイリオ」を選択(フォントサイズを大きくしない場合)、丸囲みしたい数字を半角で入力、入力した数字をマウスでドラッグして選択してから、フォントリボンの「囲い文字」アイコンをクリックすると・・・
//複数マークの読み取り方法
if (Copy(strMS_Type,10,2)='19') and (chk_MultipleMarks.Checked) then
begin
//選択肢数が19で、複数マーク許可であった場合
StrList.Add(' var1.Value = str(res)');
end else begin
//複数マークは不許可であった場合
StrList.Add(' var1.Value = "99"');
end;
Python側で読み取った値をDelphi側で処理する部分も変更(一部を抜粋)。
//選択肢の始まりは「ゼロ」
if (Copy(strMS_Type,10,2)='19') and (chk_MultipleMarks.Checked) then
begin
//複数マークに対応
//strAnsList[intSG_k]の文字数を調査
strCount:=ElementToCharLen(strAnsList[intSG_k],Length(strAnsList[intSG_k]));
//チェック内容は、以下の通り
{
文字数が2文字の場合、末尾の1文字を取得する
10 -> 0
11 -> 1
19 -> 9
末尾1文字がマークした選択肢の番号になる
文字数が5文字の場合、
1 10 -> 2文字目が1、末尾2文字が10 -> 10
2 11 -> 2文字目が2、末尾2文字が11 -> 21
3 12 -> 2文字目が3、末尾2文字が12 -> 32
(2文字目×10)+(末尾2文字 - 10)がマークした選択肢の番号になる
}
case strCount of
2:begin
//2文字の場合は、末尾1文字が選択した選択肢の番号
StringGrid1.Cells[intSG_Col,intSG_Row]:=RightStr(strAnsList[intSG_k],1);
end;
3:begin
//空欄と判定された場合
if strAnsList[intSG_k]='999' then
begin
StringGrid1.Cells[intSG_Col,intSG_Row]:=strAnsList[intSG_k];
end;
end;
5:begin
//(2文字目×10)+(末尾2文字 - 10)がマークした選択肢の番号
StringGrid1.Cells[intSG_Col,intSG_Row]:=IntToStr(
(StrToInt(Copy(strAnsList[intSG_k],2,1)) * 10) +
(StrToInt(RightStr(strAnsList[intSG_k],2))) - 10);
end;
end;
end else begin
//1行につき選択肢数分Loopする_複数選択肢に対応(New)_20240614
if (Copy(strMS_Type,10,2)='19') and (chk_MultipleMarks.Checked) then
begin
//複数選択可能な場合_選択肢の数だけLoopする
for p := 0 to intCol-1 do
begin
//対象値pが平均値の3倍より大きいか、どうかでマークありと判定
if AryVal[p]>dblAvg * intKeisu then
begin
//マークありとした判定の数を記録
q:=q+1;
//マークした番号(記号)を記録
//intMark:=p+1;
//10の位(0-8)
case p of
0:strMark_A:='1';
1:strMark_A:='2';
2:strMark_A:='3';
3:strMark_A:='4';
4:strMark_A:='5';
5:strMark_A:='6';
6:strMark_A:='7';
7:strMark_A:='8';
8:strMark_A:='9';
end;
//1の位
case p of
9:strMark_B:='0';
10:strMark_B:='1';
11:strMark_B:='2';
12:strMark_B:='3';
13:strMark_B:='4';
14:strMark_B:='5';
15:strMark_B:='6';
16:strMark_B:='7';
17:strMark_B:='8';
18:strMark_B:='9';
end;
end;
end;
//Loop終了時にマーク数を判定
if q=0 then
begin
//マークした番号がない場合
iArr[i,Rep]:=999;
end else begin
//マークした番号があり、それが一の位である場合
if (q=1) and (strMark_A='') then
begin
//マーク数が1、かつ十の位が空欄であったら
iArr[i,Rep]:=StrToInt(strMark_B);
end else begin
//マーク数は1だが、それが十の位であったら
iArr[i,Rep]:=100;
end;
if (q=2) and (strMark_A<>'') and (strMark_B<>'') then
begin
//マーク数が2、かつ十の位と一の位がともに空欄でなかったら
strMark:=strMark_A+strMark_B;
iArr[i,Rep]:=StrToInt(strMark);
end;
if q>2 then
begin
//トリプル以上のマーク数を見分けるフラグは100
iArr[i,Rep]:=100;
end;
end;
end else begin
//選択肢の始まりは「ゼロ」(1の位を基準)
if (Copy(strMS_Type,10,2)='19') and (chk_MultipleMarks.Checked) then
begin
//strAnsList[intSG_k]の文字数を調査
strCount:=ElementToCharLen(strAnsList[intSG_k],Length(strAnsList[intSG_k]));
//チェック内容は、以下の通り
{
文字数が2文字の場合、末尾の1文字を取得する
10 -> 0
11 -> 1
19 -> 9
末尾1文字がマークした選択肢の番号になる
文字数が5文字の場合、
1 10 -> 2文字目が1、末尾2文字が10 -> 10
2 11 -> 2文字目が2、末尾2文字が11 -> 21
3 12 -> 2文字目が3、末尾2文字が12 -> 32
(2文字目×10)+(末尾2文字 - 10)がマークした選択肢の番号になる
}
case strCount of
1:begin
if StrToInt(strAnsList[intSG_k])<10 then
begin
StringGrid1.Cells[intSG_Col,intSG_Row]:='100';
end;
end;
2:begin
//2文字の場合は、末尾1文字が選択した選択肢の番号
StringGrid1.Cells[intSG_Col,intSG_Row]:=RightStr(strAnsList[intSG_k],1);
end;
3:begin
//空欄と判定された場合
if strAnsList[intSG_k]='999' then
begin
StringGrid1.Cells[intSG_Col,intSG_Row]:=strAnsList[intSG_k];
end;
//3文字と判定された場合、十の位の1~9のダブルマークの場合、
//2文字目は必ず半角の空欄になる
if Copy(strAnsList[intSG_k],2,1)=' ' then
begin
StringGrid1.Cells[intSG_Col,intSG_Row]:='999';
end;
end;
5:begin
//文字列の置き換え(先頭2文字を抽出&半角スペースを削除する)
strData:=StringReplace(Copy(strAnsList[intSG_k],1,2),
' ', '', [rfReplaceAll, rfIgnoreCase]);
//Case 5で先頭2文字が10である場合はダブル以上のマークあり
if StrToInt(strData) > 9 then
begin
StringGrid1.Cells[intSG_Col,intSG_Row]:='999';
end else begin
//2文字目が半角スペースでなければ処理可能
if Copy(strAnsList[intSG_k],2,1)=' ' then
begin
StringGrid1.Cells[intSG_Col,intSG_Row]:='999';
end else begin
//(2文字目×10)+(末尾2文字 - 10)がマークした選択肢の番号
StringGrid1.Cells[intSG_Col,intSG_Row]:=IntToStr(
(StrToInt(Copy(strAnsList[intSG_k],2,1)) * 10) +
(StrToInt(RightStr(strAnsList[intSG_k],2))) - 10);
end;
end;
end;
6..99:begin
StringGrid1.Cells[intSG_Col,intSG_Row]:='999';
end;
end;
end else begin
//複数選択を許可しないマークシートの処理
end;
end;
この際、読み取りエラーをすべて「999」で処理すれば、これまでの経験から、読み取り結果のチェックプログラムは確実に「空欄」=「999」位置を教えてくれるし、もし、それが本当に「空欄」である場合は、人が見ればそれは一目瞭然、もし、それが空欄でない場合は、それを見た「人」に、マークの有無 or 空欄 or その他複数マークの判断を委ねればいい。そしてもし、「人」が見て、マークが正しければプログラムの判定結果を正しく修正、そうでなく、マークが「空欄でない」・「必要数以上にマークされていた」場合は、そのまま「空欄として処理(999)」してもらえば、採点結果には一切影響を与えないはずだ。
また、派生版であるため、プログラムには Excel Book に読み取り結果を出力する機能がありますが、大語群に対応した採点結果通知作成用の Excel ファイルは、Zipファイルを展開後、 eFile フォルダ内にあるテンプレートから生成できる Excel ファイルをマクロ有効な Excel Book として保存し、これを元にご自身で作成していただく必要があります。※ Zip ファイルに添付した Excel Book は、大語群マークシートに対応しておりません。
procedure TForm1.ButtonExitClick(Sender: TObject);
var
hWndPSWindow: HWND;
begin
//PowerShellを閉じる
hWndPSWindow:=FindWindow(nil, PChar('Windows PowerShell'));
if hWndPSWindow <> 0 then
begin
SetForegroundWindow(hWndPSWindow);
//文字列の送信
SendKeys('Exit');
//Enterキーの送信
SendKeys(#13#10);
end else begin
ShowMessage('PowerShellのウィンドウが見つかりません!');
end;
end;
するとPDFiumというライブラリがあるとCopilotさんが教えてくれました。ただ、紹介されたのは「PDFium Component Suite for FireMonkey」だったので、どちらかというとWindows専用にVCLコンポーネントを使ってプログラムを書きたい自分的には(FireMonkeyはちょっと・・・)という感じだったのですが・・・、「溺れる者は藁をもつかむ」と、まさにそんな気持ちでありましたから・・・記事に目を通してみることに。
Swanman (id:tales)さんのBlogの記事に紹介されていた Windows Runtime(略称がWinRT)なるものの存在を、これまで僕は知りませんでした。Win32 API なら名前だけは知ってましたが、どうやらそれより新しいAPI であるとのこと。難しいことはわかりませんが、このWinRTでPDFの画像化ができるのであれば、Windowsの機能を使ってそれが実現できるのですから、新規に何かライブラリを追加したりする必要がなく、それこそ理想的です。
procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
var
Value: Real;
begin
//注意:このコードは、期待通りに動作しません
Value := StrToFloatDef(Edit1.Text, 0);
case Button of
btNext: Value := Value + 0.1;
btPrev: Value := Value - 0.1;
end;
Edit1.Text := FloatToStrF(Value, ffNumber, 1, 1);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Value: Double;
begin
if TryStrToFloat(Edit2.Text, Value) then
begin
Value := Value + 0.1;
Edit2.Text := FloatToStr(Value);
end
else
ShowMessage('Invalid number');
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Value: Double;
begin
if TryStrToFloat(Edit2.Text, Value) then
begin
Value := Value - 0.1;
Edit2.Text := FloatToStr(Value);
end
else
ShowMessage('Invalid number');
end;
var
Value: Double;
Epsilon: Double;
begin
Epsilon := 1E-15; //閾値を設定
Value := SomeCalculation(); //計算を実行
if Abs(Value) < Epsilon then
Value := 0;
Edit1.Text := FloatToStr(Value);
end;
4.コードを修正
Copilotさんが教えてくれたコードを読んで、「0.0」と表示されるように修正しました。
procedure TForm1.Button3Click(Sender: TObject);
var
Value: Double;
Epsilon: Double;
begin
Epsilon := 1E-15; //閾値を設定
if TryStrToFloat(Edit3.Text, Value) then
begin
Value := Value + 0.1;
if Abs(Value) < Epsilon then
begin
Value := 0;
Edit3.Text := '0.0';
end else begin
Edit3.Text := FloatToStr(Value);
end;
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
var
Value: Double;
Epsilon: Double;
begin
Epsilon := 1E-15; //閾値を設定
if TryStrToFloat(Edit3.Text, Value) then
begin
Value := Value - 0.1;
if Abs(Value) < Epsilon then
begin
Value := 0;
Edit3.Text := '0.0';
end else begin
Edit3.Text := FloatToStr(Value);
end;
end;
end;
procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
Assert(Sender is TUpDown);
with TUpDown(Sender) do
begin
Assert(Associate is TEdit);
TEdit(Associate).Text := FloatToStrF(Position / 10, ffNumber, 1, 1);
end;
end;
procedure TFormXXX.PanelXStartDock(Sender: TObject;
var DragObject: TDragDockObject);
begin
DragObject:= TToolDockObject.Create(Sender as TPanel);
end;
procedure TFormXXX.PanelXStartDock(Sender: TObject;
var DragObject: TDragDockObject);
begin
//これでちらつかなくなった
DragObject:= TToolDockObject.Create(Sender as TPanel);
//設定し忘れないための予防的措置
if not FormXXX.DockSite then
begin
FormXXX.DockSite:=True;
end;
end;
ドロップ時のOnDockDropイベントは・・・
procedure TFormXXX.FormDockDrop(Sender: TObject;
Source: TDragDockObject; X, Y: Integer);
var
r:TRect;
begin
if IsDragObject(Source) then
begin
r.Left:=X;
r.Top:=Y;
r.Right:=X+PanelX.Width;
r.Bottom:=Y+PanelX.Height;
PanelX.ManualFloat(r);
//解放
Source.Free;
if FormXXX.DockSite then
begin
FormXXX.DockSite:=False;
end;
end;
end;
procedure TFormCollaboration.PanelXStartDock(Sender: TObject;
var DragObject: TDragDockObject);
begin
DragObject:= TToolDockObject.Create(Sender as TPanel);
try
if not FormXXX.DockSite then
begin
FormXXX.DockSite:=True;
Application.ProcessMessages; //おまじない
end;
finally
DragObject.Free; //メモリの解放
end;
FormXXX.DockSite:=False;
end;
DragObject:= TToolDockObject.Create(Sender as TPanel);
try
if not FormXXX.DockSite then
begin
FormXXX.DockSite:=True;
Application.ProcessMessages; //おまじない
end;
finally
DragObject.Free; //メモリの解放
end;
Microsoft Windows [Version 10.0.22631.3007]
(c) Microsoft Corporation. All rights reserved.
C:\Windows\System32>cd \
C:\>cd C:\Users\XXX\Downloads\ViVeTool-v0.3.3
C:\Users\XXX\Downloads\ViVeTool-v0.3.3>vivetool /query /id:41799415
ViVeTool v0.3.3 - Windows feature configuration tool
[41799415]
Priority : Service (4)
State : Enabled (2)
Type : Experiment (1)
C:\Users\XXX\Downloads\ViVeTool-v0.3.3>vivetool /disable /id:41799415
ViVeTool v0.3.3 - Windows feature configuration tool
Successfully set feature configuration(s)
C:\Users\XXX\Downloads\ViVeTool-v0.3.3>
上記リンク先でダウンロードできる「デジタル採点 All in One !」は、ここからダウンロードできる教科「情報」用マークシートも同梱しています。「デジタル採点 All in One !」には、マークシートリーダーの他、マークの読み取りを高速化するPython環境、手書き答案の採点プログラム、受験者に採点結果を通知する個票及び成績一覧表の作成プログラム、実際の採点現場で要請に応じて作成した各種のマークシート等を同梱しています。何の保証もサポートもありませんし、「All 自己責任でお願いします」という制約はありますが、すべて無料でお使いいただけます。