Диалоги

Code:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, CommDlg;

type

TMySaveDialog = class(TSaveDialog)

protected

   procedure WndProc(var Message: TMessage); override;

end;

TForm1 = class(TForm)

   Button1: TButton;

   procedure Button1Click(Sender: TObject);

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TMySaveDialog.WndProc(var Message: TMessage);

const

X = 10;

Y = 30;

begin

with Message do

begin

   if ((Msg = WM_NOTIFY) and (POFNotify(LParam)^.hdr.code = CDN_INITDONE)) or

      ((Msg = WM_UPDATEUISTATE) and (WParamLo = UIS_SET)) then

   begin

     if Owner is TForm then

       SetWindowPos(GetParent(Handle), HWND_TOP, X, Y, 0, 0, SWP_NOSIZE);

   end

   else

     inherited;

end

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

TMySaveDialog.Create(Self).Execute;

end;

end.

Code:

{

If you are developing network software for Windows NT,

you usually need to ask the user to select a computer or domain

he wants to connect/login.

}

const

FOCUSDLG_DOMAINS_ONLY = 1;

FOCUSDLG_SERVERS_ONLY = 2;

FOCUSDLG_SERVERS_DOMAINS = 3;

FOCUSDLG_BROWSE_LOGON_DOMAIN = $00010000;

FOCUSDLG_BROWSE_WKSTA_DOMAIN = $00020000;

FOCUSDLG_BROWSE_OTHER_DOMAINS = $00040000;

FOCUSDLG_BROWSE_TRUSTING_DOMAINS = $00080000;

FOCUSDLG_BROWSE_WORKGROUP_DOMAINS = $00100000;

FOCUSDLG_BROWSE_ALL_DOMAINS = FOCUSDLG_BROWSE_LOGON_DOMAIN or

   FOCUSDLG_BROWSE_WKSTA_DOMAIN or FOCUSDLG_BROWSE_OTHER_DOMAINS or

   FOCUSDLG_BROWSE_TRUSTING_DOMAINS or FOCUSDLG_BROWSE_WORKGROUP_DOMAINS;

function SystemFocusDialog(hwndOwner: HWND; dwSelectionFlag: UINT;

wszName: PWideChar; dwBufSize: DWORD; var bOKPressed: Boolean;

wszHelpFile: PWideChar; dwContextHelpId: DWORD): DWORD; stdcall;

external 'ntlanman.dll' Name 'I_SystemFocusDialog';

function ComputerBrowser(hWndParent: HWND; wCompName: PWideChar;

dwBufLen: DWORD): Boolean;

var

dwError: DWORD;

begin

Result := False;

dwError := SystemFocusDialog(hWndParent, FOCUSDLG_SERVERS_DOMAINS or

   FOCUSDLG_BROWSE_ALL_DOMAINS,

   wCompName, dwBufLen, Result, nil, 0);

if dwError <> NO_ERROR then Exit;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

wCompName: array [0..MAX_COMPUTERNAME_LENGTH + 1] of WideChar;

begin

if ComputerBrowser(0, wCompName, MAX_COMPUTERNAME_LENGTH + 1) then

   ShowMessage(wCompName)

else

   ShowMessage('no computer selected');

end;

{***************************}

// Show the ServerBrowseDialogA0 Dialog

type

TServerBrowseDialogA0 = function(hwnd: HWND; pchBuffer: Pointer;

   cchBufSize: DWORD): bool;

stdcall;

function ShowServerDialog(AHandle: THandle): string;

var

ServerBrowseDialogA0: TServerBrowseDialogA0;

LANMAN_DLL: DWORD;

buffer: array[0..1024] of char;

bLoadLib: Boolean;

begin

LANMAN_DLL := GetModuleHandle('NTLANMAN.DLL');

if LANMAN_DLL = 0 then

begin

   LANMAN_DLL := LoadLibrary('NTLANMAN.DLL');

   bLoadLib := True;

end;

if LANMAN_DLL <> 0 then

begin @ServerBrowseDialogA0 := GetProcAddress(LANMAN_DLL, 'ServerBrowseDialogA0');

   DialogBox(HInstance, MAKEINTRESOURCE(101), AHandle, nil);

   ServerBrowseDialogA0(AHandle, @buffer, 1024);

   if buffer[0] = '\' then

   begin

     Result := buffer;

   end;

   if bLoadLib then

     FreeLibrary(LANMAN_DLL);

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

label1.Caption := ShowServerDialog(Form1.Handle);

end;

Code:

// If an application asks user to select an icon, it's

// more convenient for the user to see list of files as

// large icons instead of small icons. Also, for selecting

// an image file, user will be happier to choose an image

// by seeing the thumbnails.

// The standard file dialog initialy shows the files in

// the LIST (small icon) style, and there is no documented

// way to change this behavior. So, if user wants to see

// the file list in another style, she/he should change

// it manually by selecting the desired view style form

// the provided popup menu.

// Here is a workaround for this limitation to select the

// reasonable view style for a file dialog.

type

TFileViewStyle = (fvsIcons, fvsList, fvsDetails, fvsThumbnails, fvsTiles);

function SetFileDialogViewStyle(Handle: THandle; ViewStyle: TFileViewStyle): Boolean;

const

CommandIDs: array[TFileViewStyle] of Word = ($7029, $702B, $702C, $702D, $702E);

var

NotifyWnd: THandle;

begin

Result    := False;

