ComboEdit.pas 27 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042
  1. unit ComboEdit;
  2. {$J+}
  3. {$WARN UNIT_PLATFORM OFF}
  4. interface
  5. uses Windows, Classes, StdCtrls, Controls, Messages, Forms, Graphics,
  6. Menus, Buttons, Dialogs, Mask,
  7. { SysUtils must overload deprecated FileCtrl (implements SelectDirectory) }
  8. FileCtrl, SysUtils;
  9. const
  10. scAltDown = scAlt + vk_Down;
  11. scCtrlEnter = scCtrl + vk_Return;
  12. DefEditBtnWidth = 25;
  13. resourcestring
  14. SBrowse = 'Browse';
  15. SDefaultFilter = 'All files (*.*)|*.*';
  16. SInvalidFileName = 'Invalid file name - %s';
  17. type
  18. TFileExt = type string;
  19. { TCustomComboEdit }
  20. TCustomComboEdit = class(TCustomEdit)
  21. private
  22. FButton: TButton;
  23. FBtnControl: TWinControl;
  24. FOnButtonClick: TNotifyEvent;
  25. FClickKey: TShortCut;
  26. procedure SetEditRect;
  27. procedure UpdateBtnBounds;
  28. procedure EditButtonClick(Sender: TObject);
  29. function GetMinHeight: Integer;
  30. function GetTextHeight: Integer;
  31. function GetButtonWidth: Integer;
  32. procedure SetButtonWidth(Value: Integer);
  33. function GetButtonHint: string;
  34. procedure SetButtonHint(const Value: string);
  35. function BtnWidthStored: Boolean;
  36. procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  37. procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  38. procedure CNCtlColor(var Message: TMessage); message CN_CTLCOLOREDIT;
  39. procedure WMSize(var Message: TWMSize); message WM_SIZE;
  40. procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  41. protected
  42. procedure CreateParams(var Params: TCreateParams); override;
  43. procedure CreateWnd; override;
  44. procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  45. procedure ButtonClick; dynamic;
  46. property Button: TButton read FButton;
  47. property ClickKey: TShortCut read FClickKey write FClickKey
  48. default scAltDown;
  49. property ButtonWidth: Integer read GetButtonWidth write SetButtonWidth
  50. stored BtnWidthStored;
  51. property ButtonHint: string read GetButtonHint write SetButtonHint;
  52. property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
  53. public
  54. constructor Create(AOwner: TComponent); override;
  55. destructor Destroy; override;
  56. procedure DoClick;
  57. end;
  58. type
  59. TComboEdit = class(TCustomComboEdit)
  60. published
  61. property AutoSelect;
  62. property ButtonHint;
  63. property BorderStyle;
  64. property CharCase;
  65. property ClickKey;
  66. property Color;
  67. property Ctl3D;
  68. property DragCursor;
  69. property DragMode;
  70. property Enabled;
  71. property Font;
  72. property ButtonWidth;
  73. property HideSelection;
  74. property Anchors;
  75. property BiDiMode;
  76. property Constraints;
  77. property DragKind;
  78. property ParentBiDiMode;
  79. property ImeMode;
  80. property ImeName;
  81. property ParentColor;
  82. property ParentCtl3D;
  83. property ParentFont;
  84. property ParentShowHint;
  85. property PopupMenu;
  86. property ShowHint;
  87. property TabOrder;
  88. property TabStop;
  89. property Text;
  90. property Visible;
  91. property OnButtonClick;
  92. property OnChange;
  93. property OnClick;
  94. property OnDblClick;
  95. property OnDragDrop;
  96. property OnDragOver;
  97. property OnEndDrag;
  98. property OnEnter;
  99. property OnExit;
  100. property OnKeyDown;
  101. property OnKeyPress;
  102. property OnKeyUp;
  103. property OnMouseDown;
  104. property OnMouseMove;
  105. property OnMouseUp;
  106. property OnStartDrag;
  107. property OnContextPopup;
  108. property OnEndDock;
  109. property OnStartDock;
  110. end;
  111. { TFileDirEdit }
  112. { The common parent of TFilenameEdit and TDirectoryEdit }
  113. { For internal use only; it's not intended to be used separately }
  114. const
  115. MaxFileLength = SizeOf(TFileName) - 1;
  116. type
  117. TExecOpenDialogEvent = procedure(Sender: TObject; var Name: string;
  118. var Action: Boolean) of object;
  119. TFileDirEdit = class(TCustomComboEdit)
  120. private
  121. FErrMode: Cardinal;
  122. FAcceptFiles: Boolean;
  123. FOnDropFiles: TNotifyEvent;
  124. FOnBeforeDialog: TExecOpenDialogEvent;
  125. FOnAfterDialog: TExecOpenDialogEvent;
  126. procedure SetDragAccept(Value: Boolean);
  127. procedure SetAcceptFiles(Value: Boolean);
  128. procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
  129. protected
  130. FMultipleDirs: Boolean;
  131. procedure CreateHandle; override;
  132. procedure DestroyWindowHandle; override;
  133. procedure DoAfterDialog(var FileName: string; var Action: Boolean); dynamic;
  134. procedure DoBeforeDialog(var FileName: string; var Action: Boolean); dynamic;
  135. procedure ReceptFileDir(const AFileName: string); virtual; abstract;
  136. procedure ClearFileList; virtual;
  137. procedure DisableSysErrors;
  138. procedure EnableSysErrors;
  139. property MaxLength;
  140. published
  141. property AcceptFiles: Boolean read FAcceptFiles write SetAcceptFiles default False;
  142. property OnBeforeDialog: TExecOpenDialogEvent read FOnBeforeDialog
  143. write FOnBeforeDialog;
  144. property OnAfterDialog: TExecOpenDialogEvent read FOnAfterDialog
  145. write FOnAfterDialog;
  146. property OnDropFiles: TNotifyEvent read FOnDropFiles write FOnDropFiles;
  147. property OnButtonClick;
  148. end;
  149. { TFilenameEdit }
  150. TFileDialogKind = (dkOpen, dkSave , dkOpenPicture,
  151. dkSavePicture);
  152. TFilenameEdit = class(TFileDirEdit)
  153. private
  154. FDialog: TOpenDialog;
  155. FDialogKind: TFileDialogKind;
  156. procedure CreateEditDialog;
  157. function GetFileName: string;
  158. function GetDefaultExt: TFileExt;
  159. function GetFileEditStyle: TFileEditStyle;
  160. function GetFilter: string;
  161. function GetFilterIndex: Integer;
  162. function GetInitialDir: string;
  163. function GetHistoryList: TStrings;
  164. function GetOptions: TOpenOptions;
  165. function GetDialogTitle: string;
  166. function GetDialogFiles: TStrings;
  167. procedure SetDialogKind(Value: TFileDialogKind);
  168. procedure SetFileName(const Value: string);
  169. procedure SetDefaultExt(Value: TFileExt);
  170. procedure SetFileEditStyle(Value: TFileEditStyle);
  171. procedure SetFilter(const Value: string);
  172. procedure SetFilterIndex(Value: Integer);
  173. procedure SetInitialDir(const Value: string);
  174. procedure SetHistoryList(Value: TStrings);
  175. procedure SetOptions(Value: TOpenOptions);
  176. procedure SetDialogTitle(const Value: string);
  177. function IsCustomTitle: Boolean;
  178. function IsCustomFilter: Boolean;
  179. protected
  180. procedure ButtonClick; override;
  181. procedure ReceptFileDir(const AFileName: string); override;
  182. procedure ClearFileList; override;
  183. public
  184. constructor Create(AOwner: TComponent); override;
  185. property Dialog: TOpenDialog read FDialog;
  186. property DialogFiles: TStrings read GetDialogFiles;
  187. published
  188. property DialogKind: TFileDialogKind read FDialogKind write SetDialogKind
  189. default dkOpen;
  190. property DefaultExt: TFileExt read GetDefaultExt write SetDefaultExt;
  191. property FileEditStyle: TFileEditStyle read GetFileEditStyle write SetFileEditStyle
  192. default fsEdit;
  193. property FileName: string read GetFileName write SetFileName stored False;
  194. property Filter: string read GetFilter write SetFilter stored IsCustomFilter;
  195. property FilterIndex: Integer read GetFilterIndex write SetFilterIndex default 1;
  196. property InitialDir: string read GetInitialDir write SetInitialDir;
  197. property HistoryList: TStrings read GetHistoryList write SetHistoryList;
  198. property DialogOptions: TOpenOptions read GetOptions write SetOptions
  199. default [ofHideReadOnly];
  200. property DialogTitle: string read GetDialogTitle write SetDialogTitle
  201. stored IsCustomTitle;
  202. property AutoSelect;
  203. property ButtonHint;
  204. property BorderStyle;
  205. property CharCase;
  206. property ClickKey;
  207. property Color;
  208. property Ctl3D;
  209. property DragCursor;
  210. property DragMode;
  211. property Enabled;
  212. property Font;
  213. property ButtonWidth;
  214. property HideSelection;
  215. property Anchors;
  216. property BiDiMode;
  217. property Constraints;
  218. property DragKind;
  219. property ParentBiDiMode;
  220. property ImeMode;
  221. property ImeName;
  222. property ParentColor;
  223. property ParentCtl3D;
  224. property ParentFont;
  225. property ParentShowHint;
  226. property PopupMenu;
  227. property ShowHint;
  228. property TabOrder;
  229. property TabStop;
  230. property Text;
  231. property Visible;
  232. property OnChange;
  233. property OnClick;
  234. property OnDblClick;
  235. property OnDragDrop;
  236. property OnDragOver;
  237. property OnEndDrag;
  238. property OnEnter;
  239. property OnExit;
  240. property OnKeyDown;
  241. property OnKeyPress;
  242. property OnKeyUp;
  243. property OnMouseDown;
  244. property OnMouseMove;
  245. property OnMouseUp;
  246. property OnStartDrag;
  247. property OnContextPopup;
  248. property OnEndDock;
  249. property OnStartDock;
  250. end;
  251. { TDirectoryEdit }
  252. TDirectoryEdit = class(TFileDirEdit)
  253. private
  254. FInitialDir: string;
  255. FDialogText: string;
  256. protected
  257. procedure ButtonClick; override;
  258. procedure ReceptFileDir(const AFileName: string); override;
  259. public
  260. constructor Create(AOwner: TComponent); override;
  261. published
  262. property DialogText: string read FDialogText write FDialogText;
  263. property InitialDir: string read FInitialDir write FInitialDir;
  264. property MultipleDirs: Boolean read FMultipleDirs write FMultipleDirs default False;
  265. property AutoSelect;
  266. property ButtonHint;
  267. property BorderStyle;
  268. property CharCase;
  269. property ClickKey;
  270. property Color;
  271. property Ctl3D;
  272. property DragCursor;
  273. property DragMode;
  274. property Enabled;
  275. property Font;
  276. property ButtonWidth;
  277. property HideSelection;
  278. property Anchors;
  279. property BiDiMode;
  280. property Constraints;
  281. property DragKind;
  282. property ParentBiDiMode;
  283. property ImeMode;
  284. property ImeName;
  285. property ParentColor;
  286. property ParentCtl3D;
  287. property ParentFont;
  288. property ParentShowHint;
  289. property PopupMenu;
  290. property ShowHint;
  291. property TabOrder;
  292. property TabStop;
  293. property Text;
  294. property Visible;
  295. property OnChange;
  296. property OnClick;
  297. property OnDblClick;
  298. property OnDragDrop;
  299. property OnDragOver;
  300. property OnEndDrag;
  301. property OnEnter;
  302. property OnExit;
  303. property OnKeyDown;
  304. property OnKeyPress;
  305. property OnKeyUp;
  306. property OnMouseDown;
  307. property OnMouseMove;
  308. property OnMouseUp;
  309. property OnStartDrag;
  310. property OnContextPopup;
  311. property OnEndDock;
  312. property OnStartDock;
  313. end;
  314. EComboEditError = class(Exception);
  315. procedure Register;
  316. implementation
  317. uses
  318. ShellAPI, Consts, ExtDlgs, Variants, PasTools, UITypes;
  319. procedure Register;
  320. begin
  321. RegisterComponents('Martin', [TComboEdit, TFilenameEdit, TDirectoryEdit]);
  322. end;
  323. { Utility functions }
  324. type
  325. TCharSet = TSysCharSet;
  326. function ExtractSubstr(const S: string; var Pos: Integer;
  327. const Delims: TCharSet): string;
  328. var
  329. I: Integer;
  330. begin
  331. I := Pos;
  332. while (I <= Length(S)) and not CharInSet(S[I], Delims) do Inc(I);
  333. Result := Copy(S, Pos, I - Pos);
  334. if (I <= Length(S)) and CharInSet(S[I], Delims) then Inc(I);
  335. Pos := I;
  336. end;
  337. function ValidFileName(const FileName: string): Boolean;
  338. function HasAny(const Str, Substr: string): Boolean;
  339. var
  340. I: Integer;
  341. begin
  342. Result := False;
  343. for I := 1 to Length(Substr) do begin
  344. if Pos(Substr[I], Str) > 0 then begin
  345. Result := True;
  346. Break;
  347. end;
  348. end;
  349. end;
  350. begin
  351. Result := (FileName <> '') and (not HasAny(FileName, '<>"[]|'));
  352. if Result then Result := Pos('\', ExtractFileName(FileName)) = 0;
  353. end;
  354. { TCustomComboEdit }
  355. constructor TCustomComboEdit.Create(AOwner: TComponent);
  356. begin
  357. inherited Create(AOwner);
  358. ControlStyle := ControlStyle + [csCaptureMouse];
  359. AutoSize := False;
  360. FClickKey := scCtrlEnter;
  361. FBtnControl := TWinControl.Create(Self);
  362. with FBtnControl do
  363. begin
  364. ControlStyle := ControlStyle + [csReplicatable];
  365. Width := DefEditBtnWidth;
  366. Height := 17;
  367. Visible := True;
  368. Parent := Self;
  369. end;
  370. FButton := TButton.Create(Self);
  371. with FButton do
  372. begin
  373. SetBounds(0, 0, FBtnControl.Width, FBtnControl.Height);
  374. ControlStyle := ControlStyle + [csReplicatable];
  375. ParentShowHint := True;
  376. Caption := '...';
  377. Visible := True;
  378. Parent := FBtnControl;
  379. OnClick := EditButtonClick;
  380. end;
  381. Height := 21;
  382. end;
  383. destructor TCustomComboEdit.Destroy;
  384. begin
  385. FButton.OnClick := nil;
  386. inherited Destroy;
  387. end;
  388. procedure TCustomComboEdit.CreateParams(var Params: TCreateParams);
  389. begin
  390. inherited CreateParams(Params);
  391. Params.Style := Params.Style or WS_CLIPCHILDREN;
  392. end;
  393. procedure TCustomComboEdit.CreateWnd;
  394. begin
  395. inherited CreateWnd;
  396. SetEditRect;
  397. end;
  398. procedure TCustomComboEdit.KeyDown(var Key: Word; Shift: TShiftState);
  399. begin
  400. inherited KeyDown(Key, Shift);
  401. if (FClickKey = ShortCut(Key, Shift)) and (ButtonWidth > 0) then
  402. begin
  403. EditButtonClick(Self);
  404. Key := 0;
  405. end;
  406. end;
  407. function TCustomComboEdit.GetButtonWidth: Integer;
  408. begin
  409. Result := FButton.Width;
  410. end;
  411. procedure TCustomComboEdit.SetButtonWidth(Value: Integer);
  412. begin
  413. if ButtonWidth <> Value then
  414. begin
  415. FBtnControl.Visible := Value > 1;
  416. if (csCreating in ControlState) then
  417. begin
  418. FBtnControl.Width := Value;
  419. FButton.Width := Value;
  420. with FButton do
  421. ControlStyle := ControlStyle - [csFixedWidth];
  422. end
  423. else if (Value <> ButtonWidth) and (Value < ClientWidth) then
  424. begin
  425. FButton.Width := Value;
  426. with FButton do
  427. ControlStyle := ControlStyle - [csFixedWidth];
  428. if HandleAllocated then RecreateWnd;
  429. end;
  430. end;
  431. end;
  432. function TCustomComboEdit.GetButtonHint: string;
  433. begin
  434. Result := FButton.Hint;
  435. end;
  436. procedure TCustomComboEdit.SetButtonHint(const Value: string);
  437. begin
  438. FButton.Hint := Value;
  439. end;
  440. procedure TCustomComboEdit.SetEditRect;
  441. var
  442. Loc: TRect;
  443. begin
  444. SetRect(Loc, 0, 0, ClientWidth - FBtnControl.Width - 2, ClientHeight + 1);
  445. SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
  446. end;
  447. procedure TCustomComboEdit.UpdateBtnBounds;
  448. var
  449. BtnRect: TRect;
  450. begin
  451. if NewStyleControls then begin
  452. if Ctl3D and (BorderStyle = bsSingle) then
  453. BtnRect := Bounds(Width - FButton.Width - 4, 0,
  454. FButton.Width, Height - 4)
  455. else begin
  456. if BorderStyle = bsSingle then
  457. BtnRect := Bounds(Width - FButton.Width - 2, 2,
  458. FButton.Width, Height - 4)
  459. else
  460. BtnRect := Bounds(Width - FButton.Width, 0,
  461. FButton.Width, Height);
  462. end;
  463. end
  464. else
  465. BtnRect := Bounds(Width - FButton.Width, 0, FButton.Width, Height);
  466. with BtnRect do
  467. FBtnControl.SetBounds(Left, Top, Right - Left, Bottom - Top);
  468. FButton.Height := FBtnControl.Height;
  469. SetEditRect;
  470. end;
  471. procedure TCustomComboEdit.CMCtl3DChanged(var Message: TMessage);
  472. begin
  473. inherited;
  474. UpdateBtnBounds;
  475. end;
  476. procedure TCustomComboEdit.WMSize(var Message: TWMSize);
  477. var
  478. MinHeight: Integer;
  479. begin
  480. inherited;
  481. if not (csLoading in ComponentState) then
  482. begin
  483. MinHeight := GetMinHeight;
  484. { text edit bug: if size to less than MinHeight, then edit ctrl does
  485. not display the text }
  486. if Height < MinHeight then
  487. begin
  488. Height := MinHeight;
  489. Exit;
  490. end;
  491. end;
  492. UpdateBtnBounds;
  493. end;
  494. function TCustomComboEdit.GetTextHeight: Integer;
  495. var
  496. DC: HDC;
  497. SaveFont: HFont;
  498. SysMetrics, Metrics: TTextMetric;
  499. begin
  500. DC := GetDC(0);
  501. try
  502. GetTextMetrics(DC, SysMetrics);
  503. SaveFont := SelectObject(DC, Font.Handle);
  504. GetTextMetrics(DC, Metrics);
  505. SelectObject(DC, SaveFont);
  506. finally
  507. ReleaseDC(0, DC);
  508. end;
  509. if SysMetrics.tmHeight < Metrics.tmHeight then Result := SysMetrics.tmHeight
  510. else Result := Metrics.tmHeight;
  511. end;
  512. function TCustomComboEdit.GetMinHeight: Integer;
  513. var
  514. I: Integer;
  515. begin
  516. I := GetTextHeight;
  517. Result := I + GetSystemMetricsForControl(Self, SM_CYBORDER) * 4 + 1;
  518. end;
  519. procedure TCustomComboEdit.CMFontChanged(var Message: TMessage);
  520. begin
  521. inherited;
  522. if HandleAllocated then SetEditRect;
  523. end;
  524. procedure TCustomComboEdit.CMEnabledChanged(var Message: TMessage);
  525. begin
  526. inherited;
  527. FButton.Enabled := Enabled;
  528. end;
  529. procedure TCustomComboEdit.CNCtlColor(var Message: TMessage);
  530. var
  531. TextColor: Longint;
  532. begin
  533. inherited;
  534. if NewStyleControls then begin
  535. TextColor := ColorToRGB(Font.Color);
  536. if not Enabled and (ColorToRGB(Color) <> ColorToRGB(clGrayText)) then
  537. TextColor := ColorToRGB(clGrayText);
  538. SetTextColor(Message.WParam, TextColor);
  539. end;
  540. end;
  541. procedure TCustomComboEdit.EditButtonClick(Sender: TObject);
  542. begin
  543. ButtonClick;
  544. end;
  545. procedure TCustomComboEdit.DoClick;
  546. begin
  547. EditButtonClick(Self);
  548. end;
  549. procedure TCustomComboEdit.ButtonClick;
  550. begin
  551. if Assigned(FOnButtonClick) then FOnButtonClick(Self);
  552. end;
  553. function TCustomComboEdit.BtnWidthStored: Boolean;
  554. begin
  555. Result := ButtonWidth <> DefEditBtnWidth;
  556. end;
  557. { TFileDirEdit }
  558. procedure TFileDirEdit.DoBeforeDialog(var FileName: string;
  559. var Action: Boolean);
  560. begin
  561. if Assigned(FOnBeforeDialog) then FOnBeforeDialog(Self, FileName, Action);
  562. end;
  563. procedure TFileDirEdit.DoAfterDialog(var FileName: string;
  564. var Action: Boolean);
  565. begin
  566. if Assigned(FOnAfterDialog) then FOnAfterDialog(Self, FileName, Action);
  567. end;
  568. procedure TFileDirEdit.CreateHandle;
  569. begin
  570. inherited CreateHandle;
  571. if FAcceptFiles then SetDragAccept(True);
  572. end;
  573. procedure TFileDirEdit.DestroyWindowHandle;
  574. begin
  575. SetDragAccept(False);
  576. inherited DestroyWindowHandle;
  577. end;
  578. procedure TFileDirEdit.SetDragAccept(Value: Boolean);
  579. begin
  580. if not (csDesigning in ComponentState) and (Handle <> 0) then
  581. DragAcceptFiles(Handle, Value);
  582. end;
  583. procedure TFileDirEdit.SetAcceptFiles(Value: Boolean);
  584. begin
  585. if FAcceptFiles <> Value then begin
  586. SetDragAccept(Value);
  587. FAcceptFiles := Value;
  588. end;
  589. end;
  590. procedure TFileDirEdit.DisableSysErrors;
  591. begin
  592. FErrMode := SetErrorMode(SEM_NOOPENFILEERRORBOX or SEM_FAILCRITICALERRORS);
  593. end;
  594. procedure TFileDirEdit.EnableSysErrors;
  595. begin
  596. SetErrorMode(FErrMode);
  597. FErrMode := 0;
  598. end;
  599. procedure TFileDirEdit.WMDropFiles(var Msg: TWMDropFiles);
  600. var
  601. AFileName: array[0..255] of Char;
  602. I, Num: Cardinal;
  603. begin
  604. Msg.Result := 0;
  605. try
  606. Num := DragQueryFile(Msg.Drop, $FFFFFFFF, nil, 0);
  607. if Num > 0 then begin
  608. ClearFileList;
  609. for I := 0 to Num - 1 do begin
  610. DragQueryFile(Msg.Drop, I, PChar(@AFileName), Pred(SizeOf(AFileName)));
  611. ReceptFileDir(StrPas(AFileName));
  612. if not FMultipleDirs then Break;
  613. end;
  614. if Assigned(FOnDropFiles) then FOnDropFiles(Self);
  615. end;
  616. finally
  617. DragFinish(Msg.Drop);
  618. end;
  619. end;
  620. procedure TFileDirEdit.ClearFileList;
  621. begin
  622. end;
  623. { TFilenameEdit }
  624. function StrPAlloc(const S: string): PChar;
  625. begin
  626. Result := StrPCopy(StrAlloc(Length(S) + 1), S);
  627. end;
  628. function GetParamStr(P: PChar; var Param: string): PChar;
  629. var
  630. Len: Integer;
  631. Buffer: array[Byte] of Char;
  632. begin
  633. while True do
  634. begin
  635. while (P[0] <> #0) and (P[0] <= ' ') do Inc(P);
  636. if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break;
  637. end;
  638. Len := 0;
  639. while P[0] > ' ' do
  640. if P[0] = '"' then
  641. begin
  642. Inc(P);
  643. while (P[0] <> #0) and (P[0] <> '"') do
  644. begin
  645. Buffer[Len] := P[0];
  646. Inc(Len);
  647. Inc(P);
  648. end;
  649. if P[0] <> #0 then Inc(P);
  650. end else
  651. begin
  652. Buffer[Len] := P[0];
  653. Inc(Len);
  654. Inc(P);
  655. end;
  656. SetString(Param, Buffer, Len);
  657. Result := P;
  658. end;
  659. function ParamCountFromCommandLine(CmdLine: PChar): Integer;
  660. var
  661. S: string;
  662. P: PChar;
  663. begin
  664. P := CmdLine;
  665. Result := 0;
  666. while True do
  667. begin
  668. P := GetParamStr(P, S);
  669. if S = '' then Break;
  670. Inc(Result);
  671. end;
  672. end;
  673. function ParamStrFromCommandLine(CmdLine: PChar; Index: Integer): string;
  674. var
  675. P: PChar;
  676. begin
  677. P := CmdLine;
  678. while True do
  679. begin
  680. P := GetParamStr(P, Result);
  681. if (Index = 0) or (Result = '') then Break;
  682. Dec(Index);
  683. end;
  684. end;
  685. procedure SplitCommandLine(const CmdLine: string; var ExeName,
  686. Params: string);
  687. var
  688. Buffer: PChar;
  689. Cnt, I: Integer;
  690. S: string;
  691. begin
  692. ExeName := '';
  693. Params := '';
  694. Buffer := StrPAlloc(CmdLine);
  695. try
  696. Cnt := ParamCountFromCommandLine(Buffer);
  697. if Cnt > 0 then begin
  698. ExeName := ParamStrFromCommandLine(Buffer, 0);
  699. for I := 1 to Cnt - 1 do begin
  700. S := ParamStrFromCommandLine(Buffer, I);
  701. if Pos(' ', S) > 0 then S := '"' + S + '"';
  702. Params := Params + S;
  703. if I < Cnt - 1 then Params := Params + ' ';
  704. end;
  705. end;
  706. finally
  707. StrDispose(Buffer);
  708. end;
  709. end;
  710. constructor TFilenameEdit.Create(AOwner: TComponent);
  711. begin
  712. inherited Create(AOwner);
  713. CreateEditDialog;
  714. end;
  715. procedure TFilenameEdit.CreateEditDialog;
  716. var
  717. NewDialog: TOpenDialog;
  718. begin
  719. case FDialogKind of
  720. dkOpen: NewDialog := TOpenDialog.Create(Self);
  721. dkOpenPicture: NewDialog := TOpenPictureDialog.Create(Self);
  722. dkSavePicture: NewDialog := TSavePictureDialog.Create(Self);
  723. else {dkSave} NewDialog := TSaveDialog.Create(Self);
  724. end;
  725. try
  726. if FDialog <> nil then begin
  727. with NewDialog do begin
  728. DefaultExt := FDialog.DefaultExt;
  729. FileEditStyle := FDialog.FileEditStyle;
  730. FileName := FDialog.FileName;
  731. Filter := FDialog.Filter;
  732. FilterIndex := FDialog.FilterIndex;
  733. InitialDir := FDialog.InitialDir;
  734. HistoryList := FDialog.HistoryList;
  735. Files.Assign(FDialog.Files);
  736. Options := FDialog.Options;
  737. Title := FDialog.Title;
  738. end;
  739. FDialog.Free;
  740. end
  741. else begin
  742. NewDialog.Title := SBrowse;
  743. NewDialog.Filter := SDefaultFilter;
  744. NewDialog.Options := [ofHideReadOnly];
  745. end;
  746. finally
  747. FDialog := NewDialog;
  748. end;
  749. end;
  750. function TFilenameEdit.IsCustomTitle: Boolean;
  751. begin
  752. Result := CompareStr(SBrowse, FDialog.Title) <> 0;
  753. end;
  754. function TFilenameEdit.IsCustomFilter: Boolean;
  755. begin
  756. Result := CompareStr(SDefaultFilter, FDialog.Filter) <> 0;
  757. end;
  758. procedure TFilenameEdit.ButtonClick;
  759. var
  760. Temp: string;
  761. Action: Boolean;
  762. begin
  763. inherited ButtonClick;
  764. Temp := inherited Text;
  765. Action := True;
  766. DoBeforeDialog(Temp, Action);
  767. if not Action then Exit;
  768. if ValidFileName(Temp) then
  769. try
  770. if DirectoryExists(ExtractFilePath(Temp)) then
  771. SetInitialDir(ExtractFilePath(Temp));
  772. if (ExtractFileName(Temp) = '') or
  773. not ValidFileName(ExtractFileName(Temp)) then Temp := '';
  774. FDialog.FileName := Temp;
  775. except
  776. { ignore any exceptions }
  777. end;
  778. FDialog.HelpContext := Self.HelpContext;
  779. DisableSysErrors;
  780. try
  781. Action := FDialog.Execute;
  782. finally
  783. EnableSysErrors;
  784. end;
  785. if Action then Temp := FDialog.FileName;
  786. if CanFocus then SetFocus;
  787. DoAfterDialog(Temp, Action);
  788. if Action then begin
  789. inherited Text := Temp;
  790. SetInitialDir(ExtractFilePath(FDialog.FileName));
  791. end;
  792. end;
  793. function TFilenameEdit.GetFileName: string;
  794. begin
  795. Result := inherited Text;
  796. end;
  797. procedure TFilenameEdit.SetFileName(const Value: string);
  798. begin
  799. if (Value = '') or ValidFileName(Value) then begin
  800. inherited Text := Value;
  801. ClearFileList;
  802. end
  803. else raise EComboEditError.CreateFmt(SInvalidFilename, [Value]);
  804. end;
  805. procedure TFilenameEdit.ClearFileList;
  806. begin
  807. FDialog.Files.Clear;
  808. end;
  809. procedure TFilenameEdit.ReceptFileDir(const AFileName: string);
  810. begin
  811. if FMultipleDirs then begin
  812. if FDialog.Files.Count = 0 then SetFileName(AFileName);
  813. FDialog.Files.Add(AFileName);
  814. end
  815. else SetFileName(AFileName);
  816. end;
  817. function TFilenameEdit.GetDialogFiles: TStrings;
  818. begin
  819. Result := FDialog.Files;
  820. end;
  821. function TFilenameEdit.GetDefaultExt: TFileExt;
  822. begin
  823. Result := FDialog.DefaultExt;
  824. end;
  825. function TFilenameEdit.GetFileEditStyle: TFileEditStyle;
  826. begin
  827. Result := FDialog.FileEditStyle;
  828. end;
  829. function TFilenameEdit.GetFilter: string;
  830. begin
  831. Result := FDialog.Filter;
  832. end;
  833. function TFilenameEdit.GetFilterIndex: Integer;
  834. begin
  835. Result := FDialog.FilterIndex;
  836. end;
  837. function TFilenameEdit.GetInitialDir: string;
  838. begin
  839. Result := FDialog.InitialDir;
  840. end;
  841. function TFilenameEdit.GetHistoryList: TStrings;
  842. begin
  843. Result := FDialog.HistoryList;
  844. end;
  845. function TFilenameEdit.GetOptions: TOpenOptions;
  846. begin
  847. Result := FDialog.Options;
  848. end;
  849. function TFilenameEdit.GetDialogTitle: string;
  850. begin
  851. Result := FDialog.Title;
  852. end;
  853. procedure TFilenameEdit.SetDialogKind(Value: TFileDialogKind);
  854. begin
  855. if FDialogKind <> Value then begin
  856. FDialogKind := Value;
  857. CreateEditDialog;
  858. end;
  859. end;
  860. procedure TFilenameEdit.SetDefaultExt(Value: TFileExt);
  861. begin
  862. FDialog.DefaultExt := Value;
  863. end;
  864. procedure TFilenameEdit.SetFileEditStyle(Value: TFileEditStyle);
  865. begin
  866. FDialog.FileEditStyle := Value;
  867. end;
  868. procedure TFilenameEdit.SetFilter(const Value: string);
  869. begin
  870. FDialog.Filter := Value;
  871. end;
  872. procedure TFilenameEdit.SetFilterIndex(Value: Integer);
  873. begin
  874. FDialog.FilterIndex := Value;
  875. end;
  876. procedure TFilenameEdit.SetInitialDir(const Value: string);
  877. begin
  878. FDialog.InitialDir := Value;
  879. end;
  880. procedure TFilenameEdit.SetHistoryList(Value: TStrings);
  881. begin
  882. FDialog.HistoryList := Value;
  883. end;
  884. procedure TFilenameEdit.SetOptions(Value: TOpenOptions);
  885. begin
  886. if Value <> FDialog.Options then begin
  887. FDialog.Options := Value;
  888. FMultipleDirs := ofAllowMultiSelect in FDialog.Options;
  889. if not FMultipleDirs then ClearFileList;
  890. end;
  891. end;
  892. procedure TFilenameEdit.SetDialogTitle(const Value: string);
  893. begin
  894. FDialog.Title := Value;
  895. end;
  896. { TDirectoryEdit }
  897. constructor TDirectoryEdit.Create(AOwner: TComponent);
  898. begin
  899. inherited Create(AOwner);
  900. end;
  901. procedure TDirectoryEdit.ButtonClick;
  902. var
  903. Temp: string;
  904. Action: Boolean;
  905. begin
  906. inherited ButtonClick;
  907. Temp := Text;
  908. Action := True;
  909. DoBeforeDialog(Temp, Action);
  910. if not Action then Exit;
  911. if (Temp = '') then begin
  912. if (InitialDir <> '') then Temp := InitialDir
  913. else Temp := '\';
  914. end;
  915. if not DirectoryExists(Temp) then Temp := '\';
  916. DisableSysErrors;
  917. try
  918. Action := SelectDirectory(FDialogText, '', Temp);
  919. finally
  920. EnableSysErrors;
  921. end;
  922. if CanFocus then SetFocus;
  923. DoAfterDialog(Temp, Action);
  924. if Action then begin
  925. SelText := '';
  926. if (Text = '') or not MultipleDirs then Text := Temp
  927. else Text := Text + ';' + Temp;
  928. if (Temp <> '') and DirectoryExists(Temp) then InitialDir := Temp;
  929. end;
  930. end;
  931. procedure TDirectoryEdit.ReceptFileDir(const AFileName: string);
  932. var
  933. Temp: string;
  934. begin
  935. if FileExists(ApiPath(AFileName)) then Temp := ExtractFilePath(AFileName)
  936. else Temp := AFileName;
  937. if (Text = '') or not MultipleDirs then Text := Temp
  938. else Text := Text + ';' + Temp;
  939. end;
  940. initialization
  941. end.