2021.06.14

Delphiでのコンソール表示について

コンソールアプロケーションであるalphadl ver1.2のバージョンアップに当たり、Delphiでのコンソール表示について少し調べたので備忘録としてメモしておいきます。

 

参考情報は

Microsoft Docsの「コンソール関数(Windows Console)

Mr.XRAYさんの「510_コンソールアプリケーションの作成

です。

 

以下がコンソール表示位置を制御するサンプルプロジェクトとなります。

 

 


program Console_Test;

{$APPTYPE CONSOLE}

{$R *.res}

uses
System.SysUtils,
Windows;


var
i, j, hdrlen, prglen, prg: integer;
hConOut: THandle;
CSBI: CONSOLE_SCREEN_BUFFER_INFO;
CCI: CONSOLE_CURSOR_INFO;
header: string;

begin
SetConsoleTitle('コンソール表示制御のテスト');
hConOut := GetStdHandle(STD_OUTPUT_HANDLE); // コンソール出力のハンドルを取得
GetConsoleScreenBufferInfo(hConOut, CSBI); // スクリーン情報を取得
Writeln('Width = ' + IntToStr(CSBI.dwSize.X)); // 現在のコンソールの幅を表示

GetConsoleScreenBufferInfo(hConOut, CSBI); // スクリーン情報を取得
GetConsoleCursorInfo(hConOut, CCI); // カーソル情報を取得
CCI.bVisible := False; // カーソルを非表示にする
SetConsoleCursorInfo(hConOut, CCI); // カーソル状態を設定する

header := 'Progress:[';
hdrlen := Length(header);
prglen := CSBI.dwSize.X - hdrlen;

// コンソールの幅に合わせて進捗状況のようなものを表示させる
prg := hdrlen + 1;
for i := prg to CSBI.dwSize.X do
begin
SetConsoleCursorPosition(hConOut, CSBI.dwCursorPosition);// カーソル位置を最初に取得した位置にする
Write(header);
for j := hdrlen + 1 to CSBI.dwSize.X - 1 do
begin
if prg <= j then
Write('.')
else
Write('#');
end;
Write(']');
Sleep(20);
Inc(prg);
end;
CCI.bVisible := True; // カーソルを表示する
SetConsoleCursorInfo(hConOut, CCI);
Writeln('');
Write('Hit Any Key :'); // キー入力待ち
Readln;
end.

 

実行しているところ

Contest

 

 

 

| | コメント (0)

2021.05.18

テキストエディタTEAD ver3.xx

DEKOさんがメンテを始めたようです。

Delphi 2007でメンテ中とのことですが、最終的にDelphi10.xにマイグレーションするのかな?

 

 

| | コメント (0)

2020.11.25

DelphiのDLLからクラスのインスタンスを返す

MiBarcodeのVer8.0ではZint Barcode Library for Delphiを用いてのGS1データバー等の作成が出来るようにしたのですが、このZintライブラリがAppach2.0ライセンスとなっていることから、中には使用を溜めらる方もいるのではないかと思い、何とかZintライブラリをMiBarcodeと切り離して使用したい方だけが使用できるようにならないかと考えていました。
そこで、ZintライブラリをDLL化することで、MiBarcodeをインストールする際に必要な方だけがこのDLLのインストールを選択出来るように出来ないかと思ったわけです。
で、DLL側からDLLのコール元であるMiBarcode側に作成されたバーコードをどうやって渡すのかという問題に直面しました。一番簡単なのはDLL側のバーコード作成関数が作成されたMetafileを直接返すことなのですが、これが普通にやろうとするとDLL側で生成したTMetafileのインスタンスがMiBarcode側に返された時点で破棄されてしまうようで中々うまく行かず悩みに悩んだのですが、DLL側でTMetafileのインスタンスをDLLが破棄されるまで保持し続ければ良いことがわかりました。
その方法は、DLL側でTMetafileクラスのインスタンスを宣言するためのユニットを追加して、そのユニットのinitializationでクラスを生成しfinalizationで破棄するというものです。この方法であれば、TMemoryStream等の他のクラスやヒープメモリ等もDLLが読み込まれてから破棄されるまでの間、ずっとそれらを保持し続けるため、DLL側から呼び出し側に問題なくクラス等の戻り値を返すことが出来ます。