NotifyWnd := FindWindowEx(GetParent(Handle), 0, 'SHELLDLL_DefView', nil);

if NotifyWnd <> 0 then

begin

   SendMessage(NotifyWnd, WM_COMMAND, CommandIDs[ViewStyle], 0);

   Result := True;

end;

end;

// Each time the file dialog opens, the above function should

// be called to set the desired view style. The OnShow event

// of the file dialogs seems to be the right place for this

// purpose, however at that time the list is not created yet

// and the function fails.

// When the file list is created, the dialog raises two events:

// OnFolderChange and OnSelectionChange events. We can use one

// of these events for our purpose. However, we have to consider

// that the function should be called just once for each show.

// Here is a sample usage of the introduced function:

procedure TForm1.Button1Click(Sender: TObject);

begin

OpenDialog1.Tag := 0;

OpenDialog1.Execute;

end;

procedure TForm1.OpenDialog1FolderChange(Sender: TObject);

begin

if OpenDialog1.Tag = 0 then

begin

   SetFileDialogViewStyle(OpenDialog1.Handle, fvsIcons)

   OpenDialog1.Tag := 1;

end;

end;

Code:

uses

ComObj;

procedure TForm1.FormCreate(Sender: TObject);

var

ShellApplication: Variant;

begin

ShellApplication := CreateOleObject('Shell.Application');

ShellApplication.FileRun;

end;

{*****************************}

{2.}

{ This code uses the undocumented RunFileDlg function to show the "run" dialog }

// For Win NT

procedure RunFileDlgW(OwnerWnd: HWND; Icon: HICON; lpstrDirectory: PWideChar;

lpstrTitle: PWideChar; lpstrDescription: PWideChar; Flags: Longint); stdcall;

external 'Shell32.dll' Index 61;

// For Win 9x (Win NT to show standard captions )

procedure RunFileDlg(OwnerWnd: HWND; Icon: HICON; lpstrDirectory: PChar;

lpstrTitle: PChar; lpstrDescription: PChar; Flags: Longint); stdcall;

external 'Shell32.dll' Index 61;

const

RFF_NOBROWSE = 1; //Removes the browse button.

RFF_NODEFAULT = 2; // No default item selected.

RFF_CALCDIRECTORY = 4; // Calculates the working directory from the file name.

RFF_NOLABEL = 8; // Removes the edit box label.

RFF_NOSEPARATEMEM = 14; // Removes the Separate Memory Space check box (Windows NT only).

function ShowRunFileDialg(OwnerWnd: HWND; InitialDir, Title, Description: PChar;

flags: Integer; StandardCaptions: Boolean): Boolean;

var

HideBrowseButton: Boolean;

TitleWideChar, InitialDirWideChar, DescriptionWideChar: PWideChar;

Size: Integer;

begin

if (Win32Platform = VER_PLATFORM_WIN32_NT) and not StandardCaptions then

begin

   Size := SizeOf(WideChar) * MAX_PATH;

   InitialDirWideChar := nil;

   TitleWideChar := nil;

   DescriptionWideChar := nil;

   GetMem(InitialDirWideChar, Size);

   GetMem(TitleWideChar, Size);

   GetMem(DescriptionWideChar, Size);

   StringToWideChar(InitialDir, InitialDirWideChar, MAX_PATH);

   StringToWideChar(Title, TitleWideChar, MAX_PATH);

   StringToWideChar(Description, DescriptionWideChar, MAX_PATH);

   try

     RunFileDlgW(OwnerWnd, 0, InitialDirWideChar, TitleWideChar, DescriptionWideChar, Flags);

   finally

     FreeMem(InitialDirWideChar);

     FreeMem(TitleWideChar);

     FreeMem(DescriptionWideChar);

   end;

end else

   RunFileDlg(OwnerWnd, 0, PChar(InitialDir), PChar(Title), PChar(Description), Flags);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowRunFileDialg(FindWindow('Shell_TrayWnd', nil), nil, nil, nil, RFF_NOBROWSE, True);

end;

Code:

{

>> Процедуры для открытия диалогового окна "Свойства Экрана"

Зависимости: ShellApi

Автор:       Gua, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра., ICQ:141585495, Simferopol

Copyright:   Gua

********************************************** }

// Открытие диалогового окна "Display Properties"

procedure DisplayPropertiesWindow;

begin

ShellExecute(0,'open',Pchar('rundll32.exe'),'shell32.dll,Control_RunDLL Desk.cpl', nil, SW_normal);

end;

// Открытие диалогового окна "Display Properties" с закладкой Desktop

procedure DisplayPropertiesWindow_Desktop;

begin

ShellExecute(0,'open',Pchar('rundll32.exe'),'shell32.dll,Control_RunDLL Desk.cpl @0,0', nil, SW_normal);

end;

// Открытие диалогового окна "Display Properties" с закладкой Screen Saver

procedure DisplayPropertiesWindow_ScreenSaver;

begin

ShellExecute(0,'open',Pchar('rundll32.exe'),'shell32.dll,Control_RunDLL Desk.cpl @0,1', nil, SW_normal);

end;

// Открытие диалогового окна "Display Properties" с закладкой Settings

procedure DisplayPropertiesWindow_Settings;

begin

ShellExecute(0,'open',Pchar('rundll32.exe'),'shell32.dll,Control_RunDLL Desk.cpl @0,3', nil, SW_normal);

end;