FAQ VCL
Диалоги

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: 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;


Как вызвать диалог подключения сетевого диска?

procedure TForm1.Button1Click(Sender: TObject);
begin
   WNetConnectionDialog( Handle, RESOURCETYPE_DISK );
end;


Как вызвать диалог отключения сетевого диска?

procedure TForm1.Button1Click(Sender: TObject);
begin
   WNetDisconnectDialog( Handle, RESOURCETYPE_DISK );
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;


Как вызвать диалог для ввода строки текста?

procedure TForm1.Button1Click(Sender: TObject);
begin
   Caption := InputBox( 'Новый заголовок', 'Введите текст', Caption );
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;

При использовании материала - ссылка на сайт обязательна