C'est un outil qui permet de visualiser le contenu d'un fichier type texte.
Le but est de montrer le style de la boite de dialogue (GetOpenFileName), qui est collé au dessus d'une fenêtre chargée à partir d'un fichier ressource(.res).
On peut intercepeter chaque action de l'utilisateur dans la boite de dialogue grace au message WM_NOTIFY.
En plus le style de tous les programmes est du vrai API à 95%.
J'ADORE DELPHI ET LES API WINDOWS, C EST SUPER
Source / Exemple :
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, CommDlg, dlgs;
type
LPOPENFILENAME = ^TOPENFILENAME;
LPMYDATA = ^MYDATA;
MYDATA = record
szTest1,
szTest2 : array[0..80] of Char;
end;
TForm1 = class(TForm)
private
{ Déclarations privées }
sMyData : LPMYDATA;
procedure WndProc(var Msg : TMessage);override;
function OpenFileName : BOOL;
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
hwndEdit : Integer;
cdmsgShareViolation : UINT = 0; // identifier from RegisterWindowMessage
cdmsgFileOK : UINT = 0; // identifier from RegisterWindowMessage
cdmsgHelp : UINT = 0; // identifier from RegisterWindowMessage
function ComDlg32DlgProc(Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): UINT stdcall;
function TestNotify(hDlg : Integer ; pofn : POfNotify): Bool;
function About(hDlg, Msg, wParam, lParam: integer): integer; stdcall;
implementation
{$R *.DFM}
{$R ressources.res}
const
ID_EDITCHILD = 500;
IDD_COMDLG32 = 100;
IDD_ABOUT = 113;
IDE_PATH = 102;
IDE_SELECTED = 103;
IDE_PATHFILE = 105;
IDM_FILEOPEN = 106;
IDM_EXIT = 107;
IDM_ABOUT = 108;
szmsgSHAREVIOLATION = SHAREVISTRING; // string for sharing violation
szmsgFILEOK = FILEOKSTRING; // string for OK button
szCommdlgHelp = HELPMSGSTRING; // string for Help button
procedure TForm1.WndProc(var Msg : TMessage);
var
lpszHello : string;
hdc, hFont, hIcon, hMenu : Integer;
MainFontRec : TLogFont;
Tm : TTextMetric;
begin
case Msg.Msg of
WM_CREATE :
begin
hIcon := LoadIcon(hInstance, IDI_APPLICATION);
Application.Icon.Handle := hIcon;
Application.Title := 'Boite de dialogue personnalisée';
SetWindowText(Handle, PChar(Application.Title));
lpszHello := 'Choisissez le menu Fichier/Ouvrir... pour une démo de la Boite de dialogue personnalisée';
hwndEdit := CreateWindow(
'EDIT',
nil,
WS_CHILD or WS_VISIBLE or WS_VSCROLL or
ES_LEFT or ES_MULTILINE or ES_AUTOVSCROLL,
0, 0, 0, 0,
Handle,
ID_EDITCHILD,
GetWindowLong(Handle, GWL_HINSTANCE),
nil);
hdc := GetDC(Handle);
GetTextMetrics(hdc, tm);
DeleteDC(hdc);
MainFontRec.lfHeight := tm.tmHeight + tm.tmExternalLeading + tm.tmDescent;
MainFontRec.lfWidth := tm.tmAveCharWidth;
MainFontRec.lfEscapement := 0;
MainFontRec.lfOrientation := 0;
MainFontRec.lfWeight := 0; //FW_BOLD
MainFontRec.lfItalic := 0;
MainFontRec.lfUnderline := 0;
MainFontRec.lfStrikeOut := 0;
MainFontRec.lfCharSet := ANSI_CHARSET;
MainFontRec.lfOutPrecision := OUT_DEFAULT_PRECIS;
MainFontRec.lfClipPrecision := CLIP_DEFAULT_PRECIS;
MainFontRec.lfQuality := PROOF_QUALITY;
MainFontRec.lfPitchAndFamily := VARIABLE_PITCH or FF_ROMAN;
MainFontRec.lfFaceName := 'Arial Narrow';
hFont := CreateFontIndirect(MainFontRec);
SendMessage(hwndedit, WM_SETFONT, hFont, 0);
DeleteObject(hFont);
// Update the MLE.
SendMessage(hwndEdit, WM_SETTEXT, 0, LPARAM(LPSTR(lpszHello)));
hMenu := LoadMenu(hInstance, 'FETRA');
SetMenu(Handle, hMenu);
sMyData := New(LPMYDATA);
cdmsgShareViolation := RegisterWindowMessage(szmsgSHAREVIOLATION);
cdmsgFileOK := RegisterWindowMessage(szmsgFILEOK);
cdmsgHelp := RegisterWindowMessage(szCommdlgHelp);
inherited;
end;
WM_SIZE :
begin
MoveWindow(hwndEdit, 0, 0, LOWORD(Msg.lParam), HIWORD(Msg.lParam), TRUE);
inherited;
end;
WM_COMMAND :
begin
case LOWORD(Msg.WParam) of
IDM_FILEOPEN :
OpenFileName;
IDM_EXIT :
PostQuitMessage(0);
IDM_ABOUT :
DialogBox(hInstance,
MakeIntResource(IDD_ABOUT),
Handle,
@About);
end;
inherited;
end;
WM_DESTROY :
begin
Dispose(sMyData);
inherited;
end;
else
inherited;
end;
end;
function TForm1.OpenFileName : BOOL;
var
OpenFileName : TOpenFileName;
szFile : array[0..MAX_PATH] of Char;
hFile : THANDLE;
dwFileSize, dwBytesRead : DWORD;
lpBufPtr : Pointer;
begin
ZeroMemory(@szFile, SizeOf(szFile));
Result := False;
OpenFileName.lStructSize := SizeOf(TOpenFileName);
OpenFileName.hwndOwner := Handle;
OpenFileName.hInstance := hInstance;
OpenFileName.lpstrFilter := 'Fichier Texte(*.txt)' + #0 + '*.txt' + #0 + 'Fichier dBase(*.dbf)' + #0 + '*.dbf' + #0 + 'Tous les fichiers(*.*)' + #0 + '*.*' + #0 + #0;
OpenFileName.lpstrCustomFilter := nil;
OpenFileName.nMaxCustFilter := 0;
OpenFileName.nFilterIndex := 3;
OpenFileName.lpstrFile := szFile;
OpenFileName.nMaxFile := SizeOf(szFile);
OpenFileName.lpstrFileTitle := nil;
OpenFileName.nMaxFileTitle := 0;
OpenFileName.lpstrInitialDir := nil;
OpenFileName.lpstrTitle := 'Open a File';
OpenFileName.nFileOffset := 0;
OpenFileName.nFileExtension := 0;
OpenFileName.lpstrDefExt := nil;
OpenFileName.lCustData := LONGINT(sMyData);
OpenFileName.lpfnHook := ComDlg32DlgProc;
OpenFileName.lpTemplateName := MakeIntResource(IDD_COMDLG32);
OpenFileName.Flags := OFN_ALLOWMULTISELECT or OFN_SHOWHELP or OFN_HIDEREADONLY or
OFN_EXPLORER or OFN_ENABLEHOOK or OFN_ENABLETEMPLATE;
if GetOpenFileName(OpenFileName) then
begin
// Open the file.
hFile := CreateFile(LPCSTR(OpenFileName.lpstrFile),
GENERIC_READ,
FILE_SHARE_READ,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
if hFile = - 1 then
begin
MessageBox(Handle, 'Ouverture du fichier non réussi.', nil, MB_OK );
CloseHandle(hFile);
exit;
end;
// Get the size of the file.
dwFileSize := GetFileSize(hFile, nil);
if (dwFileSize = $FFFFFFFF) then
begin
MessageBox( NULL, 'Taille du fichier : Erreur!', nil, MB_OK);
CloseHandle(hFile);
exit;
end;
lpBufPtr := LPSTR(GlobalAlloc(GMEM_FIXED, dwFileSize));
if (lpBufPtr = nil) then
begin
MessageBox(0, 'GlobalAlloc non réussi!', nil, MB_OK);
CloseHandle(hFile);
exit;
end;
// Read it's contents into a buffer.
ReadFile(hFile, lpBufPtr^, dwFileSize, dwBytesRead, nil);
if (dwBytesRead = 0) then
begin
MessageBox(Handle, 'Zéro octet lu.', nil, MB_OK );
GlobalFree(LONGINT(lpBufPtr));
exit;
end;
// Update the MLE with the file contents.
SendMessage(hWndEdit, WM_SETTEXT, 0, LPARAM(lpBufPtr));
// Close the file.
CloseHandle(hFile);
GlobalFree(LONGINT(lpBufPtr));
Result := True;
end
else
Result := False;
end;
function ComDlg32DlgProc(Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): UINT;
var
lpOFN : POpenFileName;
psMyData : LPMYDATA;
begin
Result := 1;
case Msg of
WM_INITDIALOG:
// Save off the long pointer to the OPENFILENAME structure.
SetWindowLong(Wnd, DWL_USER, lParam);
WM_DESTROY:
begin
//LPOPENFILENAME lpOFN = (LPOPENFILENAME)GetWindowLong(hDlg, DWL_USER);
lpOFN := POpenFileName(GetWindowLong(Wnd, DWL_USER));
//psMyData := New(LPMYDATA);
psMyData := LPMYDATA(lpOFN.lCustData);
GetDlgItemText(Wnd, IDE_PATH, psMyData.szTest1, SizeOf(psMyData.szTest1));
GetDlgItemText(Wnd, IDE_SELECTED, psMyData.szTest2, SizeOf(psMyData.szTest2));
end;
WM_NOTIFY:
TestNotify(Wnd, POFNOTIFY(lParam));
else
begin
if (Msg = cdmsgFileOK) then
begin
SetDlgItemText(Wnd, IDE_SELECTED, POpenFileName(lParam).lpstrFile);
if (MessageBox(Wnd, 'Vous avez cliqué sur Ouvrir.' + Chr(13) + Chr(13) + 'Devrais-je l''ouvrir?', 'ComDlg32 Test', MB_YESNO + MB_ICONQUESTION)
= IDNO) then
begin
SetWindowLong(Wnd, DWL_MSGRESULT, 1);
exit;
end;
end
else
if (Msg = cdmsgShareViolation) then
begin
SetDlgItemText(Wnd, IDE_SELECTED, LPSTR(lParam));
MessageBox(Wnd, 'Erreur Violation.', 'ComDlg32 Test', MB_OK + MB_ICONSTOP);
end;
end;
Result := 0;
end;
end;
function TestNotify(hDlg : Integer ; pofn : POfNotify): Bool;
var
szFile : array[0..MAX_PATH] of Char;
szFolder : array[0..MAX_PATH] of Char;
Ret : Integer;
begin
case pofn.hdr.code of
CDN_SELCHANGE:
begin
Ret := SendMessage(GetParent(hDlg), CDM_GETSPEC, SizeOf(szFile), LParam(@szFile));
if Ret <= SizeOf(szFile) then
SetDlgItemText(hDlg, IDE_SELECTED, szFile);
Ret := SendMessage(GetParent(hDlg), CDM_GETFILEPATH, SizeOf(szFile), LParam(@szFile));
if Ret <= SizeOf(szFile) then
SetDlgItemText(hDlg, IDE_PATHFILE, szFile);
//ShowMessage('Fichier : ' + szFile);
end;
CDN_FOLDERCHANGE :
begin
Ret := SendMessage(GetParent(hDlg), CDM_GETFOLDERPATH, SizeOf(szFolder), LParam(@szFolder));
if Ret <= SizeOf(szFolder) then
SetDlgItemText(hDlg, IDE_PATH, szFolder);
//ShowMessage('Dossier : ' + szFolder);
end;
CDN_HELP :
MessageBox(hDlg, 'Vous avez demandé de l''aide.', 'ComDlg32 Test', MB_OK + MB_ICONINFORMATION);
CDN_FILEOK :
begin
// Update the appropriate box.
SetDlgItemText(hDlg, IDE_SELECTED, pofn.lpOFN.lpstrFile);
//SetWindowLong(hDlg, DWL_MSGRESULT, 1);
end;
CDN_SHAREVIOLATION :
begin
// Update the appropriate box.
SetDlgItemText(hDlg, IDE_SELECTED, pofn.pszFile);
MessageBox(hDlg, 'Erreur Violation.', 'ComDlg32 Test', MB_OK + MB_ICONSTOP);
end;
end;
Result := True;
end;
function About(hDlg, Msg, wParam, lParam: integer): integer; stdcall;
begin
Result := 0;
case Msg of
WM_INITDIALOG:
Result := 1;
WM_COMMAND:
begin
if (LOWORD(wParam) = IDOK) or (LOWORD(wParam) = IDCANCEL) then
begin
EndDialog(hDlg, 1);
Result := 1;
end;
end;
end;
end;
end.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.