home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / pcmagazi / 1992 / 19 / utest2.pas < prev    next >
Pascal/Delphi Source File  |  1992-07-26  |  3KB  |  129 lines
  1. {
  2. TITLE:  Unit UTEST2.PAS
  3. Caption:Figure 6:  The source code for TFileDlg, an OWL object that interfaces with and processes messages
  4. for the Open File common dialog.
  5. }
  6.  
  7.  
  8. unit UTest2;
  9.  
  10. interface
  11.  
  12. uses winprocs, wintypes, wobjects, commdlg, windos, strings;
  13.  
  14. type
  15.    PFileDlg = ^TFileDlg;
  16.    TFileDlg = object(TDialog)
  17.      OFN : TOpenFileName;
  18.      constructor Init(AParent : PWindowsObject;
  19.                       AFlags   : Longint;
  20.                       AFileName : Pchar;
  21.                       ANameLength : Integer);
  22.          destructor  Done;  virtual;
  23.      function    Create : Boolean; virtual;
  24.      function    Execute : Integer; virtual;
  25.      procedure   OK(var Msg : TMessage);     virtual id_First+id_OK;
  26.      procedure   Cancel(var Msg : TMessage); virtual id_First+id_Cancel;
  27.    end;
  28.  
  29.  
  30. implementation
  31.  
  32. constructor TFileDlg.Init(AParent : PWindowsObject;
  33.                           AFlags   : Longint;
  34.                           AFileName : Pchar;
  35.                           ANameLength : Integer);
  36. var
  37.   TempName : array[0..fsFileName] of Char;
  38.   TempExt  : array[0..fsExtension] of Char;
  39.  
  40. begin
  41.    TDialog.Init(AParent,nil);
  42.    FillChar(OFN,Sizeof(OFN),0);
  43.    with OFN do
  44.    begin
  45.      lStructSize := SizeOf(OFN);
  46.      hwndOwner := AParent^.hWindow;
  47.      @lpfnHook := Instance;
  48.      Flags     := AFlags or OFN_ENABLEHOOK;
  49.      hInstance := System.hInstance;
  50.      lpstrFileTitle  := nil;
  51.      nMaxFileTitle   := 0 ;
  52.      GetMem(lpstrInitialDir,Succ(fsDirectory));
  53.      lpstrFile := AFileName;
  54.      nMaxFile        := ANameLength;
  55.      lpStrTitle := 'Open File';
  56.      FileExpand(lpstrFile,AFileName);
  57.      FileSplit(lpstrFile,lpstrInitialDir,TempName,TempExt);
  58.      StrCat(StrCopy(lpstrFile,TempName),TempExt);
  59.    end;
  60. end;
  61.  
  62.  
  63. destructor TFileDlg.Done;
  64. begin
  65.  FreeMem(OFN.lpstrInitialDir,Succ(fsDirectory));
  66.  TDialog.Done;
  67. end;
  68.  
  69.  
  70.  
  71. function    TFileDlg.Create : boolean;
  72. begin
  73.   Create := False;  { Cannot create a non-modal File Open dialog }
  74. end;
  75.  
  76.  
  77. function    TFileDlg.Execute : integer;
  78. { Basically, This is the code from TDialog.Execute with the call to
  79.   DialogBoxParam changed to GetOpenFileName }
  80. var
  81.   CDError : Longint;
  82.   OldKbHandler: PWindowsObject;
  83. begin
  84.   if Status = 0 then
  85.   begin
  86.     DisableAutoCreate;
  87.     EnableKBHandler;
  88.     IsModal := True;
  89.     OldKbHandler := Application^.KBHandlerWnd;
  90.     if GetOpenFileName(OFN) then
  91.       Execute := id_ok
  92.     else
  93.     begin
  94.       CDError := CommDlgExtendedError;
  95.       if CDError = 0 then
  96.         execute := id_Cancel
  97.       else
  98.       begin
  99.         Status := -CdError;
  100.         Execute := Status;
  101.       end;
  102.     end;
  103.     Application^.KBHandlerWnd := OldKbHandler;
  104.     HWindow := 0;
  105.   end
  106.   else Execute := Status;
  107. end;
  108.  
  109.  
  110. procedure   TFileDlg.OK(var Msg : TMessage);
  111. { COMMDLG requires that the hook function (ie: this method) does NOT
  112.   call EndDlg() for it's modal dialogs.  Setting Msg.Result to 0 will
  113.   allow COMMDLG to terminate the dialog.  A value of 1 will cause
  114.   COMMDLG to ignore the OK button press. }
  115. begin
  116.   if CanClose then
  117.     Msg.Result := 0
  118.   else
  119.     Msg.Result := 1;
  120. end;
  121.  
  122. procedure   TFileDlg.Cancel(var Msg : TMessage);
  123. begin
  124.   Msg.Result := 0
  125. end;
  126.  
  127.  
  128. end.
  129.