MfBuff.pas : DLLで使用するTMetafileクラスの宣言と生成・破棄を行う例

unit MfBuff;

{

DLL側からコール先に対して安全にMetafileの実体を返すために、DLLが起動した際にMetafileの

インスタンスを作成・保持し、DLLが破棄されるタイミングでMetafileのインスタンスを破棄する

ために、そのためだけのユニットを準備してそのinitializationとfinalizationでインスタンス

生成と破棄を行わせる

}



unit MfBuff;



interface



uses

Vcl.Graphics;



var

Mf: TMetafile;



implementation



initialization

// Metafileを準備する

Mf := TMetafile.Create;



finalization

// Metafileを開放する

Mf.Free;



end.


MfDLL.dpr : DLLの関数からTMetafileのインスタンスを返す例


library MfDLL;



uses

Windows,

System.SysUtils,

System.Classes,

Vcl.Graphics,

MfBuff in 'MfBuff.pas';



{$R *.res}



function GetMetafile: TMetafile; stdcall;

var

mc: TMetafileCanvas;

begin

// Metafileのインスタンスを返す一例としてキャンバスに四角を描画してみる

Mf.SetSize(100, 100);

mc := TMetafileCanvas.Create(Mf, GetDC(0)); // 描画キャンバスを準備

try

mc.Brush.Color := clWhite;

mc.Pen.Color := clBlack;

mc.FillRect(Rect(0, 0, 99, 99));

mc.Draw(0, 0, mf); // 描画されたバーコードをコピー

mc.Pen.Width := 2;

mc.MoveTo(1, 1); // 外枠を描画

mc.LineTo(98, 1);

mc.LineTo(98, 98);

mc.LineTo(1, 98);

mc.LineTo(1, 1);

finally

mc.Free;

end;

Result := Mf; // MfBuffユニットで生成したMetafileのインスタンスを返す

end;



exports

GetMetafile;



begin

end.


DLLと呼び出しのサンプルプロジェクト
ダウンロード - mfdllcall.zip

現在、この方法を用いてMiBarcode本体からZint Barcode Libraryを切り離してDLL化して、Zintライブラリを使用したくない場合はインストール時に選択出来るようにすべく作業中です。この作業が終わった段階で正式アップデート版としてリリースします。

#ココログの編集を「通常エディタ≒テキストモード」で行っても、保存する段階で変な整形が入って中々思った通りの結果にならずイラッとします。
#やっぱり引っ越しを考えたほうがいいのかも・・・

| | コメント (0)

2020.06.12

残念!Mr.XRAYさんの喫茶XRAY閉鎖

Mr.XRAYさんのところの掲示板「喫茶XRAY」が読み出し専用となりました。

喫茶XRAYの運営、長い間お疲れさまでした。

 

それにしても、Windows95時代からお付き合いのあった、主にDelphiやC++Builder使いのフリーソフト作者の方々も、ホームページが無くなったり音信が途絶えたりといったことが多くて、ますます寂しくなりました(当時のNifty Serveがホームページサービスを切り替えた際にそのままホームページが消滅してしまった方々が多かったように記憶しています)。

私はMS-DOS上でTurbo C 2.0を使用していた頃、1200bpsのモデム接続でのパソコン通信からのネット民スタートですので、もう随分とネット環境の片隅にいますが、まだ当分の間はこのままずるずるだらだらと活動を続けようかと思っています。

 

 

| | コメント (0)

2020.04.20

Delphi IDE Theme Editorについて

ふとした切っ掛けでDelphi IDE Theme EditorというDelphiのIDEエディタ色を変更するオープンソースのソフトウェアのことを知りました(私が知らなかっただけかも)。

Themeeditor

この色テーマエディタには気に入ったテーマを探し出すのがものすごく大変なくらいの数のプリセットテーマが用意されていて、気に入ったテーマを選んで、[Installed IDEs]で選んだテーマを適用させたいDelphiのバージョンを選択して左下の[Apply Theme]ボタンを押せばOKです。
また、テーマ変更の前に現在のエディタ色セットを[Menu]の[Import Current IDE Theme from Registry]でプリセットテーマの一つとして取り込むことも出来ます。

