Delphi Tips
>> Index
● 02/08 リソースにあるバージョン情報を取得したい。
● 09/25 TSaveDialogでファイルタイプが変更されたらファイル拡張子を変更したい
● 09/24 TOpenDialog(TSaveDialog) の初期フォルダをシステムフォルダ(デスクトップなど)に設計する
● 09/24 TOpenDialogで、Executeメソッド実行時に表示位置を変えたい。
● 09/23 TOpenDialogが表示された時のフォーカスを変えたい。
● 09/13 TFontDialog で標準以外のサイズを選択肢に表示したい
● 09/06 メッセージボックスを独自にカスタマイズしたものを使いたい。
● 09/06 メッセージボックスのデフォルトボタンを変えたい
● 09/02 Windowsの「ファイルの検索」ダイアログをプログラムから使いたい
● 02/08 OpenDialogでたくさんファイルを選択するとエラー
● 02/08 「システムエラー 読み出せません ドライブ X:」ダイアログを回避する
● 02/08 Windowsの「ファイルの検索ダイアログ」を表示させる
最終更新: 7226 日前
0226 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/08/29 西坂良幸 rev 1.5 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 2005/02/08 <> 編集
リソースにあるバージョン情報を取得したい。
Delphiのメニュー[プロジェクト|オプション]のバージョン情報ページのデータはリソースとして製作したアプリケーションの EXE ファイルの中にあります。バージョン情報ダイアログのバージョン番号は、是非このリソースの内容を反映させたいですね。
この方法は、多くの書物に書かれているようですが、ML でも多い話題です。
自作のダイアログをつくり、リポジトリに登録しておきましょう。
コンポーネント化するのもひとつの方法です。
VerQueryValue 関数の第二パラメータに、 '\' をつかって バージョン番号を取得する方法は [Delphi-ML:31478] で紹介しています。
ここでは、すべてのバージョン情報を取得する関数を紹介します。
type
TVerResourceKey = (
vrComments, // コメント
vrCompanyName, // 会社名
vrFileDescription, // 説明
vrFileVersion, // ファイルバージョン
vrInternalName, // 内部名
vrLegalCopyright, // 著作権
vrLegalTrademarks, // 商標
vrOriginalFilename, // 正式ファイル名
vrPrivateBuild, // プライベートビルド情報
vrProductName, // 製品名
vrProductVersion, // 製品バージョン
vrSpecialBuild); // スペシャルビルド情報
const
KeyWordStr: array [TVerResourceKey] of String = (
'Comments',
'CompanyName',
'FileDescription',
'FileVersion',
'InternalName',
'LegalCopyright',
'LegalTrademarks',
'OriginalFilename',
'PrivateBuild',
'ProductName',
'ProductVersion',
'SpecialBuild');
// バージョン情報を取得
function GetVersionInfo(KeyWord: TVerResourceKey): string;
const
Translation = '\VarFileInfo\Translation';
FileInfo = '\StringFileInfo\%0.4s%0.4s\';
var
BufSize, HWnd: DWORD;
VerInfoBuf: Pointer;
VerData: Pointer;
VerDataLen: Longword;
PathLocale: String;
begin
// 必要なバッファのサイズを取得
BufSize := GetFileVersionInfoSize(PChar(Application.ExeName), HWnd);
if BufSize <> 0 then
begin
// メモリを確保
GetMem(VerInfoBuf, BufSize);
try
GetFileVersionInfo(PChar(Application.ExeName), 0, BufSize, VerInfoBuf);
// 変数情報ブロック内の変換テーブルを指定
VerQueryValue(VerInfoBuf, PChar(Translation), VerData, VerDataLen);
if not (VerDataLen > 0) then
raise Exception.Create('情報の取得に失敗しました');
// 8桁の16進数に変換
// →'\StringFileInfo\027382\FileDescription'
PathLocale := Format(FileInfo + KeyWordStr[KeyWord],
[IntToHex(Integer(VerData^) and $FFFF, 4),
IntToHex((Integer(VerData^) shr 16) and $FFFF, 4)]);
VerQueryValue(VerInfoBuf, PChar(PathLocale), VerData, VerDataLen);
if VerDataLen > 0 then
begin
// VerDataはゼロで終わる文字列ではないことに注意
result := '';
SetLength(result, VerDataLen);
StrLCopy(PChar(result), VerData, VerDataLen);
end;
finally
// 解放
FreeMem(VerInfoBuf);
end;
end;
end;
// テスト
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := GetVersionInfo(vrFileVersion);
Label2.Caption := GetVersionInfo(vrLegalCopyright);
end;
参照: [Delphi-ML:31478] [Delphi-ML:37794] <アプリケーション> <開発環境>
0122 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/02/08 osamu rev 1.4 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/25 西坂良幸 編集
TSaveDialogでファイルタイプが変更されたらファイル拡張子を変更したい
Excelなどの「名前を付けて保存」でしているように 選択されたファイルタイプに応じて拡張子の部分を変更したいのですが。
TSaveDialogをはりつけて、Filterプロパティを以下のようにしたとします.
Filter -> 'テキストファイル(*.txt)|*.txt|アイコンファイル(*.ico)|*.ico|カンマテキスト(*.csv)|*.csv|'
uses Dlgs,Commdlg;
procedure TForm1.SaveDialog1TypeChange(Sender: TObject);
var
DlgParent: HWND;
StrFileName, StrExt: string;
begin
DlgParent := GetParent(TSaveDialog(Sender).Handle);
Case SaveDialog1.FilterIndex of
2: StrExt := '*.ico';
3: StrExt := '*.csv';
else StrExt := '*.txt';
end;
StrFileName := ChangeFileExt(TSaveDialog(Sender).FileName, StrExt);
SendMessage(DlgParent, CDM_SETCONTROLTEXT, Edt1, Longint(PChar(StrFileName)));
end;
// テスト
procedure TForm1.Button1Click(Sender: TObject);
begin
SaveDialog1.Execute;
Label1.Caption := SaveDialog1.FileName;
end;
Filterを切り分けて、Filterindexに拡張子をセットする処理ルーチンは省略していますが、やり方はわかると思います。
参照: [Delphi-ML:38586] [builder:7802]
0271 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/09/23 西坂良幸 rev 1.4 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/24 K.Takaoka 編集
TOpenDialog(TSaveDialog) の初期フォルダをシステムフォルダ(デスクトップなど)に設計する
TOpenDialog はデフォルトで Windows95 であればカレントディレクトリ, WindowsNT であればホームディレクトリ, Windows98 であればパーソナルディレクトリを表示します.
InitialDir プロパティにディレクトリ名を設定すれば変更できますが, システムフォルダの場所は一定ではないので実行時に指定する必要が出てしまいます.
# システムフォルダの位置を知るには API と CLSID 定数を利用します.
# その方法については [Tips:196] を参照してください.
これらのフォルダを設計時に設定することができます.
CLSID の値に :: をつけたもの, たとえば
::{20D04FE0-3AEA-1069-A2D8-08002B30309D}
などを InitialDir プロパティに設定します.
この値の一覧は Delphi の ShellAPI Unit や [Tips:196] にあります.
参照: [Delphi-ML:9689] [Delphi-ML:39628] [Tips:196]
0141 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/02/11 osamu rev 1.3 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/24 西坂良幸 編集
TOpenDialogで、Executeメソッド実行時に表示位置を変えたい。
TOpenDialogは、OnShowイベントの段階では、位置がすでに決まっているようです。調べてみると、何回かWM_NOTIFYが送られますが、NMHDR構造体のCodeメンバーがCDN_INITDONEになるダイアログの初期化時を捕まえるとうまくいくようです。(ただし、これでも最初のExecute時しか効果ありません。D4のみ?)
以下のような拡張ダイアログコンポが紹介されています。
// 定義部
type
TQueryDlgPosEvent = procedure(Sender: TObject; var pt: TPoint) of object;
ThtOpenDialogEx = class(TOpenDialog)
private
FQueryDlgPos: TQueryDlgPosEvent;
protected
procedure DefaultHandler(var Message); override;
procedure DoQueryDlgPos; virtual;
published
property OnQueryDlgPos: TQueryDlgPosEvent read FQueryDlgPos write FQueryDlgPos;
end;
// 実装部n
procedure ThtOpenDialogEx.DefaultHandler(var Message);
begin
inherited;
with TWMNotify(Message) do
if (Msg = WM_NOTIFY) then
if (NMHdr^.Code = CDN_INITDONE) then
DoQueryDlgPos;
end;
procedure ThtOpenDialogEx.DoQueryDlgPos;
var
DlgHandle: THandle;
Rect: TRect;
pt: TPoint;
begin
if Assigned(FQueryDlgPos) then
begin
DlgHandle := GetParent(Handle);
GetWindowRect(DlgHandle, Rect);
pt.x := (GetSystemMetrics(SM_CXSCREEN) - Rect.Right + Rect.Left) div 2;
pt.y := (GetSystemMetrics(SM_CYSCREEN) - Rect.Bottom + Rect.Top) div 3;
FQueryDlgPos(Self, pt);
SetWindowPos(DlgHandle, HWND_TOP, pt.X, pt.Y, 0, 0,
SWP_NOSIZE or SWP_NOZORDER);
end;
end;
// テスト
procedure TForm1.Button1Click(Sender: TObject);
var
OpenDialogEx:ThtOpenDialogEx;
begin
OpenDialogEx:=ThtOpenDialogEx.Create(self);
try
with OpenDialogEx do
begin
OnQueryDlgPos := QueryDlgPos;
Execute;
end;
finally
OpenDialogEx.Free;
end;
end;
procedure TForm1.QueryDlgPos(Sender: TObject; var pt: TPoint);
begin
Pt.x := 800;
pt.y := 600;
end;
追記:
DefaultHandlerメソッドのかわりに、WndProcメソッドをオーバーライドしてもほぼ同じ結果が得られます。
以下は、イベントの代わりに、InitialLeft, InitialTop、というプロパティを設定しています。
procedure ThtOpenDialogEx.WndProc(var Message: TMessage);
var
DlgHandle: THandle;
begin
inherited WndProc(Message);
if (Message.Msg = WM_NOTIFY) then
if (TWMNOTIFY(Message).NMHdr^.Code = CDN_INITDONE)
and not ((FInitialLeft < 0) or (FInitialTop < 0)) then
begin // 負数のときは処理しない
DlgHandle := GetParent(Handle);
SetWindowPos(DlgHandle, 0, FInitialLeft, FInitialTop, 0, 0, SWP_NOSIZE or SWP_NOZORDER);
end;
end;
参照: [Delphi-ML:12600] [Delphi-ML:24640] <Dialogs> <コンポーネント >
0016 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/02/08 osamu rev 1.3 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/23 西坂良幸 編集
TOpenDialogが表示された時のフォーカスを変えたい。
TOpenDialogは、ダイアログを開いたとき最初のフォーカスは、ファイル名になっています。
TabOrderは、ファイル名(Edit)->ファイルの種類(ComboBox)->
>それを、上下キーで指定のフォルダから選択できるように、開く(Button)->キャンセル(Button)->ファイル場所(ComboBox)->選択リスト(ListView)の順です。
たとえば、選択リスト(ListView)にフォーカスをおく場合は、
OpenDialogのOnShowイベントで以下のようにすればどうでしょう。
procedure TForm1.OpenDialog1Show(Sender: TObject);
begin
// ひとつ前のコントロールにフォーカスを戻す
PostMessage(OpenDialog1.Handle, WM_NEXTDLGCTL, -1, 0);
// リバースしないので、何かキーを押してリバースさせる
keybd_event(VK_SPACE, 0, 0, 0);
keybd_event(VK_SPACE, 0, KEYEVENTF_KEYUP, 0);
end;
参照: [Delphi-ML:33851]
0253 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/09/13 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/13 osamu 編集
TFontDialog で標準以外のサイズを選択肢に表示したい
> ルビをうつフォントを指定しようと思い、TFontDialogで
> 片付けようと思いましたが、TFontDialogで、MSゴシック
> など8Pt以下のポイントが出てきません。指定できるように
> する方法をどなたかご存知でしょうか。
思いっきり強引ですけど
unit FontDialogEx;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs;
type
TFontDialogEx = class(TFontDialog)
protected
function TaskModalDialog(DialogFunc: Pointer;
var DialogData): Bool; override;
end;
procedure Register;
implementation
uses Dlgs, CommDlg;
const
WM_FONTDIALOGEX = WM_USER + 256;
str1: string = '4';
str2: string = '5';
str3: string = '6';
str4: string = '7';
var
OldHook: function(Wnd: HWnd; Msg: UINT; WParam: WPARAM;
LParam: LPARAM): UINT; stdcall;
function FontDialogHookEx(Wnd: HWnd; Msg: UINT; WParam: WPARAM;
LParam: LPARAM): UINT; stdcall;
begin
if (Msg = WM_COMMAND) and (LOWORD(WParam) = cmb1) then begin
PostMessage(Wnd, WM_FONTDIALOGEX, 0, 0);
end;
if Msg = WM_FONTDIALOGEX then begin
SendDlgItemMessage(Wnd, cmb3, CB_RESETCONTENT, 0, 0);
SendDlgItemMessage(Wnd, cmb3, CB_ADDSTRING, 0, LongInt(PCHAR(str1)));
SendDlgItemMessage(Wnd, cmb3, CB_ADDSTRING, 0, LongInt(PCHAR(str2)));
SendDlgItemMessage(Wnd, cmb3, CB_ADDSTRING, 0, LongInt(PCHAR(str3)));
SendDlgItemMessage(Wnd, cmb3, CB_ADDSTRING, 0, LongInt(PCHAR(str4)));
Result := 1;
exit;
end;
Result := OldHook(Wnd, Msg, WParam, LParam);
end;
function TFOntDialogEx.TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool;
begin
OldHook := TChooseFont(DialogData).lpfnHook;
TChooseFont(DialogData).lpfnHook := FontDialogHookEx;
inherited TaskModalDialog(DialogFunc, DialogData);
end;
procedure Register;
begin
RegisterComponents('NkCtrls', [TFontDialogEx]);
end;
end.
一応動いてます(^^ フォント名毎に表示するサイズリストを変えたい場合は、cmb1 に選択されているフォント名を確認するコードが必要になるでしょう。
一瞬元のポイントサイズがコンボボックスに表示されてしまいますが今のところ他に良い手を思いつきません(^^;
参照: [Delphi-ML:42562] <Dialogs> <描画> <コンポーネント >
0011 D1D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/02/08 osamu rev 1.2 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/06 西坂良幸 編集
メッセージボックスを独自にカスタマイズしたものを使いたい。
メッセージボックスを使ってたのですが、動きはほとんど同じで表示のアイコンやボタンをカスタマイズする方法って言うのはないものでしょうか? 決まりきった疑問符や感嘆符などではなく、ユーザが自由にビットマップを貼り付けられるようにしたいのですが。
CreateMessageDialog関数を使えば簡単にできます。
以下の例を試して見て下さい。あなた好みのメッセージボックスのイメージが沸いてきますよ。
CreateMessageDialogは、メッセージダイアログのインスタンスを返します。
このダイアログ(TForm)の上のコンポーネントは
クラス 名前
Components[0]が、TImage 'Image'
Components[1]が、TLabel 'Message'
Components[2]が、TButton たとえば 'Yes','No' など
Components[3] ・・・ボタンがつづく
となっています。
function MyMessageBox(Const Msg: String): integer;
var
Dlg:TForm;
begin
Dlg:=CreateMessageDialog(Msg, mtError, [mbYes,mbNo]);
with Dlg do
try
Dlg.Caption := '登録確認';
TImage(Components[0]).Picture.Icon.LoadFromFile('C:\Program Files\Borland\Delphi 4\IMAGES\ICONS\Technlgy.ico');
TButton(Components[2]).Caption := '登録';
TButton(Components[3]).Caption := '中止';
ret := ShowModal;
finally
Free;
end;
end;
// テスト
procedure TForm1.Button1Click(Sender: TObject);
begin
if MyMessageBox('データを登録しますか?') = mrYes then
// 登録処理
else
; // 無視
end;
てな具合で絵(BitmapやIcon)を変える事ができます。
LeftやTopを使って配置を換えることも可能です。
HelpContextなども設定できます。
絵は32x32サイズに作っておいた方がいいです。
大きさが違う場合には位置の調整をしなければならなくなりますが、ダイアログ上のコントロールに名前がついていないので苦労します。(D4以降は上記のように名前も付いています)
ボタンについても同様です。
参照: [Delphi-ML:5100]
0238 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/09/06 西坂良幸 rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/06 西坂良幸 編集
メッセージボックスのデフォルトボタンを変えたい
ボタンが、[はい、いいえ]ならNoの方に、デフォルトが、[はい、いいえ、キャンセル]ならキャンセルにデフォルトを置きたい場合があります。
APIのMessageBoxのヘルプから、スタイルフラッグを調べて下さい。ApplicationのMessageBox メソッドを使えば簡単です。
Application.MessageBox('デフォルトボタンを変えています', PChar(Application.Title), MB_ICONQUESTION + MB_YESNO + MB_DEFBUTTON2);
Application.MessageBox('デフォルトボタンを変えています', PChar(Application.Title), MB_ICONQUESTION + MB_YESNOCancel + MB_DEFBUTTON3);
がわかりやすいでしょう。
CreateMessageDialog関数を使われるなら、次のような自作関数はどうでしょうか。
Defaultパラメータを、2とか3にすれば、デフォルトボタンを変えることができます。
function MessageDlgEx(const Msg: string; AType: TMsgDlgType; AButtons: TMsgDlgButtons; HelpCtx: Longint = 0; default: Word = 1): Word;
var
Dlg: TForm;
begin
Dlg := CreateMessageDialog(Msg, AType, AButtons);
try
// 最初のボタンが Components[2]である
if (Default <1) or (Default >= Dlg.ComponentCount - 1) then Default := 1;
Dlg.HelpContext := HelpCtx;
Dlg.ActiveControl := TWinControl(Dlg.Components[default + 1]);
result := Dlg.ShowModal;
finally
Dlg.Free;
end;
end;
参照: [Delphi-ML:5944] [Delphi-ML:32505]
0079 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/02/08 osamu rev 1.2 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/02 西坂良幸 編集
Windowsの「ファイルの検索」ダイアログをプログラムから使いたい
「ファイルの検索」ダイアログを出すには、DDEを使います。
フォームに TDdeClientConv コンポーネント(Systemタブ)を乗っけて、
procedure TForm1.Button1Click(Sender: TObject);
var
Macro:string;
begin
DdeClientConv1.SetLink('Folders','AppProperties');
DdeClientConv1.ServiceApplication:='Explorer';
DdeClientConv1.OpenLink;
Macro := Format('[FindFolder("%S")]', ['D:\Delphi 3']);
DdeClientConv1.ExecuteMacro(PChar(Macro),False);
DdeClientConv1.CloseLink;
end;
てなふうにします。D:\Delphi 3 フォルダがカレントになります。
ちなみにどこで見つけたかというと、レジストリの
HKEY_CLASSES_ROOT\Directory\shell\find\ddeexec
です。
なお、終了させる場合は
procedure TForm1.Button2Click(Sender: TObject);
var
hDialog;
begin
hDialog:=FindWindow('#32770',nil); {ダイヤログのハンドル}
SendMessage(hDialog, WM_CLOSE, 0, 0); {終了}
end;
が簡単でいいでしょう。
参照: [Delphi-ML:20377] <その他Windows関連> <ShellApi> <Windows>
0070 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/02/08 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/02/08 osamu 編集
OpenDialogでたくさんファイルを選択するとエラー
ファイル名を保存するバッファが 8KB 固定のために起こります。
VCL に手を入れるか、自分で GetOpenFileName API を呼ぶしか回避できません。
参照: [builder:5117] <バグ> <ファイル>
0081 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/02/08 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/02/08 osamu 編集
「システムエラー 読み出せません ドライブ X:」ダイアログを回避する
Q:
Delphiで、フロッピーのようなリムーバブルメディアがちゃんとセットされているかを、「静かに」知る方法はないものでしょうか。FileExists関数を使っても、フロッピーの入っていないドライブを見に行くと、システムエラーダイアログが表示されてしまいます。
A:
Windows API の SetErrorMode を使用すればいいでしょう。
ここ一年使っているドライブのチェックルーチンはこんな感じです。
# WIN32の部分はまだあまり実績がないですけど...
function IsDriveReady(drive : char) : boolean;
var
oldmode : word;
searchrec : tSearchRec;
begin
drive := upcase(drive);
oldmode := SetErrorMode(SEM_FAILCRITICALERRORS); (* ここと *)
result := DiskSize(ord(drive)-$40) <> -1;
{$IFDEF WIN32}
if result and (GetDriveType(pchar(drive+':\')) in [DRIVE_REMOTE, DRIVE_CDROM]) then begin
{$ELSE}
if result and (GetDriveType(ord(drive)-$41) = DRIVE_REMOTE) then begin
{$ENDIF}
result := FindFirst(drive+':\*.*',$3f, searchrec) = 0;
FindClose(searchrec);
end;
SetErrorMode(oldmode); (* ここね *)
end;
http://slis.flet.mita.keio.ac.jp/~anakata/delphi/myfaq.html#Q12
にも載せてあります。
参照: [Delphi-ML:184] <Windows>
0028 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/02/08 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/02/08 osamu 編集
Windowsの「ファイルの検索ダイアログ」を表示させる
ファイルの検索ダイアログを出すには、DDEを使います。
フォームに TDdeClientConv コンポーネント(Systemタブ)を乗っけて、
procedure TForm1.Button1Click(Sender: TObject);
var
Macro:string;
begin
DdeClientConv1.SetLink('Folders','AppProperties');
DdeClientConv1.ServiceApplication:='Explorer';
DdeClientConv1.OpenLink;
Macro := Format('[FindFolder("%S")]', ['D:\Delphi 3']);
DdeClientConv1.ExecuteMacro(PChar(Macro),False);
DdeClientConv1.CloseLink;
end;
てなふうにします。D:\Delphi 3 フォルダがカレントになります。
ちなみにどこで見つけたかというと、レジストリの
HKEY_CLASSES_ROOT\Directory\shell\find\ddeexec
です。
参照: [Delphi-ML:20377] <その他Windows関連> <ShellApi> <Windows>
[新規作成] [最新の情報に更新]
How To
Lounge
KeyWords
Osamu Takeuchi osamu@big.or.jp
Tips
Delphi
Home