function MessageBox(const Text, Caption: PChar; Flags: Longint = MB_OK): Integer;
所有者ウィンドウへのハンドルが確かに省略されている。
実際のコードで、Windows.MessageBox とした場合には･･･
procedure TForm1.Button4Click(Sender: TObject);
begin
Winapi.Windows.MessageBox(Handle, PChar('Do you know Delphi?'), PChar('情報'), MB_OK or MB_ICONINFORMATION);
end;
だったのが、第一引数のHandle は必要なくなり、（ OK ボタンのみの表示でよければ）MB_OK も省略できるようなので、次のように
procedure TForm1.Button3Click(Sender: TObject);
begin
Application.MessageBox(PChar('Do you know Delphi?'), PChar('情報'), MB_ICONINFORMATION);
end;
･･･とずい分、短くなる。それどころか、PChar型への型変換も省略可能なようで･･･
procedure TForm1.Button5Click(Sender: TObject);
begin
Application.MessageBox('Do you know Delphi?', '情報', MB_ICONINFORMATION);
end;
var
strMsg:string;
begin
strMsg:='メッセージ';
Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
end;
別の文字列型変数をさらに代入したり、また、改行を含む表示も、
procedure TForm1.Button2Click(Sender: TObject);
var
strMsg, strPath:string;
begin
strPath:='C:\abc\def';
strMsg:='出力先は次の場所です。' + #13#10 + #13#10 + strPath;
Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
end;
複数のボタンを表示。例えば、「はい」・「いいえ」の二択なら、
procedure TForm1.Button3Click(Sender: TObject);
begin
//Information
if Application.MessageBox(PChar('Do you know Delphi?'), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
begin
//[はい]が選ばれた時
Application.MessageBox(PChar('Gooooooooooooood!'), PChar('情報'), MB_ICONINFORMATION);
end else begin
//[いいえ]が選ばれた時
Application.MessageBox(PChar('No!'), PChar('情報'), MB_ICONINFORMATION);
end;
end;
二択だから「キャンセルはない」 （閉じるボタンは自動的に無効になる）
ユーザーに「キャンセル」も許可するなら、
procedure TForm1.Button4Click(Sender: TObject);
var
StrMsg: String;
intRet: Integer;
begin
StrMsg := 'Do you know Delphi?';
intRet := Application.MessageBox(PChar(StrMsg), PChar('情報'),
MB_YESNOCANCEL or MB_ICONQUESTION);
if intRet = mrYes then begin
//[はい]を選択した時の処理
end else
if intRet = mrNo then begin
//[いいえ]を選択した時の処理
end else
if intRet = mrCancel then begin
//[キャンセル]を選択した時の処理
Application.MessageBox(PChar('ユーザーによる処理のキャンセル'), PChar('情報'), MB_ICONINFORMATION);
end;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
Application.MessageBox('Do you know Delphi?', '情報', MB_OK or MB_RETRYCANCEL or MB_ICONINFORMATION);
end;
2023年11月８日、RAD Studio 12.0（僕にとってはDelphi 12.0）がリリースされた（ようです）。 アップデート・サブスクリプションの支払いを終え（個人で購入しているのは僕くらいだろうが･･･）、届いたメールの製品アップデートリンクをクリックして、最新の更新をチェックしたら、12.0が！
## P4D Installation using [MultiInstaller](https://github.com/pyscripter/MultiInstaller)
Use for Delphi Seattle (10.4) or later to install all packages in one step.
1. Clone or copy the Python4Delphi git repository to a folder of your choice. **The setup.ini file assumes that the folder is called "P4D"**. If you chose to name your folder differently then modify the "Folder" option in setup.ini.
2. Close all Delphi IDEs running.
3. Run MultiInstaller.exe
4. Select the packages you want and press Next
5. In the dialog box specify the _**parent folder**_ of "P4D" (i.e. the folder containing the directory to which you have copied Python4Delphi) and the Delphi target version. Then press Next to install the components
RAD Studio 12.0 対応版のP4D付属 MultiInstaller.exe を起動して表示されるフォルダの選択ダイアログは、前掲の通り。
Browseボタンをクリックして･･･
Compile packages ～の欄には RAD Studio 12 Athens が増えましたが、欄の上下に「まだまだ余裕」があります。これを見て、先ほどの予感は大きく自信を得て･･･「これはつまり、今後数十年以上先までDelphiのメジャーバージョンアップが続々と行われることを見通して、必要十分と思われる余白を予め用意した先見の明溢れる非常に大胆な先進的設計である」という確信に変わりました。
implementation
uses
FMX.Platform, FMX.DialogService;
{$R *.fmx}
procedure TForm1.Button1Click(Sender: TObject);
var
ASyncService:IFMXDialogServiceASync;
begin
//mtConfirmationだとBeep音が鳴らないが、mtInformationだとBeep音が鳴る
if TPlatformServices.Current.SupportsPlatformService (IFMXDialogServiceAsync,
IInterface(ASyncService)) then
begin
TDialogService.MessageDialog('Do you know Delphi?',
TMsgDlgType.mtInformation, [TMsgDlgBtn.mbOK], TMsgDlgBtn.mbOK, 0,
procedure(const AResult: TModalResult)
begin
if AResult = mrOK then
begin
end;
end);
end;
end;
実行すると･･･
ここにたどり着くまで、結構長かった･･･ ほんとに、ようやくって感じ。
調べてわかったことは･･･
var
ASyncService:IFMXDialogServiceASync;
･･･と宣言するためには、
uses
FMX.Platform;
uses に FMX.Platform が必要で、さらに、サポートの有無を調査するif文の･･･
if TPlatformServices.Current.SupportsPlatformService (IFMXDialogServiceAsync,
IInterface(ASyncService)) then
procedure TForm1.MsgDlgProc(const AResult: TModalResult);
begin
//何もしない手続き
end;
応答が「OK」のみの場合は、これを呼び出し。
procedure TForm1.Button2Click(Sender: TObject);
var
ASyncService:IFMXDialogServiceASync;
begin
if TPlatformServices.Current.SupportsPlatformService (IFMXDialogServiceAsync, IInterface(ASyncService)) then begin
TDialogService.MessageDialog('Do you know Delphi?',
TMsgDlgType.mtInformation,
[TMsgDlgBtn.mbOK], TMsgDlgBtn.mbOK, 0, MsgDlgProc);
end;
end;
コードが短くなって、なんとなくすっきりした。
でも、「はい」・「いいえ」・「キャンセル」のようにボタンを複数表示するとそうもいかない。
procedure TForm1.Button3Click(Sender: TObject);
var
ASyncService:IFMXDialogServiceASync;
begin
if TPlatformServices.Current.SupportsPlatformService (IFMXDialogServiceAsync, IInterface(ASyncService)) then
begin
TDialogService.MessageDialog('Do you know Delphi?',
TMsgDlgType.mtInformation, [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo, TMsgDlgBtn.mbCancel], TMsgDlgBtn.mbYes, 0,
procedure(const AResult: TModalResult)
begin
if AResult = mrYes then
begin
ShowMessage('Goooooooood!');
end;
if AResult = mrNo then
begin
ShowMessage('No Good!');
end;
if AResult = mrCancel then
begin
ShowMessage('Cancel');
end;
end);
end;
end;
case文でもよいようだ。
procedure TForm1.Button3Click(Sender: TObject);
var
ASyncService:IFMXDialogServiceASync;
begin
if TPlatformServices.Current.SupportsPlatformService (IFMXDialogServiceAsync, IInterface(ASyncService)) then
begin
TDialogService.MessageDialog('Do you know Delphi?',
TMsgDlgType.mtInformation, [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo, TMsgDlgBtn.mbCancel], TMsgDlgBtn.mbYes, 0,
procedure(const AResult: TModalResult)
begin
case AResult of
mrYes:ShowMessage('Goooooooood!');
mrNo:ShowMessage('No Good!');
mrCancel:ShowMessage('Cancel');
end;
end);
end;
end;
procedure TForm1.Button7Click(Sender: TObject);
var
ASyncService:IFMXDialogServiceASync;
begin
if TPlatformServices.Current.SupportsPlatformService (IFMXDialogServiceAsync, IInterface(ASyncService)) then
begin
TDialogService.MessageDialog('Do you know Delphi?',
TMsgDlgType.mtInformation,[TMsgDlgBtn.mbRetry],TMsgDlgBtn.mbRetry,0,
procedure(const AResult: TModalResult)
begin
case AResult of
mrOK:ShowMessage('OK!：了解');
mrCancel:ShowMessage('Cancel：取消');
mrAbort:ShowMessage('Abort：中止');
mrRetry:ShowMessage('Retry：再試行');
mrIgnore:ShowMessage('Ignore：無視');
mrYes:ShowMessage('Yes：はい');
mrNo:ShowMessage('No：いいえ');
mrClose:ShowMessage('Close：閉じる');
mrHelp:ShowMessage('Help：要援助');
mrAll:ShowMessage('All：すべて');
mrNoToAll:ShowMessage('NoToAll：すべていいえ');
mrYesToAll:ShowMessage('YesToAll：すべてはい');
else
//ないと思うけど、
ShowMessage(IntToStr(AResult));
end;
end);
end;
end;
procedure TForm1.Button9Click(Sender: TObject);
var
ASyncService:IFMXDialogServiceASync;
begin
if TPlatformServices.Current.SupportsPlatformService (IFMXDialogServiceAsync, IInterface(ASyncService)) then
begin
TDialogService.MessageDialog('Do you know Delphi?',
TMsgDlgType.mtInformation, [TMsgDlgBtn.mbOK], TMsgDlgBtn.mbOK, 0,
procedure(const AResult: TModalResult)
begin
case AResult of
mrOK:ShowMessage('OK!：了解');
mrCancel:ShowMessage('Cancel：取消');
mrAbort:ShowMessage('Abort：中止');
mrRetry:ShowMessage('Retry：再試行');
mrIgnore:ShowMessage('Ignore：無視');
mrYes:ShowMessage('Yes：はい');
mrNo:ShowMessage('No：いいえ');
mrClose:ShowMessage('Close：閉じる');
mrHelp:ShowMessage('Help：要援助');
mrAll:ShowMessage('All：すべて');
mrNoToAll:ShowMessage('NoToAll：すべていいえ');
mrYesToAll:ShowMessage('YesToAll：すべてはい');
else
ShowMessage(IntToStr(AResult));
end;
end);
end;
end;
procedure TForm1.btnGetSquareClick(Sender: TObject);
var
//PythonのScriptを入れる
strScrList:TStringList;
//Pythonから送られたデータを保存する -> グローバル変数化
//strAnsList:TStringList;
//Sort
i,j:integer;
//strFileName:string;
strList:TStringList;
//画像の等幅分割
//切り出し領域
top_x, top_y:integer;
yHeight:integer;
//xの増分
xWidth, iMax:integer;
//for Imageの読み込み
sourceImage: PIplImage;
//画像データのファイル名
p1:PAnsiChar;
//x座標の補正
str1, str2, str3, str4:string;
begin
//画像分割処理なし（初期状態）
{
//初期化
Memo1.Clear;
//Scriptを入れるStringList
strScrList:=TStringList.Create;
//結果を保存するStringList
strAnsList:=TStringList.Create;
try
//Python Script
strScrList.Add('import cv2');
strScrList.Add('import numpy as np');
strScrList.Add('from PIL import Image');
//strScrList.Add('img = cv2.imread("./ProcData/sample2.jpg")');
//strScrList.Add('img = cv2.imread(r"'+StatusBar1.SimpleText+'")');
strScrList.Add('pil_img = Image.open(r"'+StatusBar1.SimpleText+'")');
strScrList.Add('img = np.array(pil_img)');
strScrList.Add('gray = cv2.cvtColor(img, cv2.COLOR_BGR2GRAY)');
strScrList.Add('gray = 255 - gray');
strScrList.Add('ret, bin_img = cv2.threshold(gray, 20, 255, cv2.THRESH_BINARY)');
strScrList.Add('contours, hierarchy = cv2.findContours(bin_img, cv2.RETR_LIST, cv2.CHAIN_APPROX_SIMPLE)');
strScrList.Add('contours = list(filter(lambda x: cv2.contourArea(x) > '+cmbThreshold.Text+', contours))');
strScrList.Add('for i in range(len(contours)):');
strScrList.Add(' im_con = img.copy()');
strScrList.Add(' x, y, w, h = cv2.boundingRect(contours[i])');
strScrList.Add(' var1.Value =str(x)+","+str(y)+","+str(x+w)+","+str(y+h)');
//Scriptを表示
Memo1.Lines.Assign(strScrList);
//「０による浮動小数点数除算」のエラーを出ないようにするおまじない
MaskFPUExceptions(True);
//Execute
PythonEngine1.ExecStrings(Memo1.Lines);
//結果を表示
Memo2.Lines.Assign(strAnsList);
finally
//StringListの解放
strAnsList.Free;
strScrList.Free;
end;
}
//画像分割処理ここから
//初期化
//Memo1.Clear;
Memo2.Clear;
MemoTemp.Clear;
//初期化（定数的に利用する）
top_y:=0;
//分割数
iMax:=StrToInt(cmbPartition.Text);
//結果を保存するStringList
strAnsList:=TStringList.Create;
//初期化
xWidth:=0;
try
for i := 0 to iMax-1 do
begin
//画像を読み込む(Bitmap・JPEGどちらも読み込み可能)
p1:=PAnsiChar(AnsiString(StatusBar1.SimpleText));
sourceImage := cvLoadImage(p1, CV_LOAD_IMAGE_ANYDEPTH or CV_LOAD_IMAGE_ANYCOLOR);
//intとTruncは小数点以下を切り捨て。異なるのは、戻り値がintは実数、Truncは整数になること
xWidth:=Trunc(SimpleRoundTo(sourceImage.Width/iMax,0));
yHeight:=sourceImage.Height;
//切り出す座標を指定
top_x:= xWidth * i;
try
//指定範囲の画像を切り出して保存
//cvRect(x, y, Width, Height)
cvSetImageROI(sourceImage,cvRect(top_x, top_y, xWidth, yHeight));
//String 型の文字列を PAnsiChar 型の文字列に変換
//AnsiString 型でキャストして更に PAnsiChar でキャスト
p1:=PAnsiChar(AnsiString('CutImage0'+IntToStr(i)+'.jpg'));
//画像を保存する
cvSaveImage(p1, sourceImage);
finally
//イメージの解放
cvReleaseImage(sourceImage);
end;
end;
for i := 0 to iMax-1 do
begin
//Scriptを入れるStringList
strScrList:=TStringList.Create;
//x座標の補正値を計算
top_x:= xWidth * i;
try
//Python Script
strScrList.Add('import cv2');
strScrList.Add('import numpy as np');
strScrList.Add('from PIL import Image');
//strScrList.Add('img = cv2.imread("./ProcData/sample2.jpg")');
//strScrList.Add('img = cv2.imread(r"'+StatusBar1.SimpleText+'")');
//strScrList.Add('pil_img = Image.open(r"'+StatusBar1.SimpleText+'")');
strScrList.Add('pil_img = Image.open(r"'+'CutImage0'+IntToStr(i)+'.jpg'+'")');
strScrList.Add('img = np.array(pil_img)');
strScrList.Add('gray = cv2.cvtColor(img, cv2.COLOR_BGR2GRAY)');
strScrList.Add('gray = 255 - gray');
strScrList.Add('ret, bin_img = cv2.threshold(gray, 20, 255, cv2.THRESH_BINARY)');
strScrList.Add('contours, hierarchy = cv2.findContours(bin_img, cv2.RETR_LIST, cv2.CHAIN_APPROX_SIMPLE)');
strScrList.Add('contours = list(filter(lambda x: cv2.contourArea(x) > '+cmbThreshold.Text+', contours))');
strScrList.Add('for i in range(len(contours)):');
strScrList.Add(' im_con = img.copy()');
strScrList.Add(' x, y, w, h = cv2.boundingRect(contours[i])');
strScrList.Add(' var1.Value =str(x)+","+str(y)+","+str(x+w)+","+str(y+h)');
//Scriptを表示
Memo1.Clear;
Memo1.Lines.Assign(strScrList);
//「０による浮動小数点数除算」のエラーを出ないようにするおまじない
MaskFPUExceptions(True);
//Execute
PythonEngine1.ExecStrings(Memo1.Lines);
//結果を表示
if RadioButton1.Checked then
begin
//x座標を補正する
MemoTemp.Lines.Assign(strAnsList);
if i<>0 then
begin
for j := 0 to MemoTemp.Lines.Count-1 do
begin
//値を取得
str1:=GetTokenIndex(MemoTemp.Lines[j],',',0);
str2:=GetTokenIndex(MemoTemp.Lines[j],',',1);
str3:=GetTokenIndex(MemoTemp.Lines[j],',',2);
str4:=GetTokenIndex(MemoTemp.Lines[j],',',3);
//カンマ区切りの文字列の1,3番目にtop_x値を加える（座標を修正）
str1:=IntToStr(StrToInt(str1)+top_x);
str3:=IntToStr(StrToInt(str3)+top_x);
//書き戻し
MemoTemp.Lines[j]:=str1+','+str2+','+str3+','+str4;
end;
end;
end else begin
Memo2.Lines.Assign(strAnsList);
end;
finally
//StringListの解放
//strAnsList.Free;
strAnsList.Clear;
strScrList.Free;
end;
//横書きの場合のみ実行
if RadioButton1.Checked then
begin
//strFileName:=ExtractFilePath(StatusBar1.SimpleText)+'Temp.csv';
//MemoTemp.Lines.SaveToFile(strFileName);
strList := TStringList.Create;
try
for j := 0 to MemoTemp.Lines.Count-1 do
begin
strList.Add(MemoTemp.Lines[j]);
end;
//並び替え 降順 -> True
//if RadioButton1.Checked then
//begin
fAscending := False;
fIndex := 1; //２番目の項目を
fStyle := ssInteger; //整数型でソート
strList.CustomSort(MyCustomSort); //ソート開始
//end else begin
// fAscending := True;
// fIndex := 0; //１番目の項目を
// fStyle := ssInteger; //整数型でソート
// strList.CustomSort(MyCustomSort); //ソート開始
//end;
//データ抽出
//Memo2.Clear;
for j := 0 to strList.Count - 1 do
begin
Memo2.Lines.Add(strList[j]);
end;
finally
MemoTemp.Clear;
strList.Free;
end;
end;
end;
finally
//StringListの解放
strAnsList.Free;
end;
//画像分割処理ここまで
//縦書きの場合のみ実行
if RadioButton2.Checked then
begin
//strFileName:=ExtractFilePath(StatusBar1.SimpleText)+'Temp.csv';
//Memo2.Lines.SaveToFile(strFileName);
strList := TStringList.Create;
try
for i := 0 to Memo2.Lines.Count-1 do
begin
strList.Add(Memo2.Lines[i]);
end;
//並び替え 降順 -> True
//if RadioButton2.Checked then
//begin
// fAscending := False;
// fIndex := 1; //２番目の項目を
// fStyle := ssInteger; //整数型でソート
// strList.CustomSort(MyCustomSort); //ソート開始
//end else begin
fAscending := True;
fIndex := 0; //１番目の項目を
fStyle := ssInteger; //整数型でソート
strList.CustomSort(MyCustomSort); //ソート開始
//end;
//データ抽出
Memo2.Clear;
for i := 0 to strList.Count - 1 do
begin
//Memo2.Lines.Add(GetCommaText(strList.Strings[i],fIndex));
Memo2.Lines.Add(strList[i]);
end;
finally
strList.Free;
end;
end;
if RadioButton2.Checked then
begin
ScrollBox1.HorzScrollBar.Position:=ScrollBox1.HorzScrollBar.Range;
end else begin
//ScrollBarが表示されていなくてもエラーにならない
ScrollBox1.HorzScrollBar.Position:=0;
end;
//表示
LBRow.Visible:=True;
LBRow2.Visible:=True;
//操作可能に設定
btnOpen.Enabled:=True;
btnSave.Enabled:=True;
//操作不可に設定
btnGetSquare.Enabled:=False;
//先頭へスクロール
Memo2.Perform(WM_VSCROLL,SB_TOP,0);
//先頭行へ
Memo2.SelStart:=SendMessage(Memo2.Handle, EM_LineIndex, 0, 0);
Memo2.Perform(EM_SCROLLCARET, 0, 0); //キャレット位置までスクロール
Memo2.SetFocus;
GetLinePos;
//矩形を表示
Memo2Click(Sender);
end;
ちなみに、最後の解答欄矩形を表示する処理は･･･
procedure TForm1.Memo2Click(Sender: TObject);
var
i:integer;
//x1,x2,x3,x4:integer;
//y1,y2,y3,y4: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);
//ShowMessage(IntToStr(i));
//エラー対策
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.FormCreate(Sender: TObject);
var
dllFileName:string;
begin
//リソースからDLLを（なければ）生成
dllFileName:=ExtractFilePath(Application.ExeName)+'XXX.dll';
//ファイルの存在を確認
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;
private
{ Private 宣言 }
Setup_FolderPath:string;
Setup_ExeName:string;
implementation
{$R *.dfm}
uses
Winapi.ShlObj, Vcl.FileCtrl, System.UITypes, plShortcutUtils;
//ShlObjはSHGetKnownFolderPath関数を使用するために追加
//ShellExecute関数を使用してフォルダを開いて表示する場合はWinapi.ShellAPIも追加する
//Vcl.FileCtrlは、新しいフォルダ作成ボタン付きフォルダの選択ダイアログの表示に必要
procedure TForm1.btnAutoClick(Sender: TObject);
var
FolderID:TGUID;
FolderPath:PChar;
rsFileName:string;
LDir:String;
begin
//マイドキュメントフォルダへのPathを取得する
FolderID:=StringToGUID('{FDD39AD0-238F-46AF-ADB4-6C85480369C7}');
if SHGetKnownFolderPath(FolderID,0,0,FolderPath)= S_OK then
begin
Setup_FolderPath := FolderPath;
end;
//インストール先フォルダの有無を調査->なければ作成
if not System.SysUtils.DirectoryExists(ExtractFileDir(Setup_FolderPath+'\'+Setup_ExeName+'\')) then
begin
//フォルダ階層を作成
System.SysUtils.ForceDirectories(ExtractFileDir(Setup_FolderPath+
'\'+Setup_ExeName+'\'));
end;
//Path
rsFileName:=Setup_FolderPath+'\'+Setup_ExeName+'\'+Setup_ExeName+'.exe';
//ファイルがある場合は削除
if FileExists(rsFilename) then
begin
//ファイルが存在したときの処理
DeleteFile(rsfileName);
end;
//リソースを再生
with TResourceStream.Create(hInstance, 'Resource_1', RT_RCDATA) do
begin
try
SaveToFile(rsFileName);
finally
Free;
end;
end;
//デスクトップにこのプログラムのショートカットを作成
if CheckCreateShortCut.Checked then
begin
//plShortcutUtilsユニット内の関数類を使用
//CSIDL_DESKTOP等の定数名の使用にはusesにShlObjが必要
//CSIDLの値からフルパスを取得
//ショートカットを作成する場所
LDir := GetDirectoryFromCSIDL(CSIDL_DESKTOP);
if CreateShortCutLink(rsFileName, LDir, Setup_ExeName) then begin
//ショートカットの作成場所によっては，以下のコードで更新が必要
//SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0);
end;
MessageDlg('Done!', mtInformation, [mbOk] , 0);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
FolderID:TGUID;
FolderPath:PChar;
begin
//インストールするEXEの名前
Setup_ExeName:=EditExeName.Text;
//マイドキュメントフォルダへのPathを取得する
FolderID:=StringToGUID('{FDD39AD0-238F-46AF-ADB4-6C85480369C7}');
if SHGetKnownFolderPath(FolderID,0,0,FolderPath)= S_OK then
begin
Setup_FolderPath := FolderPath;
EditPath.Text:= Setup_FolderPath;
end;
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
var
FolderID:TGUID;
FolderPath:PChar;
begin
case RadioGroup1.ItemIndex of
0:begin
//マイドキュメントフォルダへのPathを取得する
FolderID:=StringToGUID('{FDD39AD0-238F-46AF-ADB4-6C85480369C7}');
if SHGetKnownFolderPath(FolderID,0,0,FolderPath)= S_OK then
begin
Setup_FolderPath := FolderPath;
EditPath.Text:= Setup_FolderPath;
end;
end;
1:begin
//マイコンピュータへのPathを取得する
Setup_FolderPath := 'C:\';
EditPath.Text:= Setup_FolderPath;
end;
end;
end;
ちなみに、PCを選択した場合に表示される「フォルダーの参照」ダイアログは･･･
PCのフォルダ構成に詳しい人向きの表示になります･･･
で、インストール先を選ぶ「変更」ボタンをクリックした際の挙動は･･･
procedure TForm1.btnGetPathClick(Sender: TObject);
var
SelectDir: String;
begin
case RadioGroup1.ItemIndex of
0:begin
//フォルダを選択 -> MyDocumentsを指定
//if SelectDirectory('', '::' + GUIDToString(CLSID_MyDocuments), SelectDir) then
//MyDocumentsを指定 -> MyDocumentsを指定 & 新しいフォルダ作成ボタン付き
if SelectDirectory('', '::' + GUIDToString(CLSID_MyDocuments), SelectDir,
[sdNewUI, sdNewFolder, sdShowEdit], Self) then
begin
EditPath.Text:=SelectDir;
Setup_FolderPath:=EditPath.Text;
end;
end;
1:begin
//フォルダを選択 -> を指定
//if SelectDirectory('', '::' + GUIDToString(CLSID_MyComputer), SelectDir) then
//MyMyComputerを指定 -> MyMyComputerを指定 & 新しいフォルダ作成ボタン付き
if SelectDirectory('', '::' + GUIDToString(CLSID_MyComputer), SelectDir,
[sdNewUI, sdNewFolder, sdShowEdit], Self) then
begin
EditPath.Text:=SelectDir;
Setup_FolderPath:=EditPath.Text;
end;
end;
end;
end;
procedure TForm1.btnOKClick(Sender: TObject);
var
rsFileName:string;
LDir:String;
begin
//Path
rsFileName:=Setup_FolderPath+'\'+Setup_ExeName+'.exe';
//ファイルがある場合は削除
if FileExists(rsFilename) then
begin
//ファイルが存在したときの処理
DeleteFile(rsfileName);
end;
//リソースを再生
with TResourceStream.Create(hInstance, 'Resource_1', RT_RCDATA) do
begin
try
SaveToFile(rsFileName);
//MessageDlg('Generate!', mtInformation, [mbOk] , 0);
finally
Free;
end;
end;
//デスクトップにこのプログラムのショートカットを作成
if CheckCreateShortCut.Checked then
begin
//plShortcutUtilsユニット内の関数類を使用
//CSIDL_DESKTOP等の定数名の使用にはusesにShlObjが必要
//CSIDLの値からフルパスを取得
//ショートカットを作成する場所
LDir := GetDirectoryFromCSIDL(CSIDL_DESKTOP);
if CreateShortCutLink(rsFileName, LDir, Setup_ExeName) then begin
//ショートカットの作成場所によっては，以下のコードで更新が必要
//SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0);
end;
MessageDlg('Done!', mtInformation, [mbOk] , 0);
end;
end;
procedure TForm1.chkPWClick(Sender: TObject);
begin
if chkPW.Checked then
begin
EditPW.PasswordChar := #0;
end else begin
EditPW.PasswordChar := '*';
end;
end;
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;
この本「徹底活用ブック」と銘打つだけあって、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;
（３）入力値の保存／読み込みと暗号化
各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('自動クリックするＸ座標を入力してください', mtInformation, [mbOk] , 0);
EditX.SetFocus;
end;
if EditY.Text='' then
begin
MessageDlg('自動クリックするＹ座標を入力してください', 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)Passwordを整数へ変換→シード値１へ代入
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)パスワード文字列の長さを取得→シード値２へ代入
Seed2:= ElementToCharLen(PassW,Length(PassW));
// (3)シード値１とシード値２の排他的論理和を計算して、シード値３へ代入
Seed3 := Seed1 xor Seed2;
//２．実数の一様乱数を計算
//---------------------------------------------------------------------------
// ０より大きく１より小さい実数の一様乱数を発生する関数
// B.A.Wichmann and I.D.Hill, Applied Statistics, 31, 1982, p.188 に基づく
// Seed1-3に入れる初期値（整数）は16bit長(maxint=32767)で十分
// Seed1-3には1から30000までの任意の整数値を準備する(０ではいけない)
//---------------------------------------------------------------------------
//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となるように
//計算結果が０より大きく、１未満の実数に直し、和の小数部分をとる
RandNum:=(Seed1/30269.0) + (Seed2/30307.0) + (Seed3/30323.0);
while RandNum>=1 do RandNum:=RandNum-1;
//３．秘密鍵を生成
//整数の一様乱数の上限値を決めて、整数の一様乱数を生成し、
//これに上で計算した実数の一様乱数を加えて秘密鍵を生成する
//Seedが秘密鍵（文字列として利用）となる
Seed:= FloatToStr(RandNum + trunc((Seed1+Seed2+Seed3)*RandNum));
//４．暗号化 / 復号化
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;
（４）カーソル位置の座標を取得
マウスのカーソルが現在置かれている位置のスクリーン座標を取得して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;
