1 {
2 ***************************************************************************
3 editbtn.pas
4 -----------
5 Component Library Extended dialogs Controls
6
7
8 ***************************************************************************
9
10 *****************************************************************************
11 * *
12 * This file is part of the Lazarus Component Library (LCL) *
13 * See the file COPYING.modifiedLGPL.txt, included in this distribution, *
14 * for details about the copyright. *
15 * *
16 * This program is distributed in the hope that it will be useful, *
17 * but WITHOUT ANY WARRANTY; without even the implied warranty of *
18 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
19 * *
20 *****************************************************************************
21
22
23 }
24 unit EditBtn;
25
26 {$mode objfpc}{$H+}
27
28 {$I lcl_defines.inc}
29
30 interface
31
32 uses
33 Classes, SysUtils, LCLProc, LResources, LCLStrConsts, Types, LCLType,
34 LMessages, Graphics, Controls, Forms, LazFileUtils, LazUTF8, Dialogs,
35 StdCtrls, Buttons, Calendar, ExtDlgs, GroupedEdit, CalendarPopup, MaskEdit,
36 Menus, StrUtils, DateUtils, TimePopup, CalcForm, ImgList;
37
38 const
39 NullDate: TDateTime = 0;
40
41 type
42
43 { TEbEdit }
44
45 TEbEdit = class(TGEEdit)
46 protected
47 procedure DoEnter; override;
48 procedure DoExit; override;
49 end;
50
51 TEditSpeedButton = class(TSpeedButton)
52 protected
53 procedure GlyphChanged(Sender: TObject); override;
54 end;
55
56 { TCustomEditButton }
57
58 TCustomEditButton = class(TCustomAbstractGroupedEdit)
59 private
60 FButtonOnlyWhenFocused: Boolean;
61 FFlat: Boolean;
62 //Forwarded events from Button
63 //Forwarded events from Edit
64
GetFocusOnButtonClicknull65 function GetFocusOnButtonClick: Boolean;
GetOnButtonClicknull66 function GetOnButtonClick: TNotifyEvent;
GetButtonnull67 function GetButton: TSpeedButton;
GetGlyphnull68 function GetGlyph: TBitmap;
GetNumGlypsnull69 function GetNumGlyps: Integer;
GetEditnull70 function GetEdit: TEbEdit;
71 procedure SetFocusOnButtonClick(AValue: Boolean);
72 procedure SetOnButtonClick(AValue: TNotifyEvent);
73
74 procedure SetButtonOnlyWhenFocused(AValue: Boolean);
75 procedure SetFlat(AValue: Boolean);
76 procedure SetGlyph(AValue: TBitmap);
77 procedure SetNumGlyphs(AValue: Integer);
GetImagesnull78 function GetImages: TCustomImageList;
79 procedure SetImages(const aImages: TCustomImageList);
GetImageIndexnull80 function GetImageIndex: TImageIndex;
81 procedure SetImageIndex(const aImageIndex: TImageIndex);
GetImageWidthnull82 function GetImageWidth: Integer;
83 procedure SetImageWidth(const aImageWidth: Integer);
84 protected
85 procedure ButtonClick; virtual;
86 procedure BuddyClick; override;
GetEditorClassTypenull87 function GetEditorClassType: TGEEditClass; override;
GetBuddyClassTypenull88 function GetBuddyClassType: TControlClass; override;
GetControlClassDefaultSizenull89 class function GetControlClassDefaultSize: TSize; override;
CalcButtonVisiblenull90 function CalcButtonVisible: Boolean; virtual;
GetDefaultGlyphNamenull91 function GetDefaultGlyphName: string; virtual;
92
93 procedure CalculatePreferredSize(var PreferredWidth,
94 PreferredHeight: integer;
95 WithThemeSpace: Boolean); override;
96 procedure CheckButtonVisible;
97 procedure LoadDefaultGlyph;
98 procedure GlyphChanged(Sender: TObject); virtual;
99
100 property Button: TSpeedButton read GetButton;
101 property ButtonCaption: TCaption read GetBuddyCaption write SetBuddyCaption;
102 property ButtonCursor: TCursor read GetBuddyCursor write SetBuddyCursor default crDefault;
103 property ButtonHint: TTranslateString read GetBuddyHint write SetBuddyHint;
104 property ButtonOnlyWhenFocused: Boolean read FButtonOnlyWhenFocused write SetButtonOnlyWhenFocused default False;
105 property ButtonWidth: Integer read GetBuddyWidth write SetBuddyWidth;
106 property Edit: TEbEdit read GetEdit;
107 property Flat: Boolean read FFlat write SetFlat default False;
108 property FocusOnButtonClick: Boolean read GetFocusOnButtonClick write SetFocusOnButtonClick default False;
109 property Glyph: TBitmap read GetGlyph write SetGlyph;
110 property NumGlyphs: Integer read GetNumGlyps write SetNumGlyphs;
111 property Images: TCustomImageList read GetImages write SetImages;
112 property ImageIndex: TImageIndex read GetImageIndex write SetImageIndex default -1;
113 property ImageWidth: Integer read GetImageWidth write SetImageWidth default 0;
114 property Spacing default 4;
115
116 property OnButtonClick: TNotifyEvent read GetOnButtonClick write SetOnButtonClick;
117 public
118 constructor Create(AOwner: TComponent); override;
119 destructor Destroy; override;
120 end;
121
122 { TEditButton }
123
124 TEditButton = class(TCustomEditButton)
125 public
126 property AutoSelected;
127 property Button;
128 published
129 property NumbersOnly;
130 property Action;
131 property AutoSelect;
132 property AutoSize default True;
133 property Align;
134 property Alignment;
135 property Anchors;
136 property BiDiMode;
137 property BorderSpacing;
138 property BorderStyle default bsNone;
139 property ButtonCaption;
140 property ButtonCursor;
141 property ButtonHint;
142 property ButtonOnlyWhenFocused;
143 property ButtonWidth;
144 property CharCase;
145 property Color;
146 property Constraints;
147 property Cursor;
148 property DirectInput;
149 property EchoMode;
150 property Enabled;
151 property Flat;
152 property FocusOnButtonClick;
153 property Font;
154 property Glyph;
155 // property HideSelection;
156 property Hint;
157 property Images;
158 property ImageIndex;
159 property ImageWidth;
160 property Layout;
161 property MaxLength;
162 property NumGlyphs;
163 property OnButtonClick;
164 property OnChange;
165 property OnClick;
166 property OnDblClick;
167 property OnDragDrop;
168 property OnDragOver;
169 property OnContextPopup;
170 property OnEditingDone;
171 property OnEndDrag;
172 property OnEnter;
173 property OnExit;
174 property OnKeyDown;
175 property OnKeyPress;
176 property OnKeyUp;
177 property OnMouseDown;
178 property OnMouseEnter;
179 property OnMouseLeave;
180 property OnMouseMove;
181 property OnMouseUp;
182 property OnMouseWheel;
183 property OnMouseWheelDown;
184 property OnMouseWheelUp;
185 property OnStartDrag;
186 property OnUTF8KeyPress;
187 property ParentBiDiMode;
188 property ParentColor;
189 property ParentFont;
190 property ParentShowHint;
191 property PasswordChar;
192 property PopupMenu;
193 property ReadOnly;
194 property ShowHint;
195 property Spacing;
196 property TabOrder;
197 property TabStop;
198 property Text;
199 property TextHint;
200 property Visible;
201 end;
202
203 TFilterStringOption = (fsoCaseSensitive, fsoMatchOnlyAtStart);
204 TFilterStringOptions = set of TFilterStringOption;
205
206 // Called when an item is filtered. Returns true if the item passes the filter.
207 // Done=False means the data should also be filtered by its title string.
208 // Done=True means no other filtering is needed.
209 TFilterItemEvent = function (ItemData: Pointer; out Done: Boolean): Boolean of object;
210 TFilterItemExEvent = function (const ACaption: string; ItemData: Pointer;
211 out Done: Boolean): Boolean of object;
212
213 // Can be used only for items that have a checkbox. Returns true if checked.
214 TCheckItemEvent = function (Item: TObject): Boolean of object;
215
216 { TCustomControlFilterEdit }
217
218 // An abstract base class for edit controls which filter data in
219 // visual controls like TListView and TTreeView.
220 TCustomControlFilterEdit = class(TCustomEditButton)
221 private
222 fFilter: string;
223 fFilterLowercase: string;
224 fFilterOptions: TFilterStringOptions;
225 fIdleConnected: Boolean;
226 fSortData: Boolean; // Data needs to be sorted.
227 fIsFirstSetFormActivate: Boolean;
228 fOnAfterFilter: TNotifyEvent;
229 procedure SetFilter(const AValue: string);
230 procedure SetIdleConnected(const AValue: Boolean);
231 procedure OnIdle(Sender: TObject; var Done: Boolean);
IsTextHintStorednull232 function IsTextHintStored: Boolean;
233 protected
234 fNeedUpdate: Boolean;
235 fIsFirstUpdate: Boolean;
236 fSelectedPart: TObject; // Select this node on next update
237 fOnFilterItem: TFilterItemEvent;
238 fOnFilterItemEx: TFilterItemExEvent;
239 fOnCheckItem: TCheckItemEvent;
240 procedure DestroyWnd; override;
DoDefaultFilterItemnull241 function DoDefaultFilterItem(const ACaption: string;
242 const ItemData: Pointer): Boolean; virtual;
DoFilterItemnull243 function DoFilterItem(const ACaption, AFilter: string;
244 ItemData: Pointer): Boolean; virtual;
245 procedure EditKeyDown(var Key: Word; Shift: TShiftState); override;
246 procedure EditChange; override;
247 procedure BuddyClick; override;
248 procedure SortAndFilter; virtual; abstract;
249 procedure ApplyFilter(Immediately: Boolean = False);
250 procedure ApplyFilterCore; virtual; abstract;
251 procedure MoveNext(ASelect: Boolean = False); virtual; abstract;
252 procedure MovePrev(ASelect: Boolean = False); virtual; abstract;
253 procedure MovePageUp(ASelect: Boolean = False); virtual; abstract;
254 procedure MovePageDown(ASelect: Boolean = False); virtual; abstract;
255 procedure MoveHome(ASelect: Boolean = False); virtual; abstract;
256 procedure MoveEnd(ASelect: Boolean = False); virtual; abstract;
ReturnKeyHandlednull257 function ReturnKeyHandled: Boolean; virtual; abstract;
GetDefaultGlyphNamenull258 function GetDefaultGlyphName: string; override;
259 public
260 constructor Create(AOwner: TComponent); override;
261 destructor Destroy; override;
262 procedure InvalidateFilter;
263 procedure ResetFilter;
ForceFilternull264 function ForceFilter(AFilter: String) : String;
265 procedure StoreSelection; virtual; abstract;
266 procedure RestoreSelection; virtual; abstract;
267 public
268 property Filter: string read fFilter write SetFilter;
269 property IdleConnected: Boolean read fIdleConnected write SetIdleConnected;
270 property SortData: Boolean read fSortData write fSortData;
271 property SelectedPart: TObject read fSelectedPart write fSelectedPart;
272 published
273 property CharCase default ecLowerCase;
274 property FilterOptions: TFilterStringOptions read fFilterOptions write fFilterOptions default [];
275 property OnAfterFilter: TNotifyEvent read fOnAfterFilter write fOnAfterFilter;
276 property OnFilterItem: TFilterItemEvent read fOnFilterItem write fOnFilterItem;
277 deprecated 'Use OnFilterItemEx with a caption parameter instead.';
278 property OnFilterItemEx: TFilterItemExEvent read fOnFilterItemEx write fOnFilterItemEx;
279 property OnCheckItem: TCheckItemEvent read fOnCheckItem write fOnCheckItem;
280 // TEditButton properties.
281 property ButtonCaption;
282 property ButtonCursor;
283 property ButtonHint;
284 property ButtonOnlyWhenFocused;
285 property ButtonWidth;
286 property Constraints;
287 property DirectInput;
288 property Flat;
289 property FocusOnButtonClick;
290 // Other properties
291 property Align;
292 property Anchors;
293 property BidiMode;
294 property BorderSpacing;
295 property BorderStyle;
296 property AutoSize;
297 property AutoSelect;
298 property Color;
299 property DragCursor;
300 property DragMode;
301 property Enabled;
302 property Font;
303 property Glyph;
304 property NumGlyphs;
305 property Images;
306 property ImageIndex;
307 property ImageWidth;
308 property Layout;
309 property MaxLength;
310 property ParentBidiMode;
311 property ParentColor;
312 property ParentFont;
313 property ParentShowHint;
314 property PopupMenu;
315 property ReadOnly;
316 property ShowHint;
317 property Spacing;
318 property TabOrder;
319 property TabStop;
320 property Visible;
321 property OnButtonClick;
322 property OnChange;
323 property OnClick;
324 property OnContextPopup;
325 property OnDblClick;
326 property OnDragDrop;
327 property OnDragOver;
328 property OnEditingDone;
329 property OnEndDrag;
330 property OnEnter;
331 property OnExit;
332 property OnKeyDown;
333 property OnKeyPress;
334 property OnKeyUp;
335 property OnMouseDown;
336 property OnMouseEnter;
337 property OnMouseLeave;
338 property OnMouseMove;
339 property OnMouseUp;
340 property OnMouseWheel;
341 property OnMouseWheelDown;
342 property OnMouseWheelUp;
343 property OnStartDrag;
344 property OnUTF8KeyPress;
345 property Text;
346 property TextHint stored IsTextHintStored;
347 end;
348
349 { TFileNameEdit }
350
351 TAcceptFileNameEvent = procedure (Sender : TObject; Var Value : String) of Object;
352 TDialogKind = (dkOpen,dkSave,dkPictureOpen,dkPictureSave);
353
354 TFileNameEdit = class(TCustomEditButton)
355 private
356 FDialogOptions: TOpenOptions;
357 FFileName : String;
358 FDialogFiles : TStrings;
359 FDialogKind: TDialogKind;
360 FDialogTitle: String;
361 FFilter: String;
362 FFilterIndex: Integer;
363 FDefaultExt: String;
364 FHideDirectories: Boolean;
365 FInitialDir: String;
366 FOnAcceptFileName: TAcceptFileNameEvent;
367 FOnFolderChange: TNotifyEvent;
368 FFileNameChangeLock: Integer;
369 procedure SetFileName(const AValue: String);
370 protected
GetDefaultGlyphNamenull371 function GetDefaultGlyphName: string; override;
CreateDialognull372 function CreateDialog(AKind: TDialogKind): TCommonDialog; virtual;
373 procedure SaveDialogResult(AKind: TDialogKind; D: TCommonDialog); virtual;
374 procedure ButtonClick; override;
375 procedure EditChange; override;
376 procedure DoFolderChange(Sender:TObject); virtual;
377 public
378 constructor Create(AOwner: TComponent); override;
379 destructor Destroy; override;
380 procedure RunDialog; virtual;
381 property AutoSelected;
382 property DialogFiles: TStrings read FDialogFiles;
383 published
384 // TFileName properties.
385 property FileName: String read FFileName write SetFileName;
386 property InitialDir: String read FInitialDir write FInitialDir;
387 property OnAcceptFileName: TAcceptFileNameEvent read FOnAcceptFileName write FOnAcceptFileName;
388 property OnFolderChange: TNotifyEvent read FOnFolderChange write FOnFolderChange;
389 property DialogKind: TDialogKind read FDialogKind write FDialogKind default dkOpen;
390 property DialogTitle: String read FDialogTitle write FDialogTitle;
391 property DialogOptions: TOpenOptions read FDialogOptions write FDialogOptions default DefaultOpenDialogOptions;
392 property Filter: String read FFilter write FFilter;
393 property FilterIndex: Integer read FFilterIndex write FFIlterIndex;
394 property DefaultExt: String read FDefaultExt write FDefaultExt;
395 property HideDirectories: Boolean read FHideDirectories write FHideDirectories;
396 // TEditButton properties.
397 property ButtonCaption;
398 property ButtonCursor;
399 property ButtonHint;
400 property ButtonOnlyWhenFocused;
401 property ButtonWidth;
402 property Constraints;
403 property DirectInput;
404 property Glyph;
405 property NumGlyphs;
406 property Images;
407 property ImageIndex;
408 property ImageWidth;
409 property Flat;
410 property FocusOnButtonClick;
411 // Other properties
412 property Align;
413 property Alignment;
414 property Anchors;
415 property AutoSelect;
416 property BidiMode;
417 property BorderSpacing;
418 property BorderStyle;
419 property AutoSize;
420 property Color;
421 property DragCursor;
422 property DragMode;
423 property Enabled;
424 property Font;
425 property Layout;
426 property MaxLength;
427 property ParentBidiMode;
428 property ParentColor;
429 property ParentFont;
430 property ParentShowHint;
431 property PopupMenu;
432 property ReadOnly;
433 property ShowHint;
434 property Spacing;
435 property TabOrder;
436 property TabStop;
437 property Visible;
438 property OnButtonClick;
439 property OnChange;
440 property OnClick;
441 property OnContextPopup;
442 property OnDblClick;
443 property OnDragDrop;
444 property OnDragOver;
445 property OnEditingDone;
446 property OnEndDrag;
447 property OnEnter;
448 property OnExit;
449 property OnKeyDown;
450 property OnKeyPress;
451 property OnKeyUp;
452 property OnMouseDown;
453 property OnMouseEnter;
454 property OnMouseLeave;
455 property OnMouseMove;
456 property OnMouseUp;
457 property OnMouseWheel;
458 property OnMouseWheelDown;
459 property OnMouseWheelUp;
460 property OnStartDrag;
461 property OnUTF8KeyPress;
462 property Text;
463 property TextHint;
464 end;
465
466
467 { TDirectoryEdit }
468
469 TDirectoryEdit = class(TCustomEditButton)
470 private
471 FDialogTitle: String;
472 FRootDir: String;
473 FOnAcceptDir: TAcceptFileNameEvent;
474 FShowHidden: Boolean;
475 FDialogOptions: TOpenOptions;
GetDirectorynull476 function GetDirectory: String;
477 procedure SetDirectory(const AValue: String);
478 protected
GetDefaultGlyphNamenull479 function GetDefaultGlyphName: string; override;
CreateDialognull480 function CreateDialog: TCommonDialog; virtual;
GetDialogResultnull481 function GetDialogResult(D : TCommonDialog) : String; virtual;
482 procedure ButtonClick; override;
483 public
484 property AutoSelected;
485 constructor Create(AOwner: TComponent); override;
486 procedure RunDialog; virtual;
487 published
488 // TDirectory properties.
489 property Directory: String read GetDirectory write SetDirectory;
490 property RootDir: String read FRootDir write FRootDir;
491 property OnAcceptDirectory: TAcceptFileNameEvent read FOnAcceptDir write FonAcceptDir;
492 property DialogTitle: String read FDialogTitle write FDialogTitle;
493 property DialogOptions: TOpenOptions read FDialogOptions write FDialogOptions default DefaultOpenDialogOptions;
494 property ShowHidden: Boolean read FShowHidden write FShowHidden;
495 // TEditButton properties.
496 property ButtonCaption;
497 property ButtonCursor;
498 property ButtonHint;
499 property ButtonOnlyWhenFocused;
500 property ButtonWidth;
501 property Constraints;
502 property DirectInput;
503 property Glyph;
504 property NumGlyphs;
505 property Images;
506 property ImageIndex;
507 property ImageWidth;
508 property Flat;
509 property FocusOnButtonClick;
510 // Other properties
511 property Align;
512 property Anchors;
513 property AutoSize;
514 property AutoSelect;
515 property BidiMode;
516 property BorderSpacing;
517 property BorderStyle;
518 property Color;
519 property DragCursor;
520 property DragMode;
521 property Enabled;
522 property Font;
523 property Layout;
524 property MaxLength;
525 property ParentBidiMode;
526 property ParentColor;
527 property ParentFont;
528 property ParentShowHint;
529 property PopupMenu;
530 property ReadOnly;
531 property ShowHint;
532 property TabOrder;
533 property Spacing;
534 property TabStop;
535 property Visible;
536 property OnButtonClick;
537 property OnChange;
538 property OnClick;
539 property OnContextPopup;
540 property OnDblClick;
541 property OnDragDrop;
542 property OnDragOver;
543 property OnEditingDone;
544 property OnEndDrag;
545 property OnEnter;
546 property OnExit;
547 property OnKeyDown;
548 property OnKeyPress;
549 property OnKeyUp;
550 property OnMouseDown;
551 property OnMouseEnter;
552 property OnMouseLeave;
553 property OnMouseMove;
554 property OnMouseUp;
555 property OnMouseWheel;
556 property OnMouseWheelDown;
557 property OnMouseWheelUp;
558 property OnStartDrag;
559 property OnUTF8KeyPress;
560 property Text;
561 property TextHint;
562 end;
563
564
565 { TDateEdit }
566
567 TAcceptDateEvent = procedure (Sender : TObject; var ADate : TDateTime;
568 var AcceptDate: Boolean) of object;
569 TCustomDateEvent = procedure (Sender : TObject; var ADate : string) of object;
570 TDateOrder = (doNone,doMDY,doDMY,doYMd);
571
572 TDateEdit = class(TCustomEditButton)
573 private
574 FDateOrder: TDateOrder;
575 FDefaultToday: Boolean;
576 FDisplaySettings: TDisplaySettings;
577 FDroppedDown: Boolean;
578 FOnAcceptDate: TAcceptDateEvent;
579 FOnCustomDate: TCustomDateEvent;
580 FFixedDateFormat: string; //used when DateOrder <> doNone
581 FFreeDateFormat: String; //used when DateOrder = doNone
582 FDate: TDateTime;
583 FUpdatingDate: Boolean;
584 procedure SetFreeDateFormat(AValue: String);
TextToDatenull585 function TextToDate(AText: String; ADefault: TDateTime): TDateTime;
GetDatenull586 function GetDate: TDateTime;
587 procedure SetDate(Value: TDateTime);
588 procedure CalendarPopupReturnDate(Sender: TObject; const ADate: TDateTime);
589 procedure CalendarPopupShowHide(Sender: TObject);
590 procedure SetDateOrder(const AValue: TDateOrder);
DateToTextnull591 function DateToText(Value: TDateTime): String;
592 protected
GetDefaultGlyphNamenull593 function GetDefaultGlyphName: string; override;
594 procedure ButtonClick; override;
595 procedure EditDblClick; override;
596 procedure EditEditingDone; override;
597 procedure SetDirectInput(AValue: Boolean); override;
598 procedure RealSetText(const AValue: TCaption); override;
599 procedure SetDateMask; virtual;
600 procedure Loaded; override;
601 public
602 constructor Create(AOwner: TComponent); override;
GetDateFormatnull603 function GetDateFormat: string;
604 property AutoSelected;
605 property Date: TDateTime read GetDate write SetDate;
606 property Button;
607 property DroppedDown: Boolean read FDroppedDown;
608 published
609 property CalendarDisplaySettings: TDisplaySettings read FDisplaySettings write FDisplaySettings;
610 property OnAcceptDate: TAcceptDateEvent read FOnAcceptDAte write FOnAcceptDate;
611 property OnCustomDate: TCustomDateEvent read FOnCustomDate write FOnCustomDate;
612 property ReadOnly;
613 property DefaultToday: Boolean read FDefaultToday write FDefaultToday default False;
614 Property DateOrder : TDateOrder Read FDateOrder Write SetDateOrder;
615 property DateFormat: String read FFreeDateFormat write SetFreeDateFormat;
616 property ButtonOnlyWhenFocused;
617 property ButtonCaption;
618 property ButtonCursor;
619 property ButtonHint;
620 property ButtonWidth;
621 property Action;
622 property Align;
623 property Anchors;
624 property AutoSize;
625 property AutoSelect;
626 property BidiMode;
627 property BorderSpacing;
628 property BorderStyle;
629 property CharCase;
630 property Color;
631 property Constraints;
632 property DirectInput;
633 property Glyph;
634 property NumGlyphs;
635 property Images;
636 property ImageIndex;
637 property ImageWidth;
638 property DragMode;
639 property EchoMode;
640 property Enabled;
641 property Flat;
642 property FocusOnButtonClick;
643 property Font;
644 property Layout;
645 property MaxLength;
646 property OnButtonClick;
647 property OnChange;
648 property OnChangeBounds;
649 property OnClick;
650 property OnContextPopup;
651 property OnDblClick;
652 property OnEditingDone;
653 property OnEnter;
654 property OnExit;
655 property OnKeyDown;
656 property OnKeyPress;
657 property OnKeyUp;
658 property OnMouseDown;
659 property OnMouseEnter;
660 property OnMouseLeave;
661 property OnMouseMove;
662 property OnMouseUp;
663 property OnMouseWheel;
664 property OnMouseWheelDown;
665 property OnMouseWheelUp;
666 property OnResize;
667 property OnUTF8KeyPress;
668 property ParentBidiMode;
669 property ParentColor;
670 property ParentFont;
671 property ParentShowHint;
672 property PopupMenu;
673 property ShowHint;
674 property TabStop;
675 property TabOrder;
676 property Spacing;
677 property Visible;
678 property Text;
679 property TextHint;
680 end;
681
682 { TTimeEdit }
683
684 TAcceptTimeEvent = procedure (Sender : TObject; var ATime : TDateTime; var AcceptTime: Boolean) of object;
685 TCustomTimeEvent = procedure (Sender : TObject; var ATime : TDateTime) of object;
686
687 TTimeEdit = class(TCustomEditButton)
688 private
689 FTime: TTime;
690 IsEmptyTime: Boolean;
691 FDefaultNow: Boolean;
692 FDroppedDown: Boolean;
693 FSimpleLayout: Boolean;
694 FOnAcceptTime: TAcceptTimeEvent;
695 FOnCustomTime: TCustomTimeEvent;
GetTimenull696 function GetTime: TDateTime;
697 procedure SetTime(AValue: TDateTime);
698 procedure SetEmptyTime;
GetLayoutnull699 function GetLayout: Boolean;
700 procedure SetLayout(AValue: Boolean);
701 procedure TimePopupReturnTime(Sender: TObject; const ATime: TDateTime);
702 procedure TimePopupShowHide(Sender: TObject);
703 procedure OpenTimePopup;
704 procedure ParseInput;
TryParseInputnull705 function TryParseInput(AInput: String; out ParseResult: TDateTime): Boolean;
706 protected
GetDefaultGlyphNamenull707 function GetDefaultGlyphName: string; override;
708 procedure ButtonClick; override;
709 procedure EditDblClick; override;
710 procedure EditEditingDone; override;
711 public
712 constructor Create(AOwner: TComponent); override;
713 property Time: TDateTime read GetTime write SetTime;
714 property Button;
715 property DroppedDown: Boolean read FDroppedDown;
716 published
717 property DefaultNow: Boolean read FDefaultNow write FDefaultNow default False;
718 property OnAcceptTime: TAcceptTimeEvent read FOnAcceptTime write FOnAcceptTime;
719 property OnCustomTime: TCustomTimeEvent read FOnCustomTime write FOnCustomTime;
720 property ReadOnly;
721 property ButtonCaption;
722 property ButtonCursor;
723 property ButtonHint;
724 property ButtonOnlyWhenFocused;
725 property ButtonWidth;
726 property Action;
727 property Align;
728 property Anchors;
729 property AutoSize;
730 property AutoSelect;
731 property BidiMode;
732 property BorderSpacing;
733 property BorderStyle;
734 property CharCase;
735 property Color;
736 property Constraints;
737 property DirectInput;
738 property Glyph;
739 property NumGlyphs;
740 property Images;
741 property ImageIndex;
742 property ImageWidth;
743 property DragMode;
744 property EchoMode;
745 property Enabled;
746 property Flat;
747 property FocusOnButtonClick;
748 property Font;
749 property MaxLength;
750 property OnButtonClick;
751 property OnChange;
752 property OnChangeBounds;
753 property OnClick;
754 property OnDblClick;
755 property OnContextPopup;
756 property OnEditingDone;
757 property OnEnter;
758 property OnExit;
759 property OnKeyDown;
760 property OnKeyPress;
761 property OnKeyUp;
762 property OnMouseDown;
763 property OnMouseEnter;
764 property OnMouseLeave;
765 property OnMouseMove;
766 property OnMouseUp;
767 property OnMouseWheel;
768 property OnMouseWheelDown;
769 property OnMouseWheelUp;
770 property OnResize;
771 property OnUTF8KeyPress;
772 property ParentBidiMode;
773 property ParentColor;
774 property ParentFont;
775 property ParentShowHint;
776 property PopupMenu;
777 property ShowHint;
778 property SimpleLayout: Boolean read GetLayout write SetLayout default True;
779 property Spacing;
780 property TabStop;
781 property TabOrder;
782 property Visible;
783 property Text;
784 property TextHint;
785 end;
786
787
788 { TCalcEdit }
789
790 TAcceptValueEvent = procedure(Sender: TObject; var AValue: Double; var Accept: Boolean) of object;
791
792 TCalcEdit = class(TCustomEditButton)
793 private
794 FDialogTitle: String;
795 FCalculatorLayout: TCalculatorLayout;
796 FOnAcceptValue: TAcceptValueEvent;
797 FDialogPosition: TPosition;
798 FDialogLeft: Integer;
799 FDialogTop: Integer;
GetAsFloatnull800 function GetAsFloat: Double;
GetAsIntegernull801 function GetAsInteger: Integer;
802 procedure SetAsFloat(const AValue: Double);
803 procedure SetAsInteger(const AValue: Integer);
TitleStorednull804 function TitleStored: boolean;
805 protected
806 FCalcDialog : TForm;
GetDefaultGlyphNamenull807 function GetDefaultGlyphName: string; override;
808 procedure ButtonClick; override;
809 public
810 constructor Create(AOwner: TComponent); override;
811 procedure RunDialog; virtual;
812 property AutoSelected;
813 published
814 // CalcEdit properties
815 property CalculatorLayout : TCalculatorLayout read FCalculatorLayout write FCalculatorLayout;
816 property AsFloat : Double read GetAsFloat write SetAsFloat;
817 property AsInteger : Integer read GetAsInteger write SetAsInteger;
818 property OnAcceptValue : TAcceptValueEvent read FOnAcceptValue write FOnAcceptValue;
819 property DialogTitle : String read FDialogTitle write FDialogTitle stored TitleStored;
820 // TEditButton properties.
821 property ButtonCaption;
822 property ButtonCursor;
823 property ButtonHint;
824 property ButtonOnlyWhenFocused;
825 property ButtonWidth;
826 property Constraints;
827 property DialogPosition: TPosition read FDialogPosition write FDialogPosition default poScreenCenter;
828 property DialogTop: Integer read FDialogTop write FDialogTop;
829 property DialogLeft: Integer read FDialogLeft write FDialogLeft;
830 property DirectInput;
831 property Glyph;
832 property NumGlyphs;
833 property Images;
834 property ImageIndex;
835 property ImageWidth;
836 property Flat;
837 property FocusOnButtonClick;
838 // Other properties
839 property Align;
840 property Anchors;
841 property BidiMode;
842 property BorderSpacing;
843 property BorderStyle;
844 property AutoSize;
845 property AutoSelect;
846 property Color;
847 property DragCursor;
848 property DragMode;
849 property Enabled;
850 property Font;
851 property Layout;
852 property MaxLength;
853 property ParentBidiMode;
854 property ParentColor;
855 property ParentFont;
856 property ParentShowHint;
857 property PopupMenu;
858 property ReadOnly;
859 property ShowHint;
860 property Spacing;
861 property TabOrder;
862 property TabStop;
863 property Visible;
864 property OnButtonClick;
865 property OnChange;
866 property OnClick;
867 property OnContextPopup;
868 property OnDblClick;
869 property OnDragDrop;
870 property OnDragOver;
871 property OnEditingDone;
872 property OnEndDrag;
873 property OnEnter;
874 property OnExit;
875 property OnKeyDown;
876 property OnKeyPress;
877 property OnKeyUp;
878 property OnMouseDown;
879 property OnMouseEnter;
880 property OnMouseLeave;
881 property OnMouseMove;
882 property OnMouseUp;
883 property OnMouseWheel;
884 property OnMouseWheelDown;
885 property OnMouseWheelUp;
886 property OnStartDrag;
887 property OnUTF8KeyPress;
888 property Text;
889 property TextHint;
890 end;
891
892 const
893 ResBtnListFilter = 'btnfiltercancel';
894 ResBtnFileOpen = 'btnselfile';
895 ResBtnSelDir = 'btnseldir';
896 ResBtnCalendar = 'btncalendar';
897 ResBtnCalculator = 'btncalculator';
898 ResBtnTime = 'btntime';
899
900 procedure Register;
901
902 implementation
903
904 {$R lcl_edbtnimg.res}
905
906 { TEditSpeedButton }
907
908 procedure TEditSpeedButton.GlyphChanged(Sender: TObject);
909 begin
910 inherited GlyphChanged(Sender);
911 if (Owner is TCustomEditButton) then TCustomEditButton(Owner).GlyphChanged(Sender);
912 end;
913
914 { TEbEdit }
915
916 procedure TEbEdit.DoEnter;
917 begin
918 if (Owner is TCustomEditButton) then TCustomEditButton(Owner).CheckButtonVisible;
919 inherited DoEnter;
920 end;
921
922 procedure TEbEdit.DoExit;
923 begin
924 if (Owner is TCustomEditButton) then TCustomEditButton(Owner).CheckButtonVisible;
925 inherited DoExit;
926 end;
927
928
929 { TCustomEditButton }
930
931 procedure TCustomEditButton.CalculatePreferredSize(var PreferredWidth,
932 PreferredHeight: integer; WithThemeSpace: Boolean);
933 begin
934 inherited CalculatePreferredSize(PreferredWidth, PreferredHeight, WithThemeSpace);
935 PreferredWidth := 0;
936 end;
937
938 procedure TCustomEditButton.SetFocusOnButtonClick(AValue: Boolean);
939 begin
940 FocusOnBuddyClick := AValue;
941 end;
942
943 procedure TCustomEditButton.SetOnButtonClick(AValue: TNotifyEvent);
944 begin
945 OnBuddyClick := AValue;
946 end;
947
948 procedure TCustomEditButton.SetButtonOnlyWhenFocused(AValue: Boolean);
949 begin
950 if FButtonOnlyWhenFocused <> AValue then
951 begin
952 FButtonOnlyWhenFocused := AValue;
953 CheckButtonVisible;
954 end;
955 end;
956
GetGlyphnull957 function TCustomEditButton.GetGlyph: TBitmap;
958 begin
959 Result := Button.Glyph;
960 end;
961
GetImageIndexnull962 function TCustomEditButton.GetImageIndex: TImageIndex;
963 begin
964 Result := Button.ImageIndex;
965 end;
966
TCustomEditButton.GetImagesnull967 function TCustomEditButton.GetImages: TCustomImageList;
968 begin
969 Result := Button.Images;
970 end;
971
GetImageWidthnull972 function TCustomEditButton.GetImageWidth: Integer;
973 begin
974 Result := Button.ImageWidth;
975 end;
976
GetButtonnull977 function TCustomEditButton.GetButton: TSpeedButton;
978 begin
979 Result := TSpeedButton(Buddy);
980 end;
981
TCustomEditButton.GetOnButtonClicknull982 function TCustomEditButton.GetOnButtonClick: TNotifyEvent;
983 begin
984 Result := OnBuddyClick;
985 end;
986
987 procedure TCustomEditButton.GlyphChanged(Sender: TObject);
988 begin
989 if ((Button.Glyph=nil) or (Button.Glyph.Empty))
990 and (Button.Images=nil) and (Button.ImageIndex=-1) then
991 LoadDefaultGlyph;
992 end;
993
994 procedure TCustomEditButton.LoadDefaultGlyph;
995 var
996 N: string;
997 begin
998 N := GetDefaultGlyphName;
999 if N <> '' then
1000 (Button as TEditSpeedButton).ButtonGlyph.LCLGlyphName := N;
1001 end;
1002
TCustomEditButton.GetFocusOnButtonClicknull1003 function TCustomEditButton.GetFocusOnButtonClick: Boolean;
1004 begin
1005 Result := FocusOnBuddyClick;
1006 end;
1007
TCustomEditButton.GetNumGlypsnull1008 function TCustomEditButton.GetNumGlyps: Integer;
1009 begin
1010 Result := Button.NumGlyphs;
1011 end;
1012
TCustomEditButton.GetEditnull1013 function TCustomEditButton.GetEdit: TEbEdit;
1014 begin
1015 Result := TEbEdit(BaseEditor);
1016 end;
1017
1018
TCustomEditButton.GetControlClassDefaultSizenull1019 class function TCustomEditButton.GetControlClassDefaultSize: TSize;
1020 begin
1021 Result.CX := 80 + 23; //as TCustomEdit + TCustomSpeedButton
1022 Result.CY := 23; //as TCustomEdit
1023 end;
1024
TCustomEditButton.GetDefaultGlyphNamenull1025 function TCustomEditButton.GetDefaultGlyphName: string;
1026 begin
1027 Result := '';
1028 end;
1029
1030 procedure TCustomEditButton.SetFlat(AValue: Boolean);
1031 begin
1032 if FFlat = AValue then
1033 Exit;
1034 FFlat := AValue;
1035 Button.Flat := AValue;
1036 end;
1037
1038 procedure TCustomEditButton.SetNumGlyphs(AValue: Integer);
1039 begin
1040 Button.NumGlyphs := AValue;
1041 end;
1042
CalcButtonVisiblenull1043 function TCustomEditButton.CalcButtonVisible: Boolean;
1044 begin
1045 Result := (csdesigning in ComponentState) or
1046 (Visible and (Edit.Focused or not FButtonOnlyWhenFocused));
1047 end;
1048
1049 procedure TCustomEditButton.CheckButtonVisible;
1050 begin
1051 if Assigned(Button) then
1052 begin
1053 Button.Visible := CalcButtonVisible;
1054 UpdateSpacing;
1055 end;
1056 end;
1057
1058 procedure TCustomEditButton.ButtonClick;
1059 begin
1060 //debugln(['TCustomEditButton.ButtonClick']);
1061 {Don't remove, even if this is an empty method!}
1062 end;
1063
1064 procedure TCustomEditButton.BuddyClick;
1065 begin
1066 inherited BuddyClick;
1067 ButtonClick;
1068 end;
1069
1070 procedure TCustomEditButton.SetGlyph(AValue: TBitmap);
1071 begin
1072 Button.Glyph := AValue;
1073 if AValue=nil then
1074 LoadDefaultGlyph;
1075 Invalidate;
1076 end;
1077
1078 procedure TCustomEditButton.SetImageIndex(const aImageIndex: TImageIndex);
1079 begin
1080 Button.ImageIndex := aImageIndex;
1081 end;
1082
1083 procedure TCustomEditButton.SetImages(const aImages: TCustomImageList);
1084 begin
1085 Button.Images := aImages;
1086 end;
1087
1088 procedure TCustomEditButton.SetImageWidth(const aImageWidth: Integer);
1089 begin
1090 Button.ImageWidth := aImageWidth;
1091 end;
1092
TCustomEditButton.GetEditorClassTypenull1093 function TCustomEditButton.GetEditorClassType: TGEEditClass;
1094 begin
1095 Result := TEbEdit;
1096 end;
1097
TCustomEditButton.GetBuddyClassTypenull1098 function TCustomEditButton.GetBuddyClassType: TControlClass;
1099 begin
1100 Result := TEditSpeedButton;
1101 end;
1102
1103 constructor TCustomEditButton.Create(AOwner: TComponent);
1104 begin
1105 inherited Create(AOwner);
1106 FButtonOnlyWhenFocused := False;
1107 FocusOnButtonClick := False;
1108
1109 SetInitialBounds(0, 0, GetControlClassDefaultSize.CX, GetControlClassDefaultSize.CY);
1110
1111 LoadDefaultGlyph;
1112 Spacing := 4;
1113 end;
1114
1115 destructor TCustomEditButton.Destroy;
1116 begin
1117 inherited Destroy;
1118 end;
1119
1120
1121 { TCustomControlFilterEdit }
1122
1123 constructor TCustomControlFilterEdit.Create(AOwner: TComponent);
1124 begin
1125 inherited Create(AOwner);
1126 CharCase:=ecLowerCase;
1127 Button.Enabled:=False;
1128 fFilterOptions:=[];
1129 fIsFirstUpdate:=True;
1130 fIsFirstSetFormActivate:=True;
1131 TextHint:=rsFilter;
1132 end;
1133
1134 destructor TCustomControlFilterEdit.Destroy;
1135 begin
1136 inherited Destroy;
1137 end;
1138
1139 procedure TCustomControlFilterEdit.DestroyWnd;
1140 begin
1141 IdleConnected:=false;
1142 inherited DestroyWnd;
1143 end;
1144
DoDefaultFilterItemnull1145 function TCustomControlFilterEdit.DoDefaultFilterItem(const ACaption: string;
1146 const ItemData: Pointer): Boolean;
1147 var
1148 NPos: integer;
1149 begin
1150 if fFilter='' then
1151 exit(True);
1152
1153 if fsoCaseSensitive in fFilterOptions then
1154 NPos := Pos(fFilter, ACaption)
1155 else
1156 NPos := Pos(fFilterLowercase, UTF8LowerCase(ACaption));
1157
1158 if fsoMatchOnlyAtStart in fFilterOptions then
1159 Result := NPos=1
1160 else
1161 Result := NPos>0;
1162 end;
1163
DoFilterItemnull1164 function TCustomControlFilterEdit.DoFilterItem(const ACaption,
1165 AFilter: string; ItemData: Pointer): Boolean;
1166 var
1167 Done: Boolean;
1168 begin
1169 Done := False;
1170 Result := False;
1171
1172 // Filter with event handler if there is one.
1173 if Assigned(fOnFilterItemEx) then
1174 Result := fOnFilterItemEx(ACaption, ItemData, Done);
1175
1176 // Support also the old filter event without a caption.
1177 if (not (Result and Done)) and Assigned(fOnFilterItem) then
1178 Result := fOnFilterItem(ItemData, Done);
1179
1180 // Filter by item's caption text if needed.
1181 if not (Result or Done) then
1182 Result := DoDefaultFilterItem(ACaption, ItemData);
1183 end;
1184
1185 procedure TCustomControlFilterEdit.OnIdle(Sender: TObject; var Done: Boolean);
1186 begin
1187 if fNeedUpdate then
1188 ApplyFilter(true);
1189 IdleConnected:=false;
1190 if Assigned(fOnAfterFilter) then
1191 fOnAfterFilter(Self);
1192 end;
1193
1194 procedure TCustomControlFilterEdit.SetFilter(const AValue: string);
1195 begin
1196 Button.Enabled:=AValue<>'';
1197 if fFilter=AValue then
1198 Exit;
1199 fFilter:=AValue;
1200 fFilterLowercase:=UTF8LowerCase(fFilter);
1201 ApplyFilter;
1202 end;
1203
1204 procedure TCustomControlFilterEdit.SetIdleConnected(const AValue: Boolean);
1205 begin
1206 if fIdleConnected=AValue then exit;
1207 fIdleConnected:=AValue;
1208 if fIdleConnected then
1209 Application.AddOnIdleHandler(@OnIdle)
1210 else
1211 Application.RemoveOnIdleHandler(@OnIdle);
1212 end;
1213
1214 procedure TCustomControlFilterEdit.EditKeyDown(var Key: Word; Shift: TShiftState);
1215 var
1216 Handled: Boolean;
1217 begin
1218 Handled:=False;
1219 if Shift = [] then
1220 case Key of
1221 VK_RETURN: Handled:=ReturnKeyHandled;
1222 end;
1223
1224 if (Shift = []) or (Shift = [ssShift]) then
1225 begin
1226 case Key of
1227 VK_UP: begin MovePrev(ssShift in Shift); Handled:=True; end;
1228 VK_DOWN: begin MoveNext(ssShift in Shift); Handled:=True; end;
1229 VK_PRIOR: begin MovePageUp(ssShift in Shift); Handled:=True; end;
1230 VK_NEXT: begin MovePageDown(ssShift in Shift); Handled:=True; end;
1231 end;
1232 end;
1233 if (Shift = [ssCtrl]) or (Shift = [ssCtrl, ssShift]) then
1234 begin
1235 case Key of
1236 VK_HOME: begin MoveHome(ssShift in Shift); Handled:=True; end;
1237 VK_END: begin MoveEnd(ssShift in Shift); Handled:=True; end;
1238 end;
1239 end;
1240 if Handled then
1241 Key:=VK_UNKNOWN
1242 else
1243 inherited EditKeyDown(Key, Shift);
1244 end;
1245
1246 procedure TCustomControlFilterEdit.EditChange;
1247 begin
1248 Filter:=Text;
1249 inherited;
1250 end;
1251
1252 procedure TCustomControlFilterEdit.BuddyClick;
1253 begin
1254 Text:='';
1255 Filter:='';
1256 if FocusOnButtonClick then
1257 Edit.SetFocus; //don't SelectAll here
1258 inherited;
1259 end;
1260
1261 procedure TCustomControlFilterEdit.ApplyFilter(Immediately: Boolean);
1262 begin
1263 if Immediately then begin
1264 fNeedUpdate := False;
1265 SortAndFilter;
1266 if (fSelectedPart=Nil) and not fIsFirstUpdate then
1267 StoreSelection; // At first round the selection is from caller
1268 fIsFirstUpdate:=False;
1269
1270 ApplyFilterCore; // The actual filtering implemented by inherited class.
1271
1272 fSelectedPart:=Nil;
1273 RestoreSelection;
1274 end
1275 else if [csDestroying,csDesigning]*ComponentState=[] then
1276 InvalidateFilter;
1277 end;
1278
1279 procedure TCustomControlFilterEdit.InvalidateFilter;
1280 begin
1281 fNeedUpdate:=true;
1282 IdleConnected:=true;
1283 end;
1284
TCustomControlFilterEdit.IsTextHintStorednull1285 function TCustomControlFilterEdit.IsTextHintStored: Boolean;
1286 begin
1287 Result := TextHint <> rsFilter;
1288 end;
1289
1290 procedure TCustomControlFilterEdit.ResetFilter;
1291 begin
1292 Filter := '';
1293 end;
1294
ForceFilternull1295 function TCustomControlFilterEdit.ForceFilter(AFilter: String): String;
1296 // Apply a new filter immediately without waiting for idle. Returns the previous filter.
1297 begin
1298 Result := FFilter;
1299 if fFilter <> AFilter then begin
1300 FFilter := AFilter;
1301 ApplyFilter(True);
1302 end;
1303 end;
1304
GetDefaultGlyphNamenull1305 function TCustomControlFilterEdit.GetDefaultGlyphName: string;
1306 begin
1307 Result := ResBtnListFilter;
1308 end;
1309
1310 { TFileNameEdit }
1311
1312 constructor TFileNameEdit.Create(AOwner: TComponent);
1313 begin
1314 inherited Create(AOwner);
1315 FDialogFiles := TStringList.Create;
1316 FDialogKind := dkOpen;
1317 FDialogOptions := DefaultOpenDialogOptions;
1318 end;
1319
1320 destructor TFileNameEdit.Destroy;
1321 begin
1322 FreeAndNil(FDialogFiles);
1323 inherited Destroy;
1324 end;
1325
1326 procedure TFileNameEdit.SetFileName(const AValue: String);
1327 begin
1328 if FFileNameChangeLock > 0 then
1329 Exit;
1330 FFileName := AValue;
1331 Inc(FFileNameChangeLock);
1332 try
1333 if FHideDirectories then
1334 Text:=ExtractFileName(AValue) //Originally used inherited RealSetText()
1335 else
1336 Text:=AValue
1337 finally
1338 Dec(FFileNameChangeLock);
1339 end;
1340 end;
1341
TFileNameEdit.CreateDialognull1342 function TFileNameEdit.CreateDialog(AKind: TDialogKind): TCommonDialog;
1343 var
1344 O: TOpenDialog;
1345 S: TSaveDialog;
1346 Dir: String;
1347 begin
1348 case AKind of
1349 dkOpen, dkPictureOpen:
1350 begin
1351 if AKind = dkPictureOpen then
1352 O := TOpenPictureDialog.Create(Self)
1353 else
1354 O := TOpenDialog.Create(Self);
1355 Result := O;
1356 end;
1357 dkSave, dkPictureSave:
1358 begin
1359 S:=TSaveDialog.Create(Self);
1360 S.DefaultExt := FDefaultExt;
1361 Result := S;
1362 end;
1363 end;
1364 if Result is TOpenDialog then
1365 begin
1366 O:=TOpenDialog(Result);
1367 Dir:=ExtractFilePath(Filename);
1368 if (Dir<>'') and DirPathExists(Dir) then
1369 // setting a FileName with path disables InitialDir
1370 O.FileName := FileName
1371 else begin
1372 // do not use path, so that InitialDir works
1373 O.FileName := ExtractFileName(Filename);
1374 end;
1375 O.Options := DialogOptions;
1376 O.Filter := Filter;
1377 O.FilterIndex := FilterIndex;
1378 O.InitialDir := CleanAndExpandDirectory(InitialDir);
1379 end;
1380 // Set some common things.
1381 Result.Title := DialogTitle;
1382 end;
1383
1384 procedure TFileNameEdit.SaveDialogResult(AKind: TDialogKind; D: TCommonDialog);
1385 var
1386 FN: String;
1387 begin
1388 case AKind of
1389 dkOpen, dkPictureOpen :
1390 begin
1391 FilterIndex := TOpenDialog(D).FilterIndex;
1392 FN := TOpenDialog(D).FileName;
1393 if (FN <> '') then
1394 begin
1395 if Assigned(OnAcceptFileName) then
1396 OnAcceptFileName(Self, FN);
1397 end;
1398 if (FN <> '') then
1399 begin
1400 // set FDialogFiles first since assigning of FileName trigger events
1401 FDialogFiles.Text := TOpenDialog(D).Files.Text;
1402 FileName := FN;
1403 end;
1404 end;
1405 dkSave, dkPictureSave :
1406 begin
1407 FileName := TSaveDialog(D).FileName;
1408 FilterIndex := TSaveDialog(D).FilterIndex;
1409 FDialogFiles.Clear;
1410 end;
1411 end;
1412 end;
1413
1414 procedure TFileNameEdit.ButtonClick;
1415 begin
1416 inherited ButtonClick;
1417 RunDialog;
1418 //Do this after the dialog, otherwise it just looks silly
1419 if FocusOnButtonClick then FocusAndMaybeSelectAll;
1420 end;
1421
TFileNameEdit.GetDefaultGlyphNamenull1422 function TFileNameEdit.GetDefaultGlyphName: string;
1423 begin
1424 Result := ResBtnFileOpen;
1425 end;
1426
1427 procedure TFileNameEdit.RunDialog;
1428 var
1429 D: TCommonDialog;
1430 begin
1431 D := CreateDialog(DialogKind);
1432 try
1433 if D.Execute then
1434 SaveDialogResult(DialogKind, D);
1435 finally
1436 D.Free;
1437 end
1438 end;
1439
1440 procedure TFileNameEdit.EditChange;
1441 begin
1442 if FFileNameChangeLock <= 0 then
1443 begin
1444 Inc(FFileNameChangeLock);
1445 try
1446 if FHideDirectories and (ExtractFilePath(Text) = '') then
1447 FFileName := ExtractFilePath(FFileName) + Text
1448 else
1449 FFileName := Text;
1450 finally
1451 Dec(FFileNameChangeLock);
1452 end;
1453 end;
1454 inherited EditChange; //do this _after_ we have updated FFileName
1455 end;
1456
1457 procedure TFileNameEdit.DoFolderChange(Sender: TObject);
1458 begin
1459 if Assigned(FOnFolderChange) then
1460 FOnFolderChange(Self);
1461 end;
1462
1463 { TDirectoryEdit }
1464
1465 constructor TDirectoryEdit.Create(AOwner: TComponent);
1466 begin
1467 inherited Create(AOwner);
1468 FDialogOptions := DefaultOpenDialogOptions;
1469 end;
1470
1471 procedure TDirectoryEdit.SetDirectory(const AValue: String);
1472 begin
1473 if (Text<>AValue) then
1474 Text:=AValue;
1475 end;
1476
TDirectoryEdit.CreateDialognull1477 function TDirectoryEdit.CreateDialog: TCommonDialog;
1478 begin
1479 Result:=TSelectDirectoryDialog.Create(Self);
1480 if DirPathExists(Directory) then
1481 begin
1482 TSelectDirectoryDialog(Result).InitialDir:=Directory;
1483 TSelectDirectoryDialog(Result).FileName:='';
1484 end
1485 else
1486 begin
1487 TSelectDirectoryDialog(Result).InitialDir:=RootDir;
1488 TSelectDirectoryDialog(Result).FileName:=Directory;
1489 end;
1490 // Set some common things.
1491 TSelectDirectoryDialog(Result).Options := DialogOptions;
1492 Result.Title := DialogTitle;
1493 end;
1494
TDirectoryEdit.GetDialogResultnull1495 function TDirectoryEdit.GetDialogResult(D: TCommonDialog) : String;
1496 begin
1497 Result:=TSelectDirectoryDialog(D).FileName;
1498 end;
1499
1500 procedure TDirectoryEdit.ButtonClick;
1501 begin
1502 inherited ButtonClick;
1503 RunDialog;
1504 //Do this after the dialog, oterwise it just looks silly
1505 if FocusOnButtonClick then FocusAndMaybeSelectAll;
1506 end;
1507
GetDefaultGlyphNamenull1508 function TDirectoryEdit.GetDefaultGlyphName: string;
1509 begin
1510 Result := ResBtnSelDir;
1511 end;
1512
1513 procedure TDirectoryEdit.RunDialog;
1514 var
1515 D: String;
1516 Dlg: TCommonDialog;
1517 B: Boolean;
1518 begin
1519 Dlg:=CreateDialog;
1520 try
1521 B:=Dlg.Execute;
1522 if B then
1523 D:=GetDialogResult(Dlg);
1524 finally
1525 Dlg.Free;
1526 end;
1527 if B then
1528 begin
1529 if Assigned(FOnAcceptDir) then
1530 begin
1531 FOnAcceptdir(Self,D);
1532 if (D<>'') then
1533 Directory:=D;
1534 end
1535 else
1536 Directory:=D;
1537 end;
1538 end;
1539
TDirectoryEdit.GetDirectorynull1540 function TDirectoryEdit.GetDirectory: String;
1541 begin
1542 Result:=Text;
1543 end;
1544
1545 { TDateEdit }
1546
StrToDateDefnull1547 function StrToDateDef(cDate: String; dDefault: TDateTime): TDateTime;
1548 begin
1549 try
1550 Result := StrToDate(cDate)
1551 except
1552 Result := dDefault;
1553 end;
1554 end;
1555
1556 constructor TDateEdit.Create(AOwner: TComponent);
1557 begin
1558 inherited Create(AOwner);
1559 FDate := NullDate;
1560 FUpdatingDate := False;
1561 FDefaultToday := False;
1562 FDisplaySettings := [dsShowHeadings, dsShowDayNames];
1563 end;
1564
1565
GetDateFormatnull1566 function TDateEdit.GetDateFormat: string;
1567 begin
1568 Result := FFixedDateFormat;
1569 end;
1570
TDateEdit.GetDefaultGlyphNamenull1571 function TDateEdit.GetDefaultGlyphName: string;
1572 begin
1573 Result := ResBtnCalendar;
1574 end;
1575
1576 procedure TDateEdit.ButtonClick;//or onClick
1577 var
1578 PopupOrigin: TPoint;
1579 ADate: TDateTime;
1580 begin
1581 inherited ButtonClick;
1582
1583 PopupOrigin := ControlToScreen(Point(0, Height));
1584 ADate := GetDate;
1585 if ADate = NullDate then
1586 ADate := SysUtils.Date;
1587 ShowCalendarPopup(PopupOrigin, ADate, CalendarDisplaySettings,
1588 @CalendarPopupReturnDate, @CalendarPopupShowHide, self);
1589 //Do this after the dialog, otherwise it just looks silly
1590 if FocusOnButtonClick then FocusAndMaybeSelectAll;
1591 end;
1592
1593
1594 procedure TDateEdit.EditDblClick;
1595 begin
1596 inherited EditDblClick;
1597 if not ReadOnly then
1598 ButtonClick;
1599 end;
1600
1601 procedure TDateEdit.EditEditingDone;
1602 var
1603 AText: String;
1604 begin
1605 inherited EditEditingDone;
1606 if DirectInput then
1607 begin
1608 AText := DateToText(GetDate);
1609 if AText <> Text then //avoid unneccesary recalculation FDate
1610 Text := AText;
1611 end;
1612 end;
1613
1614 procedure TDateEdit.SetDirectInput(AValue: Boolean);
1615 var
1616 Def: TDateTime;
1617 begin
1618 inherited SetDirectInput(AValue);
1619 //Synchronize FDate
1620 FDate := TextToDate(Text, NullDate);
1621 //Force a valid date in the control, but not if Text was empty in designmode
1622 if not ((csDesigning in ComponentState) and FDefaultToday and (FDate = NullDate)) then
1623 SetDate(FDate);
1624 end;
1625
1626 procedure TDateEdit.RealSetText(const AValue: TCaption);
1627 begin
1628 if (not DirectInput) and not FUpdatingDate then
1629 begin
1630 //force a valid date and set FDate
1631 //debugln('TDateEdit.SetText: DirectInput = False');
1632 if FDefaultToday then
1633 FDate := TextToDate(AValue, SysUtils.Date)
1634 else
1635 FDate := TextToDate(AValue, NullDate);
1636 //Allow to clear Text in Designer (Issue #0030425)
1637 if (csDesigning in ComponentState) and (AValue = '') then
1638 inherited RealSetText('')
1639 else
1640 inherited RealSetText(DateToText(FDate));
1641 end else
1642 inherited RealSetText(AValue);
1643 end;
1644
1645 procedure TDateEdit.SetDateMask;
1646
1647 Var
1648 S : String;
1649 D : TDateTime;
1650 begin
1651 Case DateOrder of
1652 doNone :
1653 begin
1654 S:=''; // no mask
1655 FFixedDateFormat:='';
1656 end;
1657 doDMY,
1658 doMDY :
1659 begin
1660 S:='99/99/9999;1;_';
1661 if DateOrder=doMDY then
1662 FFixedDateFormat:='mm/dd/yyyy'
1663 else
1664 FFixedDateFormat:='dd/mm/yyyy';
1665 end;
1666 doYMD :
1667 begin
1668 S:='9999/99/99;1;_';
1669 FFixedDateFormat:='yyyy/mm/dd';
1670 end;
1671 end;
1672 D:=GetDate;
1673 EditMask:=S;
1674 SetDate(D);
1675 end;
1676
1677 procedure TDateEdit.Loaded;
1678 begin
1679 inherited Loaded;
1680 //Forces a valid Text in the control
1681 if not (csDesigning in ComponentState) then
1682 SetDate(FDate);
1683 end;
1684
ParseDatenull1685 Function ParseDate(S : String; Order : TDateOrder; Def: TDateTime) : TDateTime;
1686
1687 Var
1688 P,N1,N2,N3 : Integer;
1689 B : Boolean;
1690
1691 begin
1692 Result:=Def;
1693 P:=Pos(DefaultFormatSettings.DateSeparator,S);
1694 If (P=0) then
1695 Exit;
1696 N1:=StrToIntDef(Copy(S,1,P-1),-1);
1697 If (N1=-1) then Exit;
1698 Delete(S,1,P);
1699 P:=Pos(DefaultFormatSettings.DateSeparator,S);
1700 If (P=0) then
1701 Exit;
1702 N2:=StrToIntDef(Copy(S,1,P-1),-1);
1703 If (N1=0) then Exit;
1704 Delete(S,1,P);
1705 N3:=StrToIntDef(S,-1);
1706 If (N3=-1) then
1707 exit;
1708 Case Order of
1709 doYMD : B:=TryEncodeDate(N1,N2,N3,Result);
1710 doMDY : B:=TryEncodeDate(N3,N1,N2,Result);
1711 doDMY : B:=TryEncodeDate(N3,N2,N1,Result);
1712 else B:=false;
1713 end;
1714 If not B then // Not sure if TryEncodeDate touches Result.
1715 Result:=Def;
1716 end;
1717
1718 // Tries to parse string when DateOrder = doNone when string maybe contains
1719 // literal day or monthnames. For example when ShortDateFormat = 'dd-mmm-yyy'
1720 // Returns NullDate upon failure.
ParseDateNoPredefinedOrdernull1721 function ParseDateNoPredefinedOrder(SDate: String; FS: TFormatSettings): TDateTime;
1722 var
1723 Fmt: String;
1724 DPos, MPos, YPos: SizeInt;
1725 DStr, MStr, YStr: String;
1726 LD, LM, LY: LongInt;
1727 DD, MM, YY: Word;
1728 const
1729 Digits = ['0'..'9'];
1730
1731 procedure GetPositions(out DPos, MPos, YPos: SizeInt);
1732 begin
1733 DStr := '';
1734 MStr := '';
1735 YStr := '';
1736 DPos := Pos('D', Fmt);
1737 MPos := Pos('M', Fmt);
1738 YPos := Pos('Y', Fmt);
1739 if (YPos = 0) or (MPos = 0) or (DPos = 0) then Exit;
1740 if (YPos > DPos) then YPos := 3 else YPos := 1;
1741 if (DPos < MPos) then
1742 begin
1743 if (YPos = 3) then
1744 begin
1745 DPos := 1;
1746 MPos := 2;
1747 end
1748 else
1749 begin
1750 DPos := 2;
1751 MPos := 3;
1752 end;
1753 end
1754 else
1755 begin
1756 if (YPos = 3) then
1757 begin
1758 DPos := 2;
1759 MPos := 1;
1760 end
1761 else
1762 begin
1763 DPos := 3;
1764 MPos := 2;
1765 end;
1766 end;
1767 end;
1768
1769 procedure ReplaceLiterals;
1770 var
1771 i, P: Integer;
1772 Sub: String;
1773 begin
1774 if (Pos('MMMM',Fmt) > 0) then
1775 begin //long monthnames
1776 //writeln('Literal monthnames');
1777 for i := 1 to 12 do
1778 begin
1779 Sub := FS.LongMonthNames[i];
1780 P := Pos(Sub, SDate);
1781 if (P > 0) then
1782 begin
1783 Delete(SDate, P, Length(Sub));
1784 Insert(IntToStr(i), SDate, P);
1785 Break;
1786 end;
1787 end;
1788 end
1789 else
1790 begin
1791 if (Pos('MMM',Fmt) > 0) then
1792 begin //short monthnames
1793 for i := 1 to 12 do
1794 begin
1795 Sub := FS.ShortMonthNames[i];
1796 P := Pos(Sub, SDate);
1797 if (P > 0) then
1798 begin
1799 Delete(SDate, P, Length(Sub));
1800 Insert(IntToStr(i), SDate, P);
1801 Break;
1802 end;
1803 end;
1804 end;
1805 end;
1806
1807 if (Pos('DDDD',Fmt) > 0) then
1808 begin //long daynames
1809 //writeln('Literal daynames');
1810 for i := 1 to 7 do
1811 begin
1812 Sub := FS.LongDayNames[i];
1813 P := Pos(Sub, SDate);
1814 if (P > 0) then
1815 begin
1816 Delete(SDate, P, Length(Sub));
1817 Break;
1818 end;
1819 end;
1820 end
1821 else
1822 begin
1823 if (Pos('DDD',Fmt) > 0) then
1824 begin //short daynames
1825 for i := 1 to 7 do
1826 begin
1827 Sub := FS.ShortDayNames[i];
1828 P := Pos(Sub, SDate);
1829 if (P > 0) then
1830 begin
1831 Delete(SDate, P, Length(Sub));
1832 Break;
1833 end;
1834 end;
1835 end;
1836 end;
1837 SDate := Trim(SDate);
1838 //writeln('ReplaceLiterals -> ',SDate);
1839 end;
1840
1841 procedure Split(out DStr, MStr, YStr: String);
1842 var
1843 i, P: Integer;
1844 Sep: Set of Char;
1845 Sub: String;
1846 begin
1847 DStr := '';
1848 MStr := '';
1849 YStr := '';
1850 Sep := [];
1851 for i := 1 to Length(Fmt) do
1852 if not (Fmt[i] in Digits) then Sep := Sep + [Fmt[i]];
1853 //get fist part
1854 P := 1;
1855 while (P <= Length(SDate)) and (SDate[P] in Digits) do Inc(P);
1856 Sub := Copy(SDate, 1, P-1);
1857 Delete(SDate, 1, P);
1858 if (DPos = 1) then DStr := Sub else if (MPos = 1) then MStr := Sub else YStr := Sub;
1859 //get second part
1860 if (SDate = '') then Exit;
1861 while (Length(SDate) > 0) and (SDate[1] in Sep) do Delete(SDate, 1, 1);
1862 if (SDate = '') then Exit;
1863 P := 1;
1864 while (P <= Length(SDate)) and (SDate[P] in Digits) do Inc(P);
1865 Sub := Copy(SDate, 1, P-1);
1866 Delete(SDate, 1, P);
1867 if (DPos = 2) then DStr := Sub else if (MPos = 2) then MStr := Sub else YStr := Sub;
1868 //get thirdpart
1869 if (SDate = '') then Exit;
1870 while (Length(SDate) > 0) and (SDate[1] in Sep) do Delete(SDate, 1, 1);
1871 if (SDate = '') then Exit;
1872 Sub := SDate;
1873 if (DPos = 3) then DStr := Sub else if (MPos = 3) then MStr := Sub else YStr := Sub;
1874 end;
1875
1876 procedure AdjustYear(var YY: Word);
1877 var
1878 CY, CM, CD: Word;
1879 begin
1880 DecodeDate(Date, CY, CM, CD);
1881 LY := CY Mod 100;
1882 CY := CY - LY;
1883 if ((YY - LY) <= 50) then
1884 YY := CY + YY
1885 else
1886 YY := CY + YY - 100;
1887 end;
1888
1889 begin
1890 Result := NullDate; //assume failure
1891 if (Length(SDate) < 5) then Exit; //y-m-d is minimum we support
1892 Fmt := UpperCase(FS.ShortDateFormat); //only care about y,m,d so this will do
1893 GetPositions(DPos, MPos, YPos);
1894 ReplaceLiterals;
1895 if (not (SDate[1] in Digits)) or (not (SDate[Length(SDate)] in Digits)) then Exit;
1896 Split(Dstr, MStr, YStr);
1897 if not TryStrToInt(DStr, LD) or
1898 not TryStrToInt(Mstr, LM) or
1899 not TryStrToInt(YStr, LY) then Exit;
1900 DD := LD;
1901 MM := LM;
1902 YY := LY;
1903 if (YY < 100) and (Pos('YYYY', UpperCase(Fmt)) = 0) then
1904 begin
1905 AdjustYear(YY);
1906 end;
1907 if not TryEncodeDate(YY, MM, DD, Result) then
1908 Result := NullDate;
1909 end;
1910
TDateEdit.TextToDatenull1911 function TDateEdit.TextToDate(AText: String; ADefault: TDateTime): TDateTime;
1912 var
1913 FS: TFormatSettings;
1914 begin
1915 if Assigned(FOnCustomDate) then
1916 FOnCustomDate(Self, AText);
1917 if (DateOrder = doNone) then
1918 begin
1919 FS := DefaultFormatSettings;
1920 if (FFreeDateFormat <> '') then
1921 FS.ShortDateFormat := FFreeDateFormat;
1922 if not TryStrToDate(AText, Result, FS) then
1923 begin
1924 Result := ParseDateNoPredefinedOrder(AText, FS);
1925 if (Result = NullDate) then Result := ADefault;
1926 end;
1927 end
1928 else
1929 Result := ParseDate(AText,DateOrder,ADefault)
1930 end;
1931
1932 procedure TDateEdit.SetFreeDateFormat(AValue: String);
1933 var
1934 D: TDateTime;
1935 begin
1936 if FFreeDateFormat = AValue then Exit;
1937 if (Text <> '') and (FDateOrder = doNone) and (not (csDesigning in ComponentState)) then
1938 begin
1939 D := GetDate;
1940 FFreeDateFormat := AValue;
1941 SetDate(D); //will update the text
1942 end
1943 else
1944 FFreeDateFormat := AValue;
1945 end;
1946
GetDatenull1947 function TDateEdit.GetDate: TDateTime;
1948 var
1949 ADate: string;
1950 Def: TDateTime;
1951 begin
1952 //debugln(['TDateEdit.GetDate: FDate = ',DateToStr(FDate)]);
1953 if (FDate = NullDate) and FDefaultToday then
1954 Def := SysUtils.Date
1955 else
1956 Def := FDate;
1957 ADate := Trim(Text);
1958 //if not DirectInput then FDate matches the Text, so no need to parse it
1959 if {(ADate <> '') and} DirectInput then
1960 begin
1961 if (ADate = '') then
1962 begin
1963 if FDefaultToday then
1964 Result := SysUtils.Date
1965 else
1966 Result := NullDate;
1967 end
1968 else
1969 begin
1970 Result := TextToDate(ADate, Def);
1971 FDate := Result;
1972 end;
1973 end
1974 else
1975 Result := Def;
1976 end;
1977
1978 procedure TDateEdit.SetDate(Value: TDateTime);
1979 begin
1980 FUpdatingDate := True;
1981 try
1982 if {not IsValidDate(Value) or }(Value = NullDate) then
1983 begin
1984 if DefaultToday then
1985 Value := SysUtils.Date
1986 else
1987 Value := NullDate;
1988 end;
1989 FDate := Value;
1990 Text := DateToText(FDate);
1991 finally
1992 FUpdatingDate := False;
1993 end;
1994 end;
1995
1996 procedure TDateEdit.CalendarPopupReturnDate(Sender: TObject;
1997 const ADate: TDateTime);
1998 var
1999 B: Boolean;
2000 D: TDateTime;
2001 begin
2002 try
2003 B := True;
2004 D := ADate;
2005 if Assigned(FOnAcceptDate) then
2006 FOnAcceptDate(Self, D, B);
2007 if B then
2008 Self.Date := D;
2009 except
2010 on E:Exception do
2011 MessageDlg(E.Message, mtError, [mbOK], 0);
2012 end;
2013 end;
2014
2015 procedure TDateEdit.CalendarPopupShowHide(Sender: TObject);
2016 begin
2017 FDroppedDown := (Sender as TForm).Visible;
2018 end;
2019
2020 procedure TDateEdit.SetDateOrder(const AValue: TDateOrder);
2021 begin
2022 if FDateOrder=AValue then exit;
2023 FDateOrder:=AValue;
2024 SetDateMask;
2025 end;
2026
TDateEdit.DateToTextnull2027 function TDateEdit.DateToText(Value: TDateTime): String;
2028 var
2029 FS: TFormatSettings;
2030 begin
2031 if Value = NullDate then
2032 Result := ''
2033 else
2034 begin
2035 if (FDateOrder = doNone) or (FFixedDateFormat = '') then
2036 begin
2037 FS := DefaultFormatSettings;
2038 if (FFreeDateFormat <> '') then
2039 FS.ShortDateFormat := FFreeDateFormat;
2040 Result := DateToStr(Value, FS)
2041 end
2042 else
2043 Result := FormatDateTime(FFixedDateFormat, Value)
2044 end;
2045 end;
2046
2047 { TTimeEdit }
2048
TTimeEdit.GetTimenull2049 function TTimeEdit.GetTime: TDateTime;
2050 var
2051 TmpResult: TDateTime;
2052 begin
2053 if DirectInput and TryParseInput(Text, TmpResult) then
2054 FTime := TmpResult;
2055 Result := FTime;
2056 if IsEmptyTime then begin
2057 if FDefaultNow then
2058 Result := TimeOf(Now);
2059 end else begin
2060 if Assigned(FOnCustomTime) then
2061 FOnCustomTime(Self, Result);
2062 end;
2063 end;
2064
GetLayoutnull2065 function TTimeEdit.GetLayout: Boolean;
2066 begin
2067 Result := FSimpleLayout;
2068 end;
2069
2070 procedure TTimeEdit.SetLayout(AValue: Boolean);
2071 begin
2072 FSimpleLayout := AValue;
2073 end;
2074
2075 procedure TTimeEdit.SetTime(AValue: TDateTime);
2076 var
2077 Output: String;
2078 begin
2079 DateTimeToString(Output, DefaultFormatSettings.ShortTimeFormat, AValue);
2080 Text := Output;
2081 FTime := AValue;
2082 IsEmptyTime := False;
2083 end;
2084
2085 procedure TTimeEdit.SetEmptyTime;
2086 begin
2087 Text := EmptyStr;
2088 FTime := NullDate;
2089 IsEmptyTime := True;
2090 end;
2091
2092 procedure TTimeEdit.TimePopupReturnTime(Sender: TObject; const ATime: TDateTime);
2093 var
2094 AcceptResult: Boolean;
2095 ReturnedTime: TDateTime;
2096 begin
2097 try
2098 AcceptResult := True;
2099 ReturnedTime := ATime;
2100 if Assigned(FOnAcceptTime) then
2101 FOnAcceptTime(Self, ReturnedTime, AcceptResult);
2102 if AcceptResult then
2103 Self.Time := ReturnedTime;
2104 except
2105 on E:Exception do
2106 MessageDlg(E.Message, mtError, [mbOK], 0);
2107 end;
2108 end;
2109
2110 procedure TTimeEdit.TimePopupShowHide(Sender: TObject);
2111 begin
2112 FDroppedDown := (Sender as TForm).Visible;
2113 end;
2114
2115 procedure TTimeEdit.OpenTimePopup;
2116 var
2117 PopupOrigin: TPoint;
2118 ATime: TDateTime;
2119 begin
2120 ParseInput;
2121 PopupOrigin := ControlToScreen(Point(0, Height));
2122 ATime := GetTime;
2123 if ATime = NullDate then
2124 ATime := SysUtils.Time;
2125 ShowTimePopup(PopupOrigin, ATime, Self.DoubleBuffered,
2126 @TimePopupReturnTime, @TimePopupShowHide, FSimpleLayout, self);
2127 end;
2128
TryParseInputnull2129 function TTimeEdit.TryParseInput(AInput: String; out ParseResult: TDateTime): Boolean;
2130 begin
2131 AInput := Trim(AInput);
2132 if (Length(AInput) in [3..4]) and (not AnsiContainsStr(AInput, DefaultFormatSettings.TimeSeparator)) then begin
2133 Insert(DefaultFormatSettings.TimeSeparator, AInput, Length(AInput) - 1);
2134 end;
2135 Result := TryStrToTime(AInput, ParseResult);
2136 end;
2137
2138 procedure TTimeEdit.ParseInput;
2139 var
2140 TmpResult: TDateTime;
2141 begin
2142 if Trim(Text) = EmptyStr then
2143 SetEmptyTime
2144 else if TryParseInput(Self.Text, TmpResult) then
2145 SetTime(TmpResult)
2146 else
2147 SetTime(FTime);
2148 end;
2149
GetDefaultGlyphNamenull2150 function TTimeEdit.GetDefaultGlyphName: string;
2151 begin
2152 Result := ResBtnTime;
2153 end;
2154
2155 procedure TTimeEdit.ButtonClick;
2156 begin
2157 inherited ButtonClick;
2158 OpenTimePopup;
2159 end;
2160
2161 procedure TTimeEdit.EditDblClick;
2162 begin
2163 inherited EditDblClick;
2164 OpenTimePopup;
2165 end;
2166
2167 procedure TTimeEdit.EditEditingDone;
2168 begin
2169 ParseInput;
2170 inherited EditEditingDone;
2171 end;
2172
2173 constructor TTimeEdit.Create(AOwner: TComponent);
2174 begin
2175 inherited Create(AOwner);
2176 SetEmptyTime;
2177 FSimpleLayout := True;
2178 end;
2179
2180 { TCalcEdit }
2181
GetAsFloatnull2182 function TCalcEdit.GetAsFloat: Double;
2183 begin
2184 Result := StrToFloatDef(Trim(Text), 0.0);
2185 end;
2186
TCalcEdit.GetAsIntegernull2187 function TCalcEdit.GetAsInteger: Integer;
2188 begin
2189 Result:=StrToIntDef(Text,0);
2190 end;
2191
TCalcEdit.GetDefaultGlyphNamenull2192 function TCalcEdit.GetDefaultGlyphName: string;
2193 begin
2194 Result := ResBtnCalculator;
2195 end;
2196
2197 procedure TCalcEdit.SetAsFloat(const AValue: Double);
2198 begin
2199 Text:=FloatToStr(AValue);
2200 end;
2201
2202 procedure TCalcEdit.SetAsInteger(const AValue: Integer);
2203 begin
2204 Text:=IntToStr(AValue);
2205 end;
2206
TitleStorednull2207 function TCalcEdit.TitleStored: boolean;
2208 begin
2209 Result:=FDialogTitle<>rsCalculator;
2210 end;
2211
2212 procedure TCalcEdit.ButtonClick;
2213 begin
2214 inherited ButtonClick;
2215 RunDialog;
2216 //Do this after the dialog, otherwise it just looks silly
2217 if FocusOnButtonClick then FocusAndMaybeSelectAll;
2218 end;
2219
2220 procedure TCalcEdit.RunDialog;
2221 var
2222 D : Double;
2223 B : Boolean;
2224 Dlg: TCalculatorForm;
2225 begin
2226 D:=AsFloat;
2227 Dlg := CreateCalculatorForm(Self,FCalculatorLayout,0);
2228 with Dlg do
2229 try
2230 Caption:=DialogTitle;
2231 Value:=D;
2232 Dlg.Top := FDialogTop;
2233 Dlg.Left := FDialogLeft;
2234 Dlg.Position := FDialogPosition;
2235 if (ShowModal=mrOK) then
2236 begin
2237 D:=Value;
2238 B:=True;
2239 If Assigned(FOnAcceptValue) then
2240 FOnAcceptValue(Self,D,B);
2241 if B then
2242 AsFloat:=D;
2243 end;
2244 finally
2245 Free;
2246 end;
2247 end;
2248
2249 constructor TCalcEdit.Create(AOwner: TComponent);
2250 begin
2251 inherited Create(AOwner);
2252 FDialogTitle:=rsCalculator;
2253 FDialogPosition := poScreenCenter;
2254 end;
2255
2256
2257 procedure Register;
2258 begin
2259 RegisterComponents('Misc', [TEditButton,TFileNameEdit,TDirectoryEdit,
2260 TDateEdit,TTimeEdit,TCalcEdit]);
2261 end;
2262
2263 Initialization
2264 RegisterPropertyToSkip(TDateEdit, 'OKCaption', 'Property streamed in older Lazarus revision','');
2265 RegisterPropertyToSkip(TDateEdit, 'CancelCaption', 'Property streamed in older Lazarus revision','');
2266 RegisterPropertyToSkip(TCustomControlFilterEdit, 'UseFormActivate', 'Property streamed in older Lazarus revision','');
2267
2268 end.
2269