source: tags/1.3.1/Packages/Common/ULastOpenedList.pas

Last change on this file was 424, checked in by chronos, 2 years ago
  • Modified: Update Common package to version 0.10.
  • Modified: fgl unit replaced by Generics.Collections.
File size: 4.7 KB
Line 
1unit ULastOpenedList;
2
3interface
4
5uses
6 Classes, SysUtils, Registry, URegistry, Menus, XMLConf, DOM;
7
8type
9
10 { TLastOpenedList }
11
12 TLastOpenedList = class(TComponent)
13 private
14 FMaxCount: Integer;
15 FOnChange: TNotifyEvent;
16 procedure SetMaxCount(AValue: Integer);
17 procedure LimitMaxCount;
18 procedure ItemsChange(Sender: TObject);
19 procedure DoChange;
20 public
21 Items: TStringList;
22 constructor Create(AOwner: TComponent); override;
23 destructor Destroy; override;
24 procedure LoadToMenuItem(MenuItem: TMenuItem; ClickAction: TNotifyEvent);
25 procedure LoadFromRegistry(Context: TRegistryContext);
26 procedure SaveToRegistry(Context: TRegistryContext);
27 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; Path: string);
28 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string);
29 procedure AddItem(FileName: string);
30 function GetFirstFileName: string;
31 published
32 property MaxCount: Integer read FMaxCount write SetMaxCount;
33 property OnChange: TNotifyEvent read FOnChange write FOnChange;
34 end;
35
36procedure Register;
37
38
39implementation
40
41procedure Register;
42begin
43 RegisterComponents('Common', [TLastOpenedList]);
44end;
45
46
47{ TLastOpenedList }
48
49procedure TLastOpenedList.SetMaxCount(AValue: Integer);
50begin
51 if FMaxCount = AValue then Exit;
52 FMaxCount := AValue;
53 if FMaxCount < 0 then FMaxCount := 0;
54 LimitMaxCount;
55end;
56
57procedure TLastOpenedList.LimitMaxCount;
58begin
59 while Items.Count > MaxCount do
60 Items.Delete(Items.Count - 1);
61end;
62
63procedure TLastOpenedList.ItemsChange(Sender: TObject);
64begin
65 DoChange;
66end;
67
68procedure TLastOpenedList.DoChange;
69begin
70 if Assigned(FOnChange) then
71 FOnChange(Self);
72end;
73
74constructor TLastOpenedList.Create(AOwner: TComponent);
75begin
76 inherited;
77 Items := TStringList.Create;
78 Items.OnChange := ItemsChange;
79 MaxCount := 10;
80end;
81
82destructor TLastOpenedList.Destroy;
83begin
84 FreeAndNil(Items);
85 inherited;
86end;
87
88procedure TLastOpenedList.LoadToMenuItem(MenuItem: TMenuItem; ClickAction: TNotifyEvent);
89var
90 NewMenuItem: TMenuItem;
91 I: Integer;
92begin
93 if Assigned(MenuItem) then begin
94 while MenuItem.Count > Items.Count do
95 MenuItem.Delete(MenuItem.Count - 1);
96 while MenuItem.Count < Items.Count do begin
97 NewMenuItem := TMenuItem.Create(MenuItem);
98 MenuItem.Add(NewMenuItem);
99 end;
100 for I := 0 to Items.Count - 1 do begin
101 MenuItem.Items[I].Caption := Items[I];
102 MenuItem.Items[I].OnClick := ClickAction;
103 end;
104 end;
105end;
106
107procedure TLastOpenedList.LoadFromRegistry(Context: TRegistryContext);
108var
109 I: Integer;
110 Registry: TRegistryEx;
111 FileName: string;
112begin
113 Registry := TRegistryEx.Create;
114 with Registry do
115 try
116 RootKey := Context.RootKey;
117 OpenKey(Context.Key, True);
118 Items.Clear;
119 I := 0;
120 while ValueExists('File' + IntToStr(I)) and (I < MaxCount) do begin
121 FileName := UTF8Encode(ReadStringWithDefault('File' + IntToStr(I), ''));
122 if Trim(FileName) <> '' then Items.Add(FileName);
123 Inc(I);
124 end;
125 if Assigned(FOnChange) then
126 FOnChange(Self);
127 finally
128 Free;
129 end;
130end;
131
132procedure TLastOpenedList.SaveToRegistry(Context: TRegistryContext);
133var
134 I: Integer;
135 Registry: TRegistryEx;
136begin
137 Registry := TRegistryEx.Create;
138 with Registry do
139 try
140 RootKey := Context.RootKey;
141 OpenKey(Context.Key, True);
142 for I := 0 to Items.Count - 1 do
143 WriteString('File' + IntToStr(I), Items[I]);
144 finally
145 Free;
146 end;
147end;
148
149procedure TLastOpenedList.LoadFromXMLConfig(XMLConfig: TXMLConfig; Path: string
150 );
151var
152 I: Integer;
153 Value: string;
154 Count: Integer;
155begin
156 with XMLConfig do begin
157 Count := GetValue(DOMString(Path + '/Count'), 0);
158 if Count > MaxCount then Count := MaxCount;
159 Items.Clear;
160 for I := 0 to Count - 1 do begin
161 Value := string(GetValue(DOMString(Path + '/File' + IntToStr(I)), ''));
162 if Trim(Value) <> '' then Items.Add(Value);
163 end;
164 if Assigned(FOnChange) then
165 FOnChange(Self);
166 end;
167end;
168
169procedure TLastOpenedList.SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string);
170var
171 I: Integer;
172begin
173 with XMLConfig do begin
174 SetValue(DOMString(Path + '/Count'), Items.Count);
175 for I := 0 to Items.Count - 1 do
176 SetValue(DOMString(Path + '/File' + IntToStr(I)), DOMString(Items[I]));
177 Flush;
178 end;
179end;
180
181procedure TLastOpenedList.AddItem(FileName:string);
182begin
183 if Items.IndexOf(FileName) <> -1 then Items.Delete(Items.IndexOf(FileName));
184 Items.Insert(0, FileName);
185 LimitMaxCount;
186 DoChange;
187end;
188
189function TLastOpenedList.GetFirstFileName: string;
190begin
191 if Items.Count > 0 then Result := Items[0]
192 else Result := '';
193end;
194
195end.
196
Note: See TracBrowser for help on using the repository browser.