~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to lcl/editbtn.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
31
31
  Graphics, Controls, Forms, FileUtil, Dialogs, StdCtrls, Buttons, Calendar,
32
32
  ExtDlgs, CalendarPopup, MaskEdit;
33
33
 
 
34
 
34
35
const
35
36
  NullDate: TDateTime = 0;
36
37
 
48
49
    function GetButtonWidth: Integer;
49
50
    function GetDirectInput: Boolean;
50
51
    function GetFlat: Boolean;
51
 
    procedure CheckButtonVisible;
52
52
    procedure SetButtonHint(const AValue: TTranslateString);
53
53
    procedure SetButtonNeedsFocus(const AValue: Boolean);
54
54
    procedure SetButtonWidth(const AValue: Integer);
62
62
    procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
63
63
    procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
64
64
  protected
 
65
    procedure CheckButtonVisible;
 
66
    function CalcButtonVisible: boolean; virtual;
 
67
    function CalcButtonEnabled: Boolean; virtual;
65
68
    function GetReadOnly: Boolean; override;
66
69
    function GetDefaultGlyph: TBitmap; virtual;
67
70
    function GetDefaultGlyphName: String; virtual;
73
76
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
74
77
    procedure CMVisibleChanged(var Msg: TLMessage); message CM_VISIBLECHANGED;
75
78
    procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED;
 
79
    procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
76
80
    // New properties.
77
81
    property ButtonWidth : Integer read GetButtonWidth write SetButtonWidth;
78
82
    property DirectInput : Boolean read GetDirectInput write SetDirectInput default True;
88
92
    property ButtonOnlyWhenFocused: Boolean read FButtonNeedsFocus write SetButtonNeedsFocus default False;
89
93
  end;
90
94
  
91
 
  
92
95
  { TEditButton }
93
 
  
 
96
 
94
97
  TEditButton = class(TCustomEditButton)
95
98
  Public
96
99
    property Button;
99
102
    property AutoSelect;
100
103
    property Align;
101
104
    property Anchors;
 
105
    property BidiMode;
102
106
    property BorderSpacing;
103
107
    property BorderStyle;
104
108
    property ButtonOnlyWhenFocused;
134
138
    property OnMouseUp;
135
139
    property OnStartDrag;
136
140
    property OnUTF8KeyPress;
 
141
    property ParentBidiMode;
137
142
    property ParentColor;
138
143
    property ParentFont;
139
144
    property ParentShowHint;
147
152
    property Visible;
148
153
  end;
149
154
 
 
155
  // Called when an item is filtered. Returns true if the item passes the filter.
 
156
  // Done=False means the data should also be filtered by its title string.
 
157
  // Done=True means no other filtering is needed.
 
158
  TFilterItemEvent = function (Item: TObject; out Done: Boolean): Boolean of object;
 
159
 
 
160
  // Can be used only for items that have a checkbox. Returns true if checked.
 
161
  TCheckItemEvent = function (Item: TObject): Boolean of object;
 
162
 
 
163
  { TCustomControlFilterEdit }
 
164
 
 
165
  // An abstract base class for edit controls which filter data in
 
166
  // visual controls like TListView and TTreeView.
 
167
  TCustomControlFilterEdit = class(TCustomEditButton)
 
168
  private
 
169
    fFilter: string;
 
170
    fIdleConnected: Boolean;
 
171
    fSortData: Boolean;             // Data needs to be sorted.
 
172
    procedure SetFilter(const AValue: string);
 
173
    procedure SetIdleConnected(const AValue: Boolean);
 
174
    procedure OnIdle(Sender: TObject; var Done: Boolean);
 
175
  protected
 
176
    fNeedUpdate: Boolean;
 
177
    fIsFirstUpdate: Boolean;
 
178
    fSelectedPart: TObject;         // Select this node on next update
 
179
    fOnFilterItem: TFilterItemEvent;
 
180
    fOnCheckItem: TCheckItemEvent;
 
181
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
 
182
    procedure Change; override;
 
183
    procedure DoEnter; override;
 
184
    procedure DoExit; override;
 
185
    procedure DoButtonClick (Sender: TObject); override;
 
186
    procedure SortAndFilter; virtual; abstract;
 
187
    procedure ApplyFilter(Immediately: Boolean = False);
 
188
    procedure ApplyFilterCore; virtual; abstract;
 
