この本「徹底活用ブック」と銘打つだけあって、ThinkPad220に関するありとあらゆる情報が掲載されている感があり、どこから読んでも面白い本だった。新幹線の車内で電源を確保する方法など「こんなことやって、ほんとに大丈夫なのか?」と思っちゃったりもしたけど、そのゲーム機としての利用案内で知ったのが「Microsoft Flight Simulator Version 4」
(こんなん、あるんだー!)
それが「Flight Simulator」なるモノと、僕の出会いだった。
FS2020
FS98、FS2004どちらも楽しく遊べた。FS2004はWindowsXP時代のソフトで、インストールディスクなしで動かすには fs9.exe そのものを入れ替えるという裏技も必要だったりしたけど、ヤフオクで「Microsoft Force FeedBack2」なるジョイスティックも入手。現実世界では絶対に実現できない「火酒」を片手に操縦桿を握るという楽しみも、僕はこのFS2004で覚えた・・・。
procedure TForm1.chkSettingClick(Sender: TObject);
begin
if chkSetting.Checked then
begin
LabelID.Visible:=True;
btnCopy.Visible:=True;
btnCopy.Enabled:=True;
Edit1.Visible:=True;
LabelX.Visible:=True;
EditX.Visible:=True;
LabelY.Visible:=True;
EditY.Visible:=True;
btnSave.Visible:=True;
chkZahyo.Visible:=True;
LabelXY.Visible:=True;
LabelWaitTime.Visible:=True;
cmbWaitTime.Visible:=True;
end else begin
LabelID.Visible:=False;
btnCopy.Visible:=False;
Edit1.Visible:=False;
LabelX.Visible:=False;
EditX.Visible:=False;
LabelY.Visible:=False;
EditY.Visible:=False;
btnSave.Visible:=False;
chkZahyo.Visible:=False;
LabelXY.Visible:=False;
LabelWaitTime.Visible:=False;
cmbWaitTime.Visible:=False;
end;
end;
(3)入力値の保存/読み込みと暗号化
各VCLコントロールに入力された値は、必要な個所は暗号化してiniファイルに保存する。
uses
System.IniFiles;
procedure TForm1.btnSaveClick(Sender: TObject);
var
strID:string;
Ini:TIniFile;
begin
//入力の有無をCheck
if Edit1.Text='' then
begin
MessageDlg('IDとして利用するメールアドレスを入力してください', mtInformation, [mbOk] , 0);
Edit1.SetFocus;
Exit;
end;
if (EditX.Text='') or (EditY.Text='') then
begin
if EditX.Text='' then
begin
MessageDlg('自動クリックするX座標を入力してください', mtInformation, [mbOk] , 0);
EditX.SetFocus;
end;
if EditY.Text='' then
begin
MessageDlg('自動クリックするY座標を入力してください', mtInformation, [mbOk] , 0);
EditY.SetFocus;
end;
Exit;
end;
if cmbWaitTime.Text='' then
begin
MessageDlg('カーソル移動の待機時間をミリ秒単位で入力してください', mtInformation, [mbOk] , 0);
cmbWaitTime.SetFocus;
Exit;
end;
//暗号化
strID:=EDText(Edit1.Text, IntToStr(HashOf('XXXXXXXX')), True);
//iniファイルに保存
Ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
try
//保存
Ini.WriteString('Section', 'ID', strID);
Ini.WriteString('Section', 'IchiX', EditX.Text);
Ini.WriteString('Section', 'IchiY', EditY.Text);
Ini.WriteString('Section', 'WaitTime', cmbWaitTime.Text);
//Userに通知
MessageDlg('現在の設定を保存しました!', mtInformation, [mbOk] , 0);
if not btnCopy.Enabled then btnCopy.Enabled:=True;
finally
Ini.Free;
end;
end;
コードの中で使用しているEDText関数はテキスト暗号化の関数。
private
{ Private 宣言 }
//HashNameMBCS(Create hashed values from a Unicode string)
//MBCS:Multibyte Character Set=マルチバイト文字セット
function HashOf(const key: string): cardinal;
//テキスト暗号化/復号化
Function EDText(KeyStr,PassW:string; EncOrDec:Boolean):string;
//KeyStr:平文 or 暗号化文のいずれかを指定
//PassW:パスワード
//EncOrDec:True -> Encode / False -> Decode
public
{ Public 宣言 }
end;
function TForm1.HashOf(const key: string): cardinal;
var
I: integer;
begin
Result := 0;
for I := 1 to length(key) do
begin
Result := (Result shl 5) or (Result shr 27);
Result := Result xor Cardinal(key[I]);
end;
end;
function TForm1.EDText(KeyStr, PassW: string; EncOrDec: Boolean): string;
var
{暗号化用変数}
Source, Dest, Password:TStringBuilder;
lpSource, lpPass:Integer;
PassValue, SourceValue, EDValue:Word;
{共用変数}
//乱数の種
Seed1,Seed2,Seed3:integer;
//実数の一様乱数
RandNum:Double;
//秘密鍵Seed
Seed:string;
{復号化用変数}
DecSource:string;
begin
//1.シード値を準備
// (1)Passwordを整数へ変換→シード値1へ代入
Password := TStringBuilder.Create;
//Seed1を初期化
//Seed1:=0;
try
Password.Append(PassW);
PassValue := 0;
for lpPass := 0 to Password.Length - 1 do
begin
//パスワード→整数
PassValue := PassValue + Word(Password.Chars[lpPass]);
end;
Seed1:=PassValue;
finally
Password.Free;
end;
// (2)パスワード文字列の長さを取得→シード値2へ代入
Seed2:= ElementToCharLen(PassW,Length(PassW));
// (3)シード値1とシード値2の排他的論理和を計算して、シード値3へ代入
Seed3 := Seed1 xor Seed2;
//2.実数の一様乱数を計算
//---------------------------------------------------------------------------
// 0より大きく1より小さい実数の一様乱数を発生する関数
// B.A.Wichmann and I.D.Hill, Applied Statistics, 31, 1982, p.188 に基づく
// Seed1-3に入れる初期値(整数)は16bit長(maxint=32767)で十分
// Seed1-3には1から30000までの任意の整数値を準備する(0ではいけない)
//---------------------------------------------------------------------------
//Seed1:=171*Seed1 mod 30269 と同値
Seed1:=(Seed1 mod 177)*171-(Seed1 div 177)* 2;
if Seed1<0 then Seed1:=Seed1+30269;
//Seed2:=172*Seed1 mod 30307 と同値
Seed2:=(Seed2 mod 176)*172-(Seed2 div 176)* 35;
if Seed2<0 then Seed2:=Seed2+30307;
//Seed1:=170*Seed1 mod 30323 と同値
Seed3:=(Seed3 mod 178)*170-(Seed3 div 178)* 63;
if Seed3<0 then Seed3:=Seed3+30323;
//See1-3それぞれの乱数を0<RandNum<1となるように
//計算結果が0より大きく、1未満の実数に直し、和の小数部分をとる
RandNum:=(Seed1/30269.0) + (Seed2/30307.0) + (Seed3/30323.0);
while RandNum>=1 do RandNum:=RandNum-1;
//3.秘密鍵を生成
//整数の一様乱数の上限値を決めて、整数の一様乱数を生成し、
//これに上で計算した実数の一様乱数を加えて秘密鍵を生成する
//Seedが秘密鍵(文字列として利用)となる
Seed:= FloatToStr(RandNum + trunc((Seed1+Seed2+Seed3)*RandNum));
//4.暗号化 / 復号化
if (EncOrDec) then
begin
//暗号化(Encode)
Source := TStringBuilder.Create;
Dest := TStringBuilder.Create;
Password := TStringBuilder.Create;
try
Source.Append(KeyStr);
//秘密鍵をセット
Password.Append(Seed);
lpPass := 0;
//テキストのエンコード
for lpSource := 0 to Source.Length - 1 do
begin
//パスワード→整数
if Password.Length = 0 then
PassValue := 0
else begin
PassValue := Word(Password.Chars[lpPass]);
Inc(lpPass);
if lpPass >= Password.Length then lpPass := 0;
end;
//テキスト→整数
SourceValue := Word(Source.Chars[lpSource]);
//XOR演算
EDValue := PassValue xor SourceValue;
//16進数文字列に変換
Dest.Append(IntToHex(EDValue, 4));
//処理結果を返り値にセット
Result:=Dest.ToString;
end;
finally
Password.Free;
Dest.Free;
Source.Free;
end;
end else begin
//復号化(Decode)
DecSource:=keyStr;
Dest := TStringBuilder.Create;
Password := TStringBuilder.Create;
try
//暗号化テキストのデコード
Dest.Clear;
Password.Clear;
//秘密鍵をセット
Password.Append(Seed);
lpPass := 0;
for lpSource := 1 to Length(DecSource) div 4 do
begin
SourceValue := StrToInt('$' + Copy(DecSource, (lpSource - 1) * 4 + 1, 4));
if Password.Length = 0 then
PassValue := 0
else
begin
PassValue := Word(Password.Chars[lpPass]);
Inc(lpPass);
if lpPass >= Password.Length then lpPass := 0;
end;
EDValue := SourceValue xor PassValue;
Dest.Append(Char(EDValue));
end;
//処理結果を返り値にセット
Result:=Dest.ToString;
finally
Password.Free;
Dest.Free;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Ini: TIniFile;
strID, strX, strY, strWaitTime: String;
i:integer;
begin
//Formを最大化して表示
Form1.WindowState:=wsMaximized;
//待ち時間の選択肢(100~3000ミリ秒を100ミリ秒単位で用意)
for i := 1 to 30 do
begin
cmbWaitTime.Items.Add(IntToStr(i*100));
end;
//iniファイルの存在を確認
if FileExists(ChangeFileExt(Application.ExeName, '.ini')) then
begin
//iniファイルからデータを読込み
Ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
try
strID:=Ini.ReadString('Section', 'ID', '');
strX:=Ini.ReadString('Section', 'IchiX', '580');
strY:=Ini.ReadString('Section', 'IchiY', '420');
strWaitTime:=Ini.ReadString('Section', 'WaitTime', '500');
finally
Ini.Free;
end;
//復号して表示
Edit1.Text:=EDText(strID, IntToStr(HashOf('XXXXXXXX')), False);
EditX.Text:=strX;
EditY.Text:=strY;
cmbWaitTime.Text:=strWaitTime;
end;
//Navigate
EdgeBrowser1.Navigate('https://onedrive.live.com/about/ja-jp/signin/');
end;
(4)カーソル位置の座標を取得
マウスのカーソルが現在置かれている位置のスクリーン座標を取得してLabelに表示。
procedure TForm1.chkZahyoClick(Sender: TObject);
begin
if chkZahyo.Checked then
begin
//Enabled
Timer1.Enabled:=True;
end else begin
//Enabled
Timer1.Enabled:=False;
LabelXY.Caption:='[X座標, Y座標]';
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Ini: TIniFile;
strID, strX, strY, strWaitTime: String;
i:integer;
dllFileName:string;
begin
//リソースからDLLを(なければ)生成
//rijnファイルの位置を指定
dllFileName:=ExtractFilePath(Application.ExeName)+'WebView2Loader.dll';
//rijnファイルの存在を確認
if not FileExists(dllFilename) then
begin
//リソースを再生
with TResourceStream.Create(hInstance, 'Resource_1', RT_RCDATA) do
begin
try
SaveToFile(dllFileName);
finally
Free;
end;
end;
end;
・・・
end;
procedure TForm1.chkInfoClick(Sender: TObject);
var
strInfo:string;
strWidth:integer;
begin
if chkInfo.Checked then
begin
//表示する文字列
strInfo:='ID(メールアドレス)が自動入力されないときは、Ctrl+V で入力できます!';
strWidth:=StatusBar1.Canvas.TextWidth(strInfo);
btnOK.Visible:=True;
with btnOK do
begin
Parent:=StatusBar1;
Left:=strWidth-20;
Top:=1;
end;
//StatusBar1の設定(重要:このプロパティがFalseだとStatusBarにテキストが表示されない)
StatusBar1.SimplePanel:=True;
//Info
StatusBar1.SimpleText:=strInfo;
end else begin
StatusBar1.SimpleText:='';
btnOK.Visible:=False;
end;
end;
案内を「表示する」が選ばれていた場合はFormCreate時に案内表示を出すよう設定。
procedure TForm1.FormCreate(Sender: TObject);
var
Ini: TIniFile;
strID, strX, strY, strWaitTime: String;
i:integer;
dllFileName:string;
strWidth:Integer;
strInfo:string;
boolInfo:boolean;
begin
if chkInfo.Checked then
begin
//表示する文字列
strInfo:='ID(メールアドレス)が自動入力されないときは、Ctrl+V で入力できます!';
strWidth:=StatusBar1.Canvas.TextWidth(strInfo);
with btnOK do
begin
Parent:=StatusBar1;
Left:=strWidth-20;
Top:=1;
end;
//StatusBar1の設定(重要:このプロパティがFalseだとStatusBarにテキストが表示されない)
StatusBar1.SimplePanel:=True;
//Info
StatusBar1.SimpleText:=strInfo;
end;
・・・
//iniファイルの存在を確認
if FileExists(ChangeFileExt(Application.ExeName, '.ini')) then
begin
//iniファイルからデータを読込み
Ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
try
strID:=Ini.ReadString('Section', 'ID', '');
strX:=Ini.ReadString('Section', 'IchiX', '580');
strY:=Ini.ReadString('Section', 'IchiY', '420');
strWaitTime:=Ini.ReadString('Section', 'WaitTime', '500');
boolInfo:=Ini.ReadBool('Section','Info',True);
finally
Ini.Free;
end;
//復号して表示
Edit1.Text:=EDText(strID, IntToStr(HashOf('adminy')), False);
EditX.Text:=strX;
EditY.Text:=strY;
cmbWaitTime.Text:=strWaitTime;
chkInfo.Checked:=boolInfo;
end;
・・・
end;
案内そのものを表示したくない場合は、ユーザーの自由意思でその設定も可能に。
procedure TForm1.btnSaveClick(Sender: TObject);
var
strID:string;
Ini:TIniFile;
begin
//入力の有無をCheck
・・・
//暗号化
strID:=EDText(Edit1.Text, IntToStr(HashOf('adminy')), True);
//iniファイルに保存
Ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
try
//保存
Ini.WriteString('Section', 'ID', strID);
Ini.WriteString('Section', 'IchiX', EditX.Text);
Ini.WriteString('Section', 'IchiY', EditY.Text);
Ini.WriteString('Section', 'WaitTime', cmbWaitTime.Text);
Ini.WriteBool('Section','Info',chkInfo.Checked);
//Userに通知
MessageDlg('現在の設定を保存しました!', mtInformation, [mbOk] , 0);
if not btnCopy.Enabled then btnCopy.Enabled:=True;
finally
Ini.Free;
end;
end;
WebView4Delphi is an open source project created by Salvador Díaz Fau to embed Chromium-based browsers in applications made with Delphi or Lazarus/FPC for Windows.
function TMiniBrowserFrm.WaitTime(const t: integer): Boolean;
var
Timeout: TDateTime;
begin
//待ち関数 指定カウントが経過すれば True, 中断されたならば False
fgWaitBreak := False;
Timeout := Now + t/24/3600/1000;
while (Now < Timeout)and not fgWaitBreak do begin
Application.ProcessMessages;
Sleep(1);
end;
Result := not fgWaitBreak;
end;
procedure NetErrorProc(err: DWORD);
var
s: String;
begin
case err of
ERROR_ACCESS_DENIED: s := ERR_ACCESS_DENIED;
ERROR_ALREADY_ASSIGNED: s := ERR_ALREADY_ASSIGNED;
ERROR_BAD_DEV_TYPE: s := ERR_BAD_DEV_TYPE;
ERROR_BAD_NET_NAME: s := ERR_BAD_NET_NAME;
ERROR_BAD_PROFILE: s := ERR_BAD_PROFILE;
ERROR_BAD_PROVIDER: s := ERR_BAD_PROVIDER;
ERROR_BUSY: s := ERR_BUSY;
ERROR_CANCELLED: s := ERR_CANCELLED;
ERROR_CANNOT_OPEN_PROFILE: s := ERR_CANNOT_OPEN_PROFILE;
ERROR_DEVICE_ALREADY_REMEMBERED: s := ERR_DEVICE_ALREADY_REMEMBERED;
ERROR_EXTENDED_ERROR: s := ERR_EXTENDED_ERROR;
ERROR_INVALID_PASSWORD: s := ERR_INVALID_PASSWORD;
ERROR_NO_NET_OR_BAD_PATH: s := ERR_NO_NET_OR_BAD_PATH;
ERROR_NO_NETWORK: s := ERR_NO_NETWORK;
//次の行はエラーメッセージから調べて追加
53: s := ERROR_BAD_NETPATH;
1200: s := ERROR_BAD_DEVICE;
2202: s := NERR_BadUsername;
else
s := IntToStr(err);
end;
MessageDlg(s, mtError, [mbOk], 0);
end;
begin
//StringGridに読み取り結果を表示
//オリジナルのプログラムは1行で終わってた
//StringGrid1.Cells[intSG_Col,intSG_Row]:=strAnsList[intSG_k];
//選択肢の0始まりに対応できるようコードを改良
if cmbOneZeroSelect.Text='1' then
begin
StringGrid1.Cells[intSG_Col,intSG_Row]:=strAnsList[intSG_k];
end else begin
if (strAnsList[intSG_k]='99') or (strAnsList[intSG_k]='999') then
begin
StringGrid1.Cells[intSG_Col,intSG_Row]:=strAnsList[intSG_k];
end else begin
strAnsList[intSG_k]:=IntToStr(StrToInt(strAnsList[intSG_k])-1);
StringGrid1.Cells[intSG_Col,intSG_Row]:=strAnsList[intSG_k];
end;
end;
・・・
end;
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;
最後に初期化用画像を読み込んで、1回だけ自動採点を実行する。
//スプラッシュ画面を表示してPython Engineを初期化
try
theSplashForm.Show;
theSplashForm.Refresh
//Scriptを入れるStringList
strScrList := TStringList.Create;
//結果を保存するStringList
strAnsList := TStringList.Create;
try
strScrList.Add('import json');
・・・略(自動採点用のPythonスクリプトをStringListに作成)・・・
//0による浮動小数除算の例外をマスクする
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 部分を「ムダ」だと思う方もいらっしゃるかもしれませんが、「画像の使用権を購入」してまで表示したスプラッシュ画面なので、せめて2秒間だけ!必要以上に長く表示させてください・・・。