:: MVP ::
|
|
:: RSS ::
|
|
|
Как изменить заголовок кнопок в MessageDlg?
function MyMessageDialog( const Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; Captions: array of string ): integer;
var
aMsgDlg: TForm;
i: integer;
dlgButton: TButton;
CaptionIndex: integer;
begin
aMsgDlg := CreateMessageDialog( Msg, DlgType, Buttons );
CaptionIndex := 0;
for i := 0 to aMsgDlg.ComponentCount - 1 do
begin
if ( aMsgDlg.Components[i] is TButton ) then
begin
dlgButton := TButton( aMsgDlg.Components[i] );
if CaptionIndex > High( Captions ) then Break;
dlgButton.Caption := Captions[CaptionIndex];
Inc( CaptionIndex );
end;
end;
Result := aMsgDlg.ShowModal;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if MyMessageDialog( 'Новые кнопки', mtConfirmation, mbOKCancel, ['1','2'] ) = mrOk then
ShowMessage( 'Была нажата кнопка "1"' )
else
ShowMessage( 'Была нажата кнопка "2"' );
end;
|
Как вызвать стандартное окно About?
// Способ первый
uses
{...,} ShellAPI;
procedure ShowAbout;
begin
ShellAbout( Form1.Handle, 'Название программы',
'Авторские права на программу', Application.Icon.Handle );
end;
// Способ второй
uses
{...,} ShellAPI;
procedure ShowAbout;
begin
ShellExecute(Application.Handle, 'open', PChar('rundll32.exe'),
PChar('shell32,ShellAboutA Авторские права на программу'), nil, SW_SHOWNORMAL);
end;
|
Как вызвать диалог завершения работы с Windows?
// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage( FindWindow( 'Progman', 'Program Manager' ), WM_CLOSE, 0, 0 );
end;
// Способ второй
uses
{...,} ComObj;
procedure TForm1.Button1Click(Sender: TObject);
var
Shell: Variant;
begin
Shell := CreateOleObject( 'Shell.Application' );
Shell.ShutdownWindows;
end;
|
Как вызвать диалог свойств принтера?
uses
{...,} WinSpool, Printers;
procedure ShowPrinterProperty( Wnd: HWND; ComboBox: TComboBox );
const
Defaults: TPrinterDefaults = ( pDatatype: nil; pDevMode: nil;
DesiredAccess: STANDARD_RIGHTS_REQUIRED or PRINTER_ACCESS_USE );
var
hPrinter: THandle;
Device: array[0..255] of char;
Driver: array[0..255] of char;
Port: array[0..255] of char;
hDeviceMode: THandle;
RetVal: boolean;
begin
Printer.PrinterIndex := Combobox.ItemIndex;
Printer.GetPrinter( Device, Driver, Port, hDeviceMode );
if not OpenPrinter( @Device, hPrinter, @Defaults ) then
RaiseLastWin32Error;
try
PrinterProperties( Wnd, hPrinter );
finally
ClosePrinter( hPrinter );
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Combobox1.Items := Printer.Printers;
Combobox1.ItemIndex := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowPrinterProperty( Handle, ComboBox1 );
end;
|
Как открыть диалог создания ярлыка?
uses
{...,} Registry, ShellAPI;
function Launch_CreateShortCut_Dialog( Directory: string ): boolean;
var
reg: TRegistry;
cmd: string;
begin
Result := false;
reg := TRegistry.Create;
try
reg.Rootkey := HKEY_CLASSES_ROOT;
if reg.OpenKeyReadOnly( '.lnk\ShellNew' ) then
begin
cmd := reg.ReadString( 'Command' );
cmd := StringReplace( cmd, '%1', Directory, [] );
Result := true;
WinExec( PChar( cmd ), SW_SHOWNORMAL );
end
finally
reg.CloseKey;
reg.Free;
end;
end;
// В качестве параметра указывается диск или каталог,
// в котором будет создан ярлык
procedure TForm1.Button1Click(Sender: TObject);
begin
Launch_CreateShortCut_Dialog( 'c:\' );
end;
|
Как вызвать диалог для выбора иконки?
// Пример для WinNT, в Win9x возможно придется
// тип WideString заменить на AnsiString
function SHChangeIconDialog( hOwner: THandle; szFilename: WideString;
Reserved: integer; var lpIconIndex: integer): dword; stdcall;
external 'shell32.dll' index 62;
procedure TForm1.Button1Click(Sender: TObject);
var
IconIndex: integer;
begin
SHChangeIconDialog( Handle, 'shell32.dll', 0, IconIndex );
end;
|
Как вызвать диалог свойств диска/папки/файла?
uses
{...,} ShellAPI;
procedure ShowProperties( Path: string );
var
SEInfo: TShellExecuteInfo;
begin
FillChar( SEInfo, SizeOf( SEInfo ), 0 );
SEInfo.cbSize := SizeOf( TShellExecuteInfo );
with SEInfo do
begin
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_INVOKEIDLIST or SEE_MASK_FLAG_NO_UI;
Wnd := Application.Handle;
lpFile := PChar( Path );
lpVerb := 'Properties';
lpParameters := '';
lpDirectory := '';
hInstApp := 0;
lpIDList := nil;
lpDirectory := PChar( Path );
nShow := SW_SHOWNORMAL;
end;
ShellExecuteEx( @SEInfo );
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowProperties( 'c:\' ); // Свойства диска
// ShowProperties( 'c:\winnt' ); // Свойства папки
// ShowProperties( 'c:\boot.ini' ); // Свойства файла
end;
|
При использовании материала - ссылка на сайт обязательна
|
|