189
    procedure MoveNext; virtual; abstract;
 
190
    procedure MovePrev; virtual; abstract;
 
191
    function ReturnPressed: Boolean; virtual; abstract;
 
192
    function GetDefaultGlyphName: String; override;
 
193
  public
 
194
    constructor Create(AOwner: TComponent); override;
 
195
    destructor Destroy; override;
 
196
    procedure InvalidateFilter;
 
197
    procedure StoreSelection; virtual; abstract;
 
198
    procedure RestoreSelection; virtual; abstract;
 
199
  public
 
200
    property Filter: string read fFilter write SetFilter;
 
201
    property IdleConnected: Boolean read fIdleConnected write SetIdleConnected;
 
202
    property SortData: Boolean read fSortData write fSortData;
 
203
    property SelectedPart: TObject read fSelectedPart write fSelectedPart;
 
204
  published
 
205
    property OnFilterItem: TFilterItemEvent read fOnFilterItem write fOnFilterItem;
 
206
    property OnCheckItem: TCheckItemEvent read fOnCheckItem write fOnCheckItem;
 
207
    // TEditButton properties.
 
208
    property ButtonWidth;
 
209
    property DirectInput;
 
210
    property ButtonOnlyWhenFocused;
 
211
    property NumGlyphs;
 
212
    property Flat;
 
213
    // Other properties
 
214
    property Align;
 
215
    property Anchors;
 
216
    property BidiMode;
 
217
    property BorderSpacing;
 
218
    property BorderStyle;
 
219
    property AutoSize;
 
220
    property AutoSelect;
 
221
    property Color;
 
222
    property DragCursor;
 
223
    property DragMode;
 
224
    property Enabled;
 
225
    property Font;
 
226
    property MaxLength;
 
227
    property ParentBidiMode;
 
228
    property ParentColor;
 
229
    property ParentFont;
 
230
    property ParentShowHint;
 
231
    property PopupMenu;
 
232
    property ReadOnly;
 
233
    property ShowHint;
 
234
    property TabOrder;
 
235
    property TabStop;
 
236
    property Visible;
 
237
    property OnChange;
 
238
    property OnClick;
 
239
    property OnDblClick;
 
240
    property OnDragDrop;
 
241
    property OnDragOver;
 
242
    property OnEditingDone;
 
243
    property OnEndDrag;
 
244
    property OnEnter;
 
245
    property OnExit;
 
246
    property OnKeyDown;
 
247
    property OnKeyPress;
 
248
    property OnKeyUp;
 
249
    property OnMouseDown;
 
250
    property OnMouseMove;
 
251
    property OnMouseUp;
 
252
    property OnStartDrag;
 
253
    property OnUTF8KeyPress;
 
254
  end;
150
255
 
151
256
  { TFileNameEdit }
152
257
 
165
270
    FDefaultExt: String;
166
271
    FHideDirectories: Boolean;
167
272
    FInitialDir: String;
168
 
    FOnAcceptFN: TAcceptFileNameEvent;
 
273
    FOnAcceptFileName: TAcceptFileNameEvent;
169
274
    FOnFolderChange: TNotifyEvent;
170
275
    FFileNameChangeLock: Integer;
171
276
    procedure SetFileName(const AValue: String);
172
277
  protected
173
278
    function GetDefaultGlyph: TBitmap; override;
174
279
    function GetDefaultGlyphName: String; override;
175
 
    function CreateDialog(AKind : TDialogKind) : TCommonDialog; virtual;
176
 
    procedure SaveDialogResult(AKind : TDialogKind; D : TCommonDialog); virtual;
 
280
    function CreateDialog(AKind: TDialogKind): TCommonDialog; virtual;
 
281
    procedure SaveDialogResult(AKind: TDialogKind; D: TCommonDialog); virtual;
177
282
    procedure DoButtonClick (Sender: TObject); override;
178
283
    procedure RunDialog; virtual;
179
284
    procedure TextChanged; override;
186
291
    // TFileName properties.
187
292
    property FileName: String read FFileName write SetFileName;
188
293
    property InitialDir: String read FInitialDir write FInitialDir;
189
 
    property OnAcceptFileName: TAcceptFileNameEvent read FOnAcceptFN write FonAcceptFN;
 
294
    property OnAcceptFileName: TAcceptFileNameEvent read FOnAcceptFileName write FOnAcceptFileName;
