source: trunk/Packages/Common/ULastOpenedList.pas

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