このプログラムを使えば， DLLのエクスポート関数の一覧を見ることができる． と言っても，Borland系言語製品に付属しているTDUMP.EXEの標準入出力をパイプしているだけ． 当然TDUMP.EXEが無いと動作しない．
タイトルのことを実現するには，以下のようにする．
procedure TMainForm.SetBackErase;
var
TheIndex, TheColor: Integer;
begin
TheIndex := COLOR_BACKGROUND;
TheColor := -1;
SetSysColors( 2, TheIndex, TheColor );
end;
SendMessage( HWnd, LVM_SETTEXTCOLOR, 0, AColor );
function TMainForm.GetDesktopHWnd;
var
HWnd: THandle;
begin
HWnd := FindWindow( 'Progman', nil );
HWnd := FindWindowEx( HWnd, 0, 'SHELLDLL_DefView', nil );
HWnd := FindWindowEx( HWnd, 0, 'SysListView32', nil );
Result := HWnd;
end;
タイトルのことを実現するにはGetLogicalDrives関数を用いる． この関数が戻すDWORD値は，現在使用可能なドライブの順序値に相当するビットがマスクされている． もし，A,C,Dドライブが使用可能なら，1番目と3番目と4番目のビットが1で，あとのビットは0になっている．
したがって，戻り値のビットを順に調べていけばよいのであるが，このような操作はPascalの集合型を
使うと大変要領良く行える．
以下のGetDriveString関数は，例えばA,C,D,Eドライブが使用可能なら，"ACDE"という文字列を返す．
function GetDriveString: String;
var
R, Index: Integer;
DriveBits: set of 0..25;
begin
Result := '';
R := GetLogicalDrives;
if R <> 0 then
begin
Integer( DriveBits ) := R;
for Index := 0 to 25 do
if Index in DriveBits then
Result := Result + Char( Index + Ord( 'A' ) );
end;
end;
以下の関数を使えばコンソールプログラムの標準出力をString型変数で得ることができる．
どうしてそうなるのかの詳細は，実のところ良くわかっていない．
function RedirectExec( CmdLine: String;
var StdIn, StdOut, StdErr: String ): Boolean;
var
hPipe1Read, hPipe1Write: THandle;
hPipe2Read, hPipe2Write: THandle;
hPipe3Read, hPipe3Write: THandle;
hStdin, hStdOut, hStdErr: THandle;
SI: TStartupInfo;
PI: TProcessInformation;
Buf: array[ 0..1024 ] of Char;
ReadCount: Integer;
begin
// Make StdOut Pipe
CreatePipe( hPipe1Read, hPipe1Write, nil, 0 );
DuplicateHandle( GetCurrentProcess, hPipe1Write,
GetCurrentProcess, @hStdOut, 0, True,
DUPLICATE_CLOSE_SOURCE or DUPLICATE_SAME_ACCESS );
// Make StdIn Pipe
CreatePipe( hPipe2Read, hPipe2Write, nil, 0 );
DuplicateHandle( GetCurrentProcess, hPipe2Read,
GetCurrentProcess, @hStdIn, 0, True,
DUPLICATE_CLOSE_SOURCE or DUPLICATE_SAME_ACCESS );
// Make StdErr Pipe
CreatePipe( hPipe3Read, hPipe3Write, nil, 0 );
DuplicateHandle( GetCurrentProcess, hPipe3Write,
GetCurrentProcess, @hStdErr,0, True,
DUPLICATE_CLOSE_SOURCE or DUPLICATE_SAME_ACCESS );
// Intialize StartupInfo
FillChar( SI, SizeOf( SI ), 0 );
SI.cb := SizeOf( SI );
SI.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
SI.wShowWindow := SW_HIDE;
SI.hStdInput := hStdIn;
SI.hStdOutput := hStdOut;
SI.hStdError := hStdErr;
StdIn := StdIn + #$1a; // EOF
StdOut := '';
StdErr := '';
try
Result := CreateProcess( nil, PChar( CmdLine ),nil, nil, True,
NORMAL_PRIORITY_CLASS or CREATE_NO_WINDOW,
nil, nil, SI, PI );
CloseHandle( PI.hThread );
CloseHandle( hStdOut ); // Close StdOutPut
Closehandle( hStdIn ); // Close StdInPut
CloseHandle( hStdErr ); // Close StdError
// Write StdInPut
FileWrite( hPipe2Write, PChar( StdIn )^, Length( StdIn ) );
// Read StdOutPut
repeat
Application.ProcessMessages;
FillChar( Buf, SizeOf( Buf ), 0 );
ReadCount := FileRead( hPipe1Read, Buf, SizeOf( Buf ) - 1 );
StdOut := StdOut + Buf;
until ReadCount <<= 0;
// Read StdError
repeat
Application.ProcessMessages;
FillChar( Buf, SizeOf( Buf ), 0 );
ReadCount := FileRead( hPipe3Read,Buf, SizeOf( Buf ) - 1 );
StdErr := StdErr + Buf;
until ReadCount <= 0;
WaitForSingleObject( PI.hProcess, INFINITE );
CloseHandle( PI.hProcess );
finally
// CloseHandle( hStdOut ); // Close StdOutPut
// Closehandle( hStdIn ); // Close StdInPut
// CloseHandle( hStdErr ); // Close StdError
CloseHandle( hPipe1Read ); // Close StdOut Pipe
CloseHandle( hPipe2Write ); // Close StdIn Pipe
Closehandle( hPipe3Read ); // Close StdError Pipe
end;
end;
タイトルのことを実現するには，まずGetTempPath関数を使ってテンポラリディレクトリの
パスを取得し，次にGetTempFileName関数を使って一意的なファイル名を作成すればよい．
例えば以下のような関数を用いる．
function GetTemporaryFileName: String;
var
Path: array[ 0..255 ] of Char;
TempFile: array[ 0..255 ] of Char;
begin
GetTempPath( SizeOf( Path ), Path );
GetTempFileName( Path, '$', 0, TempFile );
Result := TempFile;
end;
APIのGetDiskFreeSpaceEx関数を使えば2GB超のドライブ容量が取得できるが，この関数は Windows 95 OSR2以降かNT4.0以降でしかサポートされていない． これ以前のOSでは，旧来のGetDiskFreeSpace関数を使って1クラスタあたりのセクタ数， 1セクタあたりのバイト数，空きクラスタ数および総クラスタ数を取得し，これらを乗ずることで 空き容量および総容量を求めるが，2GB超のドライブ容量は正しく求められない． このようなことのため，ディスク容量を取得する場合は前もってOSのバージョンを調べておく必要がある．
しかしながら，Delphi 5ではGetDiskFreeSpaceExが関数ポインタとしてSysUtilsユニット に宣言されており，ユニットの初期化時に，もしAPIのGetDiskFreeSpaceEx関数がサポート されているならそのアドレスが代入され，さもなければDelphiの内部関数のアドレスが代入されるように なっている． Delphiの内部関数はGetDiskFreeSpace関数を呼び出しているだけなので，依然2GBの制限は残っているが， 少なくともOSのバージョンを気にかけずにGetDiskFreeSpaceExを呼び出すことができる．
以下はGetDiskFreeSpaceExを使用した例である．
エクスプローラに表示される値と同じ値がリストボックスに表示される．
procedure TForm1.Button1Click(Sender: TObject);
var
Avail, Total, Free: Int64;
begin
GetDiskFreeSpaceEx( 'D:\', Avail, Total, @Free );
ListBox1.Items.Add( Format( 'Avail = %8.3f', [ Avail / IntPower( 1024, 3 ) ] ) );
ListBox1.Items.Add( Format( 'Total = %8.3f', [ Total / IntPower( 1024, 3 )] ) );
ListBox1.Items.Add( Format( 'Free = %8.3f', [ Free / IntPower( 1024, 3 ) ] ) );
end;
APIのSHGetFileInfo関数を使えば，ファイル，フォルダおよびドライブに関連付けられた システムアイコンのハンドルを取得することができる． 取得したアイコンを描画する場合は，DrawIconEx関数を使う．DrawIcon関数は使わない．
procedure TForm1.Button2Click(Sender: TObject);
var
FileName: String;
SFI: TSHFileInfo;
Flag: Cardinal;
begin
if OpenDlg.Execute then
begin
try
FileName := OpenDlg.FileName;
Flag := SHGFI_ICON;
SHGetFileInfo( PChar( FileName ), 0, SFI, SizeOf( SFI ), Flag );
DrawIconEx( Image1.Canvas.Handle, 0, 0, SFI.hIcon,
0, 0, 0, 0, DI_NORMAL );
finally
DeleteObject( SFI.hIcon );
end;
end;
end;
Flag := SHFGI_ICON or SHGFI_SMALLICON
なお，アイコンの描画が終了したら必ずDeleteObject関数を呼び出して アイコンを破棄しなければならない． これを忘れた場合，例えばフォルダにあるファイルすべてのアイコンを取得する ようなことを繰り返すとリソース不足に陥る． 推測であるが，SHGetFileInco関数は該当するシステムアイコンのコピーを作成し， そのハンドルを戻すようである． したがって，アイコンを破棄しても何ら問題ない．
FlagにSHGFI_USEFILEATTRIBUTESを指定しておき，
SHGetFileInfo関数の最初の引数はフォルダのパスを設定し，2番目の引数に
FILE_ATTRIBUTE_DIRECTORYを指定する．
例えば，
FileName := 'c:\winnt';
Flag := SHGFI_ICON or SHGFI_USEFILEATTRIBUTES;
ShGetFileInfo( PChar( FileName ), FILE_ATTRIBUTE_DIRECTORY, SFI, SizeOf( SFI ), Flag );
DrawIconEx( Image1.Canvas.Handle, 0, 0, SFI.hIcon, 0, 0, 0, 0, DI_NORMAL );
Flag := SHFGI_ICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES;
Flag := SHFGI_ICON or SHGFI_OPENICON or SHGFI_USEFILEATTRIBUTES;
Win32環境でアプリケーションの二重起動を防止するには，mutexを使う方法が最も簡単である． アプリケーションを最初に起動するときに ユニークな名前のmutexオブジェクトを作成しておき， 次に起動する際にその名前のmutexが存在するかを調べ，あれば起動を中止する．
以下はプロジェクトのソースコードであり，すでにmutexオブジェクトが存在すれば，
すなわち，すでにアプリケーションが起動済みであれば，そのアプリケーションを
アクティブにし，アイコン化されていれば元の大きさに復元する．
起動済みアプリケーションのハンドルを検索する際には，クラス名が必要である．
Delphiで作成したアプリケーションでは，メインフォームの名前にTをつけたものが
アプリケーションのクラス名になる．
var
hMutex, Wnd, AppWnd: THandle;
begin
hMutex := OpenMutex( MUTEX_ALL_ACCESS, False, 'hPrevCalendar' );
if hMutex = 0 then
begin
hMutex := CreateMutex( nil, False, 'hPrevCalendar' );
Application.Initialize;
Application.CreateForm(TCalendarMainForm, CalendarMainForm);
Application.CreateForm(TMemoDlg, MemoDlg);
Application.Run;
ReleaseMutex( hMutex );
end
else begin
Wnd := FindWindow( 'TCalendarMainForm', nil );
if Wnd <> 0 then
begin
AppWnd := GetWindowLong( Wnd, GWL_HWNDPARENT );
ShowWindow( AppWnd, SW_SHOW );
ShowWindow( Wnd, SW_SHOW );
if IsIconic( AppWnd ) then
begin
SendMessage( AppWnd, WM_SYSCOMMAND, SC_RESTORE, -1 );
end;
SetForegroundWindow( AppWnd );
end;
end;
end.
Windows標準のバージョン情報ダイアログを表示するには，ShellAbout関数を使う．
この関数を使うときは，ShellAPIユニットをuses節に追加する．
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellAbout( Handle, '九州大学',
'工学研究院付属環境科学システム研究センター',
Application.Icon.Handle );
end;
ここ に移動した．
タイトルのことを実現するにはShell_NotifyIcon APIを用いる．
このAPIのプロトタイプは以下の通り．
function Shell_NotifyIcon(dwMessage: DWORD; lpData: PNotifyIconData): BOOL; stdcall;
_NOTIFYICONDATAA = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array [0..63] of AnsiChar;
end;
アプリケーションのアイコンをトレイに追加するには，
メインフォームのOnCreateイベントに以下のように書く．
const
WM_TRAYICONCLICKED = WM_USER + 1000;
var
IconData: TNotifyIconData;
procedure TMainForm.FormCreate(Sender: TObject);
begin
with IconData do
begin
cbSize := SizeOf( TNotifyIconData );
Wnd := Self.Handle;
uID := 1;
uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
uCallbackMessage := WM_TRAYICONCLICKED;
hIcon := Application.Icon.Handle;
szTip := 'Use Shell_NotifyIcon';
end;
Shell_NotifyIcon( NIM_ADD, @IconData );
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Shell_NotifyIcon( NIM_DELETE, @IconData );
end;
procedure TMainForm.WMTrayIconClicked( var Mes: TMessage );
var
Pos: TPoint;
begin
if Mes.LParam = WM_LBUTTONDOWN then
begin
GetCursorPos( Pos );
PopupMenu.Popup( Pos.X, Pos.Y );
end;
end;
なお，この例ではメニューのオーナードローを使っている． やり方についてはここにまとめた．
Windows2000で新たに追加されたSetLayeredWindowAttributesを使えば簡単に（半）透明ウィンドウを
作成することができる．
このAPIのプロトタイプは以下の通り．
function SetLayeredWindowAttributes( hwnd: HWND; crKey: COLORREF;
bAlpha: BYTE; dwFlags: DWORD ): BOOL; stdcall;
LWA_COLORKEY：透過色としてcrKeyを使う．
LWA_ALPHA：bAlphaによって透過度合を指定する．
を指定できる． SetLayeredWindowAttributesを使うためにはウィンドウがWS_EX_LAYEREDスタイルを 持っている必要があるため，フォームのCreateParamsメソッドをオーバーライドする．
なお，ここで述べたAPIおよび定数はDelphi5のwindows.pasには宣言されていないので， 自前で宣言する必要がある．
以下は半透明のウィンドウを作成した例である．
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
protected
public
procedure CreateParams( var Params: TCreateParams ); override;
end;
var
Form1: TForm1;
function SetLayeredWindowAttributes( hwnd: HWND; crKey: COLORREF;
bAlpha: BYTE; dwFlags: DWORD ): BOOL; stdcall;
implementation
{$R *.DFM}
const
WS_EX_LAYERED = $80000;
LWA_COLORKEY = 1;
LWA_ALPHA = 2;
function SetLayeredWindowAttributes;
external 'user32.dll' name 'SetLayeredWindowAttributes';
procedure TForm1.CreateParams( var Params: TCreateParams );
begin
inherited CreateParams( Params );
Params.Exstyle := Params.Exstyle or WS_EX_LAYERED;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
SetLayeredWindowAttributes( Handle, ColorToRGB( clWindow ),
200, LWA_ALPHA or LWA_COLORKEY );
end;
| SEO | [PR] 爆速!無料ブログ 無料ホームページ開設 無料ライブ放送 | ||