190
295
    property OnFolderChange: TNotifyEvent read FOnFolderChange write FOnFolderChange;
191
296
    property DialogKind: TDialogKind read FDialogKind write FDialogKind default dkOpen;
192
297
    property DialogTitle: String read FDialogTitle write FDialogTitle;
193
 
    property DialogOptions: TOpenOptions read FDialogOptions write FDialogOptions;
 
298
    property DialogOptions: TOpenOptions read FDialogOptions write FDialogOptions default DefaultOpenDialogOptions;
194
299
    property Filter: String read FFilter write FFilter;
195
300
    property FilterIndex: Integer read FFilterIndex write FFIlterIndex;
196
301
    property DefaultExt: String read FDefaultExt write FDefaultExt;
207
312
    property Alignment;
208
313
    property Anchors;
209
314
    property AutoSelect;
 
315
    property BidiMode;
210
316
    property BorderSpacing;
211
317
    property BorderStyle;
212
318
    property AutoSize;
216
322
    property Enabled;
217
323
    property Font;
218
324
    property MaxLength;
 
325
    property ParentBidiMode;
219
326
    property ParentColor;
220
327
    property ParentFont;
221
328
    property ParentShowHint;
282
389
    property Anchors;
283
390
    property AutoSize;
284
391
    property AutoSelect;
 
392
    property BidiMode;
285
393
    property BorderSpacing;
286
394
    property BorderStyle;
287
395
    property Color;
290
398
    property Enabled;
291
399
    property Font;
292
400
    property MaxLength;
 
401
    property ParentBidiMode;
293
402
    property ParentColor;
294
403
    property ParentFont;
295
404
    property ParentShowHint;
376
485
    property Anchors;
377
486
    property AutoSize;
378
487
    property AutoSelect;
 
488
    property BidiMode;
379
489
    property BorderSpacing;
380
490
    property BorderStyle;
381
491
    property Color;
403
513
    property OnMouseUp;
404
514
    property OnResize;
405
515
    property OnUTF8KeyPress;
 
516
    property ParentBidiMode;
406
517
    property ParentFont;
407
518
    property ParentShowHint;
408
 
    property PasswordChar;
409
519
    property PopupMenu;
410
520
    property ShowHint;
411
521
    property TabStop;
452
562
    // Other properties
453
563
    property Align;
454
564
    property Anchors;
 
565
    property BidiMode;
455
566
    property BorderSpacing;
456
567
    property BorderStyle;
457
568
    property AutoSize;
462
573
    property Enabled;
463
574
    property Font;
464
575
    property MaxLength;
 
576
    property ParentBidiMode;
465
577
    property ParentColor;
466
578
    property ParentFont;
467
579
    property ParentShowHint;
490
602
    property OnUTF8KeyPress;
491
603
  end;
492
604
 
 
605
 
493
606
var
494
607
  FileOpenGlyph: TBitmap;
495
608
  DateGlyph: TBitmap;
496
609
  CalcGlyph: TBitmap;
497
610
 
498
611
const
 
612
  ResBtnListFilter = 'btnfiltercancel';
499
613
  ResBtnFileOpen   = 'btnselfile';
500
614
  ResBtnSelDir     = 'btnseldir';
501
615
  ResBtnCalendar   = 'btncalendar';
506
620
implementation
507
621
 
508
622
 
509
 
{ TEditBtn }
 
623
{ TCustomEditButton }
510
624
 
511
625
constructor TCustomEditButton.Create(AOwner: TComponent);
512
626
var
573
687
    Result := False;
574
688
end;
575
689
 
 
690
function TCustomEditButton.CalcButtonVisible: boolean;
 
691
begin
 
692
  Result := (csdesigning in ComponentState) or
 
693
            (Visible and (Focused or not FButtonNeedsFocus));
 
694
end;
 
695
 
576
696
procedure TCustomEditButton.CheckButtonVisible;
577
697
begin
578
698
  If Assigned(FButton) then
579
 
    FButton.Visible:=(csdesigning in ComponentState) or
580
 
                     (Visible and (Focused or not FButtonNeedsFocus));
 
699
    FButton.Visible:=CalcButtonVisible;
581
700
end;
582
701
 
583
702
procedure TCustomEditButton.SetButtonHint(const AValue: TTranslateString);
636
755
procedure TCustomEditButton.CMVisibleChanged(var Msg: TLMessage);
637
756
begin
638
757
  inherited CMVisibleChanged(Msg);
