Getopenfilename personnalisée

Télécharger le projet
Commenter

Description

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.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_kanto)