ComboEdit.pas 27 KB

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