639
 
  
640
758
  CheckButtonVisible;
641
759
end;
642
760
 
643
761
procedure TCustomEditButton.CMEnabledChanged(var Msg: TLMessage);
644
762
begin
645
763
  inherited CMEnabledChanged(Msg);
 
764
  if (FButton<>nil) then
 
765
    FButton.Enabled:=CalcButtonEnabled;
 
766
end;
646
767
 
647
 
  if (FButton<>nil) and (not ReadOnly) then
648
 
    FButton.Enabled:=Enabled;
 
768
procedure TCustomEditButton.CMBiDiModeChanged(var Message: TLMessage);
 
769
begin
 
770
  inherited;
 
771
  DoPositionButton;
649
772
end;
650
773
 
651
774
function TCustomEditButton.GetMinHeight: Integer;
663
786
procedure TCustomEditButton.Loaded;
664
787
begin
665
788
  inherited Loaded;
 
789
  DoPositionButton;
666
790
  CheckButtonVisible;
667
 
  DoPositionButton; 
668
791
end;
669
792
 
670
793
procedure TCustomEditButton.WMKillFocus(var Message: TLMKillFocus);
671
794
begin
672
 
  if FButtonNeedsFocus then
673
 
    FButton.Visible:=False;
 
795
  CheckButtonVisible;
674
796
  inherited;
675
797
end;
676
798
 
682
804
procedure TCustomEditButton.SetParent(AParent: TWinControl);
683
805
begin
684
806
  inherited SetParent(AParent);
685
 
  if FButton <> nil then 
 
807
  if FButton <> nil then
686
808
  begin
687
 
    DoPositionButton; 
 
809
    DoPositionButton;
688
810
    CheckButtonVisible;
689
811
  end;
690
812
end;
691
813
 
 
814
function TCustomEditButton.CalcButtonEnabled: Boolean;
 
815
begin
 
816
  Result := not FIsReadOnly and Enabled;
 
817
end;
 
818
 
692
819
procedure TCustomEditButton.SetReadOnly(AValue: Boolean);
693
820
begin
694
821
  FIsReadOnly := AValue;
695
822
  if Assigned(FButton) then
696
 
    FButton.Enabled := not FIsReadOnly and Enabled;
 
823
    FButton.Enabled := CalcButtonEnabled;
697
824
  inherited SetReadOnly(FIsReadOnly or (not DirectInput));
698
825
end;
699
826
 
700
827
procedure TCustomEditButton.DoPositionButton;
701
828
begin
702
 
  if FButton = nil then exit; 
 
829
  if FButton = nil then exit;
703
830
  FButton.Parent := Parent;
704
 
  FButton.Visible := Visible;
705
 
  FButton.AnchorToCompanion(akLeft,0,Self); 
 
831
  if BiDiMode = bdLeftToRight then
 
832
    FButton.AnchorToCompanion(akLeft,0,Self)
 
833
  else
 
834
    FButton.AnchorToCompanion(akRight,0,Self);
706
835
end;
707
836
 
708
837
procedure TCustomEditButton.WMSetFocus(var Message: TLMSetFocus);
709
838
begin
710
 
  FButton.Visible:=True;
711
 
  inherited;
 
839
  CheckButtonVisible;
 
840
  inherited;
 
841
end;
 
842
 
 
843
 
 
844
{ TCustomControlFilterEdit }
 
845
 
 
846
constructor TCustomControlFilterEdit.Create(AOwner: TComponent);
 
847
begin
 
848
  inherited Create(AOwner);
 
849
  CharCase:=ecLowerCase;
 
850
  Button.Enabled:=False;
 
851
  fIsFirstUpdate := True;
 
852
end;
 
853
 
 
854
destructor TCustomControlFilterEdit.Destroy;
 
855
begin
 
856
  inherited Destroy;
 
857
end;
 
858
 
 
859
procedure TCustomControlFilterEdit.OnIdle(Sender: TObject; var Done: Boolean);
 
860
begin
 
861
  if fNeedUpdate then
 
862
    ApplyFilter(true);
 
863
  IdleConnected:=false;
 
864
end;
 
865
 
 
866
procedure TCustomControlFilterEdit.SetFilter(const AValue: string);
 
867
var
 
868
  NewValue: String;
 
869
begin
 