尚、Lazarus2.0.8も[Installed IDEs]の一覧に出てきます。
ただし、Lazarusにテーマを適用したところ、色は問題なく適用されましたが、予約語等の一部の設定が太字になってしまう不具合があるようです。まぁ、Lazarus側の設定で簡単に修正できますので、大した問題ではないと思います。ちなみに、Lazarusからはテーマのインポートは出来ないようです。

Delphi IDE Theme Editorのプロジェクトページ

Delphi IDE Theme Editor実行ファイルのインストーラー

| | コメント (0)

2019.09.01

バーコード作成ライブラリ;Zint Barcode Generator for Delphiについて

Zint Barcode Generator for Delphi(以降Zint-Dと略)は50以上の手法を含むバーコードエンコーディングライブラリであるZint Barcode GeneratorをDelphi/Lazarus用に移植したライブラリです。
Zint-Dはとても機能が豊富な反面あまり扱いやすいとは言えないため、今回MiBarcodeに実装するために最低限の機能に絞ったラッパークラスを作成しましたので参考にアップしておきます。

 

ZintLibClassを使用したサンプル

 

 

Zintlib_20190901082801

 

ラッパークラスとサンプルプロジェクトのダウンロード - zintlibclass.zip

 

 

 

 

| | コメント (2)

2018.07.21

Delphi Community Edition

EmbarcaderoからC++Builder/Delphi Comunity Editionがリリースされています。機能的にはProfessional Editionと同等となっているようです。
公式ページではMacOSやいOS, Android向けのマルチプラットホームがアピールされていますが、個人的には64bit Windows用のアプリケーションも作成出来るようになったことが嬉しいところです(まぁ絶対に必要というわけでもないのですが)。
尚、一番嬉しいことはデバッグ時に変数の中身をツールチップ表示出来るようになったことです。Delphi/C++Builderには元々この機能はあったのですが、Starter Editionでは削られていたためデバッグ時の変数内容確認がとても不便でした。
Debugtips

昔Delphi XE2まで使用していたProfessional版では当たり前だったデバッグ作業に対して、Startter Editionでは若干の苦痛を伴っていましたが、これで昔ながらのやり方が出来るようになってDelphiでのデバッグ作業が楽になりそうです。

#ただ気になるのはCommunity Editionのライセンスが1年間となっていて、今の所は1年後に更新出来るようになっているようではあるものの、Embarcaderoの方針変更で1年後(もしくは数年後)には使用出来なくなったりしないかということでしょうか。
#まぁその時はLazarusで頑張るという手もあるのですが・・・

| | コメント (0) | トラックバック (0)

2018.03.10

Indy(IdSMTP)を用いた添付ファイル付きメール送信

SimpleNovelDownloaderに、作成したKindle用mobiファイルを自動的にSend-To-Kindleでxxxxxx@kindle.comにエール送信してしまえば後から手動でいちいち作成したmobiファイルを添付してメール送信する手間が無くなると思い立ち、DelphiでIndyのIdSMTPを用いたメール送信機能を追加することにしました。

ということで早速実装してみたものの、通常のメールアドレスに対して送信する分には添付ファイルも含めて受信出来るものの、xxxx@kindle.comに送信すると「ファイル未添付のお知らせ」メールが帰ってくるという問題が発生し、しばらく悩みました。
その結果、メールソフトを使用してmobiファイルを添付してxxxx@kindle.comに送信する場合には件名と本文がなくても問題ないが、IdSMTPを用いる場合にはネット上で紹介されている一般的な?方法(TIdAttachmentFile.Createを使用して添付ファイルを追加する)を用いた場合、件名と本文がないと「ファイル未添付のお知らせ」となる。また、件名と本文を指定しても成功する場合と失敗する場合があるようだ、ということが判りました。

で、更にネット上で調べたところ、TIdMessageBuilderを使用してメール本文と添付ファイルを追加する方法があることが判り、この方法を用いて件名と本文を追加した状態でxxxx@kindle.comに送信すると安定してmobiファイルをSend-To-Kindle出来ることが確認出来ました。
また、OpenSSLを使用したSSL接続を用いる場合に、ネット上で紹介されているIdSMTP1.UseTL := utUseExplicitTLSではうまくいかないことも判りました。

