home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / tpwinst / owl.pak / STDDLGS.PAS next >
Pascal/Delphi Source File  |  1991-05-21  |  7KB  |  254 lines

  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal for Windows                        }
  5. {       Standard dialogs unit for ObjectWindows         }
  6. {                                                       }
  7. {       Copyright (c) 1991 Borland International        }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit StdDlgs;
  12.  
  13. interface
  14.  
  15. uses WinTypes, WinProcs, WinDos, WObjects, Strings;
  16.  
  17. {$R STDDLGS}
  18.  
  19. const
  20.   sd_FileOpen = $7F00;
  21.   sd_FileSave = $7F01;
  22.  
  23. const
  24.   id_FName = 100;
  25.   id_FPath = 101;
  26.   id_FList = 102;
  27.   id_DList = 103;
  28.  
  29. const
  30.   fsFileSpec = fsFileName + fsExtension;
  31.  
  32. type
  33.   PFileDialog = ^TFileDialog;
  34.   TFileDialog = object(TDialog)
  35.     Caption: PChar;
  36.     FilePath: PChar;
  37.     PathName: array[0..fsPathName] of Char;
  38.     Extension: array[0..fsExtension] of Char;
  39.     FileSpec: array[0..fsFileSpec] of Char;
  40.     constructor Init(AParent: PWindowsObject; AName, AFilePath: PChar);
  41.     function CanClose: Boolean; virtual;
  42.     procedure SetupWindow; virtual;
  43.     procedure HandleFName(var Msg: TMessage); virtual id_First + id_FName;
  44.     procedure HandleFList(var Msg: TMessage); virtual id_First + id_FList;
  45.     procedure HandleDList(var Msg: TMessage); virtual id_First + id_DList;
  46.   private
  47.     procedure SelectFileName;
  48.     procedure UpdateFileName;
  49.     function UpdateListBoxes: Boolean;
  50.   end;
  51.  
  52. const
  53.   sd_InputDialog = $7F02;
  54.  
  55. const
  56.   id_Prompt = 100;
  57.   id_Input  = 101;
  58.  
  59. type
  60.   PInputDialog = ^TInputDialog;
  61.   TInputDialog = object(TDialog)
  62.     Caption: PChar;
  63.     Prompt: PChar;
  64.     Buffer: PChar;
  65.     BufferSize: Word;
  66.     constructor Init(AParent: PWindowsObject;
  67.       ACaption, APrompt, ABuffer: PChar; ABufferSize: Word);
  68.     function CanClose: Boolean; virtual;
  69.     procedure SetupWindow; virtual;
  70.   end;
  71.  
  72. implementation
  73.  
  74. function GetFileName(FilePath: PChar): PChar;
  75. var
  76.   P: PChar;
  77. begin
  78.   P := StrRScan(FilePath, '\');
  79.   if P = nil then P := StrRScan(FilePath, ':');
  80.   if P = nil then GetFileName := FilePath else GetFileName := P + 1;
  81. end;
  82.  
  83. function GetExtension(FilePath: PChar): PChar;
  84. var
  85.   P: PChar;
  86. begin
  87.   P := StrScan(GetFileName(FilePath), '.');
  88.   if P = nil then GetExtension := StrEnd(FilePath) else GetExtension := P;
  89. end;
  90.  
  91. function HasWildCards(FilePath: PChar): Boolean;
  92. begin
  93.   HasWildCards := (StrScan(FilePath, '*') <> nil) or
  94.     (StrScan(FilePath, '?') <> nil);
  95. end;
  96.  
  97. { TFileDialog }
  98.  
  99. constructor TFileDialog.Init(AParent: PWindowsObject;
  100.   AName, AFilePath: PChar);
  101. begin
  102.   TDialog.Init(AParent, AName);
  103.   Caption := nil;
  104.   FilePath := AFilePath;
  105. end;
  106.  
  107. function TFileDialog.CanClose: Boolean;
  108. var
  109.   PathLen: Word;
  110. begin
  111.   CanClose := False;
  112.   GetDlgItemText(HWindow, id_FName, PathName, fsPathName + 1);
  113.   FileExpand(PathName, PathName);
  114.   PathLen := StrLen(PathName);
  115.   if (PathName[PathLen - 1] = '\') or HasWildCards(PathName) or
  116.     (GetFocus = GetDlgItem(HWindow, id_DList)) then
  117.   begin
  118.     if PathName[PathLen - 1] = '\' then
  119.       StrLCat(PathName, FileSpec, fsPathName);
  120.     if not UpdateListBoxes then
  121.     begin
  122.       MessageBeep(0);
  123.       SelectFileName;
  124.     end;
  125.     Exit;
  126.   end;
  127.   StrLCat(StrLCat(PathName, '\', fsPathName), FileSpec, fsPathName);
  128.   if UpdateListBoxes then Exit;
  129.   PathName[PathLen] := #0;
  130.   if GetExtension(PathName)[0] = #0 then
  131.     StrLCat(PathName, Extension, fsPathName);
  132.   AnsiLower(StrCopy(FilePath, PathName));
  133.   CanClose := True;
  134. end;
  135.  
  136. procedure TFileDialog.SetupWindow;
  137. begin
  138.   SendDlgItemMessage(HWindow, id_FName, em_LimitText, fsPathName, 0);
  139.   if Caption <> nil then SetWindowText(HWindow, Caption);
  140.   StrLCopy(PathName, FilePath, fsPathName);
  141.   StrLCopy(Extension, GetExtension(PathName), fsExtension);
  142.   if HasWildCards(Extension) then Extension[0] := #0;
  143.   if not UpdateListBoxes then
  144.   begin
  145.     StrCopy(PathName, '*.*');
  146.     UpdateListBoxes;
  147.   end;
  148.   SelectFileName;
  149. end;
  150.  
  151. procedure TFileDialog.HandleFName(var Msg: TMessage);
  152. begin
  153.   if Msg.LParamHi = en_Change then
  154.     EnableWindow(GetDlgItem(HWindow, id_Ok),
  155.       SendMessage(Msg.LParamLo, wm_GetTextLength, 0, 0) <> 0);
  156. end;
  157.  
  158. procedure TFileDialog.HandleFList(var Msg: TMessage);
  159. begin
  160.   case Msg.LParamHi of
  161.     lbn_SelChange, lbn_DblClk:
  162.       begin
  163.         DlgDirSelect(HWindow, PathName, id_FList);
  164.         UpdateFileName;
  165.         if Msg.LParamHi = lbn_DblClk then Ok(Msg);
  166.       end;
  167.     lbn_KillFocus:
  168.       SendMessage(Msg.LParamLo, lb_SetCurSel, Word(-1), 0);
  169.   end;
  170. end;
  171.  
  172. procedure TFileDialog.HandleDList(var Msg: TMessage);
  173. begin
  174.   case Msg.LParamHi of
  175.     lbn_SelChange, lbn_DblClk:
  176.       begin
  177.         DlgDirSelect(HWindow, PathName, id_DList);
  178.         StrCat(PathName, FileSpec);
  179.         if Msg.LParamHi = lbn_DblClk then
  180.           UpdateListBoxes else
  181.           UpdateFileName;
  182.       end;
  183.     lbn_KillFocus:
  184.       SendMessage(Msg.LParamLo, lb_SetCurSel, Word(-1), 0);
  185.   end;
  186. end;
  187.  
  188. procedure TFileDialog.SelectFileName;
  189. begin
  190.   SendDlgItemMessage(HWindow, id_FName, em_SetSel, 0, $7FFF0000);
  191.   SetFocus(GetDlgItem(HWindow, id_FName));
  192. end;
  193.  
  194. procedure TFileDialog.UpdateFileName;
  195. begin
  196.   SetDlgItemText(HWindow, id_FName, AnsiLower(PathName));
  197.   SendDlgItemMessage(HWindow, id_FName, em_SetSel, 0, $7FFF0000);
  198. end;
  199.  
  200. function TFileDialog.UpdateListBoxes: Boolean;
  201. var
  202.   Result: Integer;
  203.   Path: array[0..fsPathName] of Char;
  204. begin
  205.   UpdateListBoxes := False;
  206.   if GetDlgItem(HWindow, id_FList) <> 0 then
  207.   begin
  208.     StrCopy(Path, PathName);
  209.     Result := DlgDirList(HWindow, Path, id_FList, id_FPath, 0);
  210.     if Result <> 0 then DlgDirList(HWindow, '*.*', id_DList, 0, $C010);
  211.   end else
  212.   begin
  213.     StrLCopy(Path, PathName, GetFileName(PathName) - PathName);
  214.     StrLCat(Path, '*.*', fsPathName);
  215.     Result := DlgDirList(HWindow, Path, id_DList, id_FPath, $C010);
  216.   end;
  217.   if Result <> 0 then
  218.   begin
  219.     StrLCopy(FileSpec, GetFileName(PathName), fsFileSpec);
  220.     StrCopy(PathName, FileSpec);
  221.     UpdateFileName;
  222.     UpdateListBoxes := True;
  223.   end;
  224. end;
  225.  
  226. { TInputDialog }
  227.  
  228. constructor TInputDialog.Init(AParent: PWindowsObject;
  229.   ACaption, APrompt, ABuffer: PChar; ABufferSize: Word);
  230. begin
  231.   TDialog.Init(AParent, PChar(sd_InputDialog));
  232.   Caption := ACaption;
  233.   Prompt := APrompt;
  234.   Buffer := ABuffer;
  235.   BufferSize := ABufferSize;
  236. end;
  237.  
  238. function TInputDialog.CanClose: Boolean;
  239. begin
  240.   GetDlgItemText(HWindow, id_Input, Buffer, BufferSize);
  241.   CanClose := True;
  242. end;
  243.  
  244. procedure TInputDialog.SetupWindow;
  245. begin
  246.   TDialog.SetupWindow;
  247.   SetWindowText(HWindow, Caption);
  248.   SetDlgItemText(HWindow, id_Prompt, Prompt);
  249.   SetDlgItemText(HWindow, id_Input, Buffer);
  250.   SendDlgItemMessage(HWindow, id_Input, em_LimitText, BufferSize - 1, 0);
  251. end;
  252.  
  253. end.
  254.