870
  if AValue=lisCEFilter then
 
871
    NewValue:=''
 
872
  else
 
873
    NewValue:=AValue;
 
874
  Button.Enabled:=NewValue<>'';
 
875
  if (NewValue='') and not Focused then begin
 
876
    Text:=lisCEFilter;
 
877
    Font.Color:=clBtnShadow;
 
878
  end
 
879
  else begin
 
880
    Text:=NewValue;
 
881
    Font.Color:=clDefault;
 
882
  end;
 
883
  if fFilter=NewValue then exit;
 
884
  fFilter:=NewValue;
 
885
  ApplyFilter;
 
886
end;
 
887
 
 
888
procedure TCustomControlFilterEdit.SetIdleConnected(const AValue: Boolean);
 
889
begin
 
890
  if fIdleConnected=AValue then exit;
 
891
  fIdleConnected:=AValue;
 
892
  if fIdleConnected then
 
893
    Application.AddOnIdleHandler(@OnIdle)
 
894
  else
 
895
    Application.RemoveOnIdleHandler(@OnIdle);
 
896
end;
 
897
 
 
898
procedure TCustomControlFilterEdit.KeyDown(var Key: Word; Shift: TShiftState);
 
899
var
 
900
  Handled: Boolean;
 
901
begin
 
902
  Handled:=False;
 
903
  if Shift = [] then
 
904
    case Key of
 
905
      VK_UP:     begin MovePrev; Handled:=True; end;
 
906
      VK_DOWN:   begin MoveNext; Handled:=True; end;
 
907
      VK_RETURN: Handled:=ReturnPressed;
 
908
    end;
 
909
  if Handled then
 
910
    Key:=VK_UNKNOWN
 
911
  else
 
912
    inherited KeyDown(Key, Shift);
 
913
end;
 
914
 
 
915
procedure TCustomControlFilterEdit.Change;
 
916
begin
 
917
  Filter:=Text;
 
918
  inherited;
 
919
end;
 
920
 
 
921
procedure TCustomControlFilterEdit.DoEnter;
 
922
begin
 
923
  if Text=lisCEFilter then
 
924
    Text:='';
 
925
  inherited;
 
926
end;
 
927
 
 
928
procedure TCustomControlFilterEdit.DoExit;
 
929
begin
 
930
  Filter:=Text;
 
931
  inherited;
 
932
end;
 
933
 
 
934
procedure TCustomControlFilterEdit.DoButtonClick(Sender: TObject);
 
935
begin
 
936
  Filter:='';
 
937
end;
 
938
 
 
939
procedure TCustomControlFilterEdit.ApplyFilter(Immediately: Boolean);
 
940
begin
 
941
  if Immediately then begin
 
942
    fNeedUpdate := False;
 
943
    SortAndFilter;
 
944
    if (fSelectedPart=Nil) and not fIsFirstUpdate then
 
945
      StoreSelection;      // At first round the selection is from caller
 
946
    fIsFirstUpdate:=False;
 
947
 
 
948
    ApplyFilterCore;       // The actual filtering implemented by inherited class.
 
949
 
 
950
    fSelectedPart:=Nil;
 
951
    RestoreSelection;
 
952
  end
 
953
  else begin
 
954
    if [csDestroying,csDesigning]*ComponentState=[] then
 
955
      InvalidateFilter;
 
956
  end;
 
957
end;
 
958
 
 
959
procedure TCustomControlFilterEdit.InvalidateFilter;
 
960
begin
 
961
  fNeedUpdate:=true;
 
962
  IdleConnected:=true;
 
963
end;
 
964
 
 
965
function TCustomControlFilterEdit.GetDefaultGlyphName: String;
 
966
begin
 
967
  Result := ResBtnListFilter;
712
968
end;
713
969
 
714
970
{ TFileNameEdit }
718
974
  inherited Create(AOwner);
719
975
  FDialogFiles := TStringList.Create;
720
976
  FDialogKind := dkOpen;
 
977
  FDialogOptions := DefaultOpenDialogOptions;
721
978
end;
722
979
 
723
980
destructor TFileNameEdit.Destroy;
746
1003
var
747
1004
  O: TOpenDialog;
748
1005
  S: TSaveDialog;
 
1006
  Dir: String;
749
1007
begin
750
 
  Case AKind of
751
 
    dkopen, dkPictureOpen:
 
1008
  case AKind of
 