で、テスト用に作成したものが以下となります。また、一番下にサンプルプロジェクトソースも置いておきます。
Smtptest

// IdSMTPで添付ファイルを含めたメール送信を行うための一般的な方法
// DEKOさんのところのちっぷす(https://ht-deko.com/tech040.html)等で紹介されて
// いる方法
// Send-To-Kindleでhoge@kindle.comに添付ファイルを送信する場合は、Subjectと
// Body.Textが空だと必ず失敗して「ファイル未添付のお知らせ」メールが帰ってくる
procedure TForm1.Button3Click(Sender: TObject);
var
  pt: integer;
begin
	pt									:= StrToInt(SMTPPort.Text);
  IdSMTP1.Host     		:= SMTPServer.Text;
  IdSMTP1.Port     		:= StrToInt(SMTPPort.Text);
  IdSMTP1.Username 		:= SMTPUser.Text;
  IdSMTP1.Password 		:= SMTPPassw.Text;
	// SSL接続時:OpenSSL(https://www.openssl.org/)のインストールが必要
	if UseSSL.Checked then
  begin
    SSL1.Host 				:= IdSMTP1.Host;
    SSL1.Port 				:= IdSMTP1.Port;
    SSL1.Destination  := SSL1.Host + ':' + IntToStr(SSL1.Port);
    IdSMTP1.IOHandler := SSL1;
    // SSLを使用する場合、DEKOさんのちっぷすや他の情報ではUseTLS := utUseExplicitTLS
    // としているが、これでは失敗する
    // 以下の情報を元に、ポートが465の場合にはUseTLS := utUseImplicitTLSとすると
    // うまくいく
		// https://stackoverflow.com/questions/7037929/using-gmails-outgoing-smtp-from-delphiindy-using-tls
    if pt = 465 then
    	IdSMTP1.UseTLS 	:= utUseImplicitTLS
    else
    	IdSMTP1.UseTLS 	:= utUseExplicitTLS;
	end else begin
    IdSMTP1.IOHandler := nil;
    IdSMTP1.UseTLS 	  := utNoTLSSupport;
  end;
 
  try
  	IdMsg.OnInitializeISO           := IdMessage_InitializeISO;
  	IdMsg.ContentType             	:= 'multipart/mixed';
  	IdMsg.CharSet                   := 'UTF-8';
  	IdMsg.ContentTransferEncoding   := 'BASE64';
  	IdMsg.From.Name                 := SenderName.Text;
  	IdMsg.From.Address              := MailAddr.Text;
  	IdMsg.Recipients.EMailAddresses := DestAddr.Text;
  	IdMsg.Subject                 	:= UTF8Encode(MailSubject.Text);
  	IdMsg.Body.Text                 := UTF8Encode(MailBody.Text);
    IdMsg.ConvertPreamble						:= True;
    // 複数のファイルを添付する場合はこれを繰り返す
  	with TIdAttachmentFile.Create(IdMsg.MessageParts, Attached.Text) do
    begin
  		FileName 		:= UTF8Encode(ExtractFileName(Attached.Text));
  		ContentType	:= 'application/octet-stream';
    end;
 
   	IdSMTP1.Connect;

IdSMTP1.Send(IdMsg);

except on E:Exception do
MessageDlg('ERROR: ' + E.Message, mtError, [mbOK], 0);
end;
IdSMTP1.Disconnect;
end;

// IdSMTPでTIdMessageBuilderPlain使用を使用した添付ファイルを含めたメール送信
// Send-To-Kindleでhoge@kindle.comに添付ファイルを送信する場合は、この方法の方が
// 安定しているようだ(SubjectとBody.Textが空だと失敗する場合がある)
procedure TForm1.Button1Click(Sender: TObject);
var
Bldr: TIdMessageBuilderPlain;
pt: integer;
begin
pt := StrToInt(SMTPPort.Text);
IdSMTP1.Host := SMTPServer.Text;
IdSMTP1.Port := pt;
IdSMTP1.Username := SMTPUser.Text;
IdSMTP1.Password := SMTPPassw.Text;
// SSL接続時:OpenSSL(https://www.openssl.org/)のインストールが必要
if UseSSL.Checked then
begin
SSL1.Host := IdSMTP1.Host;
SSL1.Port := IdSMTP1.Port;
SSL1.Destination := SSL1.Host + ':' + IntToStr(SSL1.Port);
IdSMTP1.IOHandler := SSL1;
// SSLを使用する場合、DEKOさんのちっぷすや他の情報ではUseTLS := utUseExplicitTLS
// としているが、これでは失敗する
// 以下の情報を元に、ポートが465の場合にはUseTLS := utUseImplicitTLSとすると
// うまくいく
// https://stackoverflow.com/questions/7037929/using-gmails-outgoing-smtp-from-delphiindy-using-tls
if pt = 465 then
IdSMTP1.UseTLS := utUseImplicitTLS
else
IdSMTP1.UseTLS := utUseExplicitTLS;
end else begin
IdSMTP1.IOHandler := nil;
IdSMTP1.UseTLS := utNoTLSSupport;
end;

try
IdMsg.OnInitializeISO := IdMessage_InitializeISO;
// ファイルを添付する場合、multipart/mixedの指定が必要
IdMsg.ContentType := 'multipart/mixed';
IdMsg.CharSet := 'UTF-8';
IdMsg.ContentTransferEncoding := 'BASE64';
IdMsg.From.Name := SenderName.Text;
IdMsg.From.Address := MailAddr.Text;
IdMsg.Recipients.EMailAddresses := DestAddr.Text;
IdMsg.Subject := UTF8Encode(MailSubject.Text);

Bldr := TIdMessageBuilderPlain.Create;
try
Bldr.PlainTextCharSet := 'UTF-8';
// メール本文
Bldr.PlainText.Text := UTF8Encode(MailBody.Text);
// 添付ファイル(複数のファイルを添付する場合はひとつづつAddする)
Bldr.Attachments.Add(Attached.Text);
// まとめてIdMessageにセットする
Bldr.FillMessage(IdMsg);
finally
// IdMessageにセットした後はBldrを開放する
Bldr.Free;
end;

IdSMTP1.Connect;

IdSMTP1.Send(IdMsg);

except on E:Exception do
MessageDlg('ERROR: ' + E.Message, mtError, [mbOK], 0);
end;
IdSMTP1.Disconnect;
end;


「idsmtpsample.zip」をダウンロード


| | コメント (3) | トラックバック (0)

2018.01.31

SaveDialogを拡張してコントロールを追加する(その3:補足)

> 何かもっとやり方があるのではないかと思ったりもするのですが
と言っていましたが、以下のようにComboBoxをひとつだけにしたところ、ラベルの色が黒になったことも含めてWindowsメモ帳の名前をつけて保存ダイアログと同じになりました。
アクセラレータキー(&E)もきちんと反応しますので、この方法がWindowsメモ帳でのファイルダイアログ拡張と同じ方法なのだと思います。

Dialog3



// IFileDialogCustomizeをサポートするかどうか問い合わせる
if Supports(FileSaveDialog1.Dialog, IFileDialogCustomize, Fdc) then
begin
// 返されたFileSaveDialog1のIFileDialogCustomizeインターフェイスに対して
// コントロールを追加する
//
// AddTextでラベルを追加すると文字が青色になることとComboBoxとのレイアウト
// が思うようにならないため、StartVisualGroupでラベルと追加する(色はグレーだけど)
Fdc.StartVisualGroup(dwIDCtl, '文字コードセット(&E):');
Fdc.AddComboBox(dwIDCtl + 1);
Fdc.AddControlItem(dwIDCtl + 1, 0, 'Shift-JIS'); // ComboBoxにアイテムを追加する
Fdc.AddControlItem(dwIDCtl + 1, 1, 'JIS');
Fdc.AddControlItem(dwIDCtl + 1, 2, 'EUC-JP');
Fdc.AddControlItem(dwIDCtl + 1, 3, 'Unicode(Little Endian)');
Fdc.AddControlItem(dwIDCtl + 1, 4, 'Unicode(Big Endian)');
Fdc.AddControlItem(dwIDCtl + 1, 5, 'UTF-8');
Fdc.AddControlItem(dwIDCtl + 1, 6, 'UTF-8N');
Fdc.SetSelectedControlItem(dwIDCtl + 1, 0); // 0番目を選択
Fdc.EndVisualGroup;

Fdc.MakeProminent(dwIDCtl + 0); // 上記で登録したコントロールをメイン指定する
Fdc.MakeProminent(dwIDCtl + 1); // この指定を行ったコントロールは「保存(開く)ボタン」の左側に配置されるが、配置出来るのはひとつだけ

// イベントを登録(ボタンが押された等のイベントを処理しない場合は以下の登録は
// しなくても良いようだ)
fdevt := TMyFileDialogEvents.Create;
if Succeeded(FileSaveDialog1.Dialog.Advise(fdevt, cookie)) then
begin
FileDialog := FileSaveDialog1.Dialog;
MyEvents := fdevt;
MyEventsCookie := cookie;
end;
end;

追加検索キーワード
ファイルダイアログのカスタマイズ
コモンダイアログのカスタマイズ

| | コメント (0) | トラックバック (0)

2018.01.29

SaveDialogを拡張してコントロールを追加する(その3:完結編)

Delphiで出来ないとあんまり意味がないんですけどね。と言っていましたが、ついに情報を見つけました。
情報元はMSDNのIFileDialogCustomize::GetSelectedControlItem method、stackoverflowのAdd a IFileDialogCustomize PushButton Eventです。

結論から言いますと、今までノーマークだったコンポーネントパレット[Vista Dialog]のTFielOpenDialogとTFileSaveDialogが答えでした。これらのコンポーネントはWindows Vistaで変更されたファイルダイアログをサポートするためのもののようですが、追加するラベルの文字色も青色になる等、前の記事で書いたC#でCommonOpenFileDialogを使用する場合と同じような感じになるようです。
それにしても、Windows7以降ではコンポーネントパレット[Dialogs]にあるTOpenDialogとTSaveDialogを使用しても同じダイアログボックスが表示されるため、通常はVista DIalogを使用する機会はないものと思われます(私も今まで使ったことがありませんでした)。

で、コントロールの追加の仕方ですが、Delphi標準のファイルダイアログコンポーネントにはないOnExecuteイベントにコントロールを追加する処理を書いて、Executeした後にそれらのコントロールのステータスを確認する処理を追加すれは良いようです。尚、ボタン等の動作イベントを発生するコントロールを追加して、ファイルダイアログが開いたままの状態でそれらのイベントを処理する場合には、OnExecuteでイベント処理を追加して処理させることが出来るようです。一応stackoverflowのQ&Aに記載されているTMyFileDialogEventsユニットを追加していますが、サンプルでは使用していませんのできちんと動作するのかどうかは不明です。

以下がサンプルソースコードになります。

unit DialogTestUnit;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls, ShlObj;

type
TForm1 = class(TForm)
Button1: TButton;
FileSaveDialog1: TFileSaveDialog;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FileSaveDialog1Execute(Sender: TObject);
private
{ Private 宣言 }
Fdc: IFileDialogCustomize;
public
{ Public 宣言 }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses
MyFileDialogEvents;

var
FileDialog: IFileDialog = nil;
MyEvents: IFileDialogEvents = nil;
MyEventsCookie: DWORD = 0;

const
dwIDCtl = 19000;

procedure TForm1.FileSaveDialog1Execute(Sender: TObject);
var
fdevt: IFileDialogEvents;
cookie: DWORD;
begin
inherited;

// IFileDialogCustomizeをサポートするかどうか問い合わせる
if Supports(FileSaveDialog1.Dialog, IFileDialogCustomize, Fdc) then
begin
// 返されたFileSaveDialog1のIFileDialogCustomizeインターフェイスに対して
// コントロールを追加する
//
// AddTextでラベルを追加すると文字が青色になることとComboBoxとのレイアウト
// が思うようにならないため、StartVisualGroupでラベルと追加する(色はグレーだけど)
Fdc.StartVisualGroup(dwIDCtl, PWideChar('文字コードセット:'));
Fdc.AddComboBox(dwIDCtl + 1);
Fdc.AddControlItem(dwIDCtl + 1, 0, 'Shift-JIS'); // ComboBoxにアイテムを追加する
Fdc.AddControlItem(dwIDCtl + 1, 1, 'JIS');
Fdc.AddControlItem(dwIDCtl + 1, 2, 'EUC-JP');
Fdc.AddControlItem(dwIDCtl + 1, 3, 'Unicode(Little Endian)');
Fdc.AddControlItem(dwIDCtl + 1, 4, 'Unicode(Big Endian)');
Fdc.AddControlItem(dwIDCtl + 1, 5, 'UTF-8');
Fdc.AddControlItem(dwIDCtl + 1, 6, 'UTF-8N');
Fdc.SetSelectedControlItem(dwIDCtl + 1, 0); // 0番目を選択
Fdc.EndVisualGroup;

Fdc.StartVisualGroup(dwIDCtl + 2, PWideChar('改行コード:'));
Fdc.AddComboBox(dwIDCtl + 3);
Fdc.AddControlItem(dwIDCtl + 3, 0, 'CR+LF'); // ComboBoxにアイテムを追加する
Fdc.AddControlItem(dwIDCtl + 3, 1, 'CR');
Fdc.AddControlItem(dwIDCtl + 3, 2, 'LF');
Fdc.SetSelectedControlItem(dwIDCtl + 3, 0); // 0番目を選択
Fdc.EndVisualGroup;

// イベントを登録(ボタンが押された等のイベントを処理しない場合は以下の登録は
// しなくても良いようだ)
fdevt := TMyFileDialogEvents.Create;
if Succeeded(FileSaveDialog1.Dialog.Advise(fdevt, cookie)) then
begin
FileDialog := FileSaveDialog1.Dialog;
MyEvents := fdevt;
MyEventsCookie := cookie;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
id1, id2: DWORD;
s1, s2: string;
begin
FileDialog := nil;
MyEvents := nil;
MyEventsCookie := 0;

if FileSaveDialog1.Execute then
begin
// dwIDCtl + 1のComboBoxのItemIndexを取得する
Fdc.GetSelectedControlItem(dwIDCtl + 1, id1);
// dwIDCtl + 3のComboBoxのItemIndexを取得する
Fdc.GetSelectedControlItem(dwIDCtl + 3, id2);
case id1 of
0: s1 := 'Shift-JIS';
1: s1 := 'JIS';
2: s1 := 'EUC-JP';
3: s1 := 'Unicode(Little Endian)';
4: s1 := 'Unicode(Big Endian)';
5: s1 := 'UTF-8';
6: s1 := 'UTF-8N';
end;
case id2 of
0: s2 := 'CR+LF';
1: s2 := 'CR';
2: s2 := 'LF';
end;
Label1.Caption := s1 + ' (' + s2 + ')';
if (FileDialog <> nil) and (MyEventsCookie <> 0) then
FileDialog.Unadvise(MyEventsCookie);
FileDialog := nil;
MyEvents := nil;
MyEventsCookie := 0;
end;
end;

end.



「SaveDialogを拡張してコントロールを追加する」の最初の記事ではテンプレートを用いた拡張を行うため、TSaveDialogを継承したコンポーネントにしましたが、今回の例ではTFileSaveDialogの標準イベントOnExecuteにコントロールを追加するための処理を追加するだけですので、わざわざコンポーネント化する必要もないのかと思いました。
それにしても、C#ではNuGetでパッケージライブラリを追加する必要があったのですが、Delphiでは標準の状態でファイルダイアログを拡張することが出来ちゃいましたと言う事でした。
まぁ、ラベルテキストの文字色が青色だったり、追加するコントロールのレイアウトをうまく設定出来なかったりと、何かもっとやり方があるのではないかと思ったりもするのですが、これで(私としては)機能的には充分なので取り敢えずは完結で良いかなと思った次第です。

テキストをAddTextで追加した場合・・・文字が青色になり、ComboBoxがその下に配置される。
Dialog2

テキストをStartVisualGroupで追加し、ComboBox追加後にEndVisualGroupした場合・・・文字色は灰色となり、ComboBoxはその右側に配置される。
Dialog1


まぁ、お好みなのでしょうが、個人的には後の例の方がイメージに合うかなという感じです。

#追加情報や違ったやり方があるよという方は、コメントに書き込んでいただけると嬉しいです。
#て言いますか、Mr. X-RAYさんの所のダイアログ関連でまとめてくれないかな(他力本願)・・・


サンプルプロジェク「FileDialogTest.zip」をダウンロード

| | コメント (2) | トラックバック (0)