1009
    dkOpen, dkPictureOpen:
752
1010
    begin
753
 
      O:=TOpenDialog.Create(Self);
754
 
      O.FileName:=FileName;
755
 
      O.Options:=DialogOptions;
756
 
      O.InitialDir:=InitialDir;
757
 
      O.Filter:=Filter;
758
 
      O.FilterIndex:=FilterIndex;
759
 
      Result:=O;
 
1011
      O := TOpenDialog.Create(Self);
 
1012
      Result := O;
760
1013
    end;
761
1014
    dkSave, dkPictureSave:
762
1015
    begin
763
1016
      S:=TSaveDialog.Create(Self);
764
 
      S.DefaultExt:= FDefaultExt;
765
 
      S.Filter:=Filter;
766
 
      S.FilterIndex:=FilterIndex;
767
 
      Result:=S;
768
 
    end;
 
1017
      S.DefaultExt := FDefaultExt;
 
1018
      Result := S;
 
1019
    end;
 
1020
  end;
 
1021
  if Result is TOpenDialog then
 
1022
  begin
 
1023
    O:=TOpenDialog(Result);
 
1024
    Dir:=ExtractFilePath(Filename);
 
1025
    if (Dir<>'') and DirPathExists(Dir) then
 
1026
      // setting a FileName with path disables InitialDir
 
1027
      O.FileName := FileName
 
1028
    else begin
 
1029
      // do not use path, so that InitialDir works
 
1030
      O.FileName := ExtractFileName(Filename);
 
1031
    end;
 
1032
    O.Options := DialogOptions;
 
1033
    O.Filter := Filter;
 
1034
    O.FilterIndex := FilterIndex;
 
1035
    O.InitialDir := CleanAndExpandDirectory(InitialDir);
769
1036
  end;
770
1037
  // Set some common things.
771
1038
  Result.Title := DialogTitle;
776
1043
  FN: String;
777
1044
begin
778
1045
  case AKind of
779
 
    dkOpen,dkPictureOpen :
 
1046
    dkOpen, dkPictureOpen :
780
1047
    begin
781
 
      FN:=TOpenDialog(D).FileName;
782
 
      if (FN<>'') then
 
1048
      FilterIndex := TOpenDialog(D).FilterIndex;
 
1049
      FN := TOpenDialog(D).FileName;
 
1050
      if (FN <> '') then
783
1051
      begin
784
 
        if Assigned(FOnAcceptFN) then
785
 
          FOnAcceptFN(Self,Fn);
 
1052
        if Assigned(OnAcceptFileName) then
 
1053
          OnAcceptFileName(Self, FN);
786
1054
      end;
787
 
      if (FN<>'') then
 
1055
      if (FN <> '') then
788
1056
      begin
789
1057
        // set FDialogFiles first since assigning of FileName trigger events
790
 
        FDialogFiles.Text:=TOpenDialog(D).Files.Text;
791
 
        FileName:=FN;
 
1058
        FDialogFiles.Text := TOpenDialog(D).Files.Text;
 
1059
        FileName := FN;
792
1060
      end;
793
1061
    end;
794
 
    dkSave,dkPictureSave :
 
1062
    dkSave, dkPictureSave :
795
1063
    begin
796
 
      FileName:=TSaveDialog(D).FileName;
 
1064
      FileName := TSaveDialog(D).FileName;
 
1065
      FilterIndex := TSaveDialog(D).FilterIndex;
797
1066
      FDialogFiles.Clear;
798
1067
    end;
799
1068
  end;
817
1086
 
818
1087
procedure TFileNameEdit.RunDialog;
819
1088
var
820
 
  D : TCommonDialog;
 
1089
  D: TCommonDialog;
821
1090
begin
822
 
  D:=CreateDialog(DialogKind);
 
1091
  D := CreateDialog(DialogKind);
823
1092
  try
824
1093
    if D.Execute then
825
 
      SaveDialogResult(DialogKind,D);
 
1094
      SaveDialogResult(DialogKind, D);
826
1095
  finally
827
1096
    D.Free;
828
1097
  end
1207
1476
  FdialogTitle:=rsCalculator;
1208
1477
end;
1209
1478
 
 
1479
 
 
1480
 
1210
1481
procedure Register;
1211
1482
begin
1212
1483
  RegisterComponents('Misc', [TEditButton,TFileNameEdit,TDirectoryEdit,