Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/InputAssistDataModule.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.6 - (show annotations) (download) (as text)
Tue May 23 14:51:26 2006 UTC (17 years, 10 months ago) by h677
Branch: MAIN
Changes since 1.5: +5 -3 lines
File MIME type: text/x-pascal
デフォルトのファイルをコピーして残して置くように変更

1 unit InputAssistDataModule;
2
3 interface
4
5 uses
6 SysUtils, Classes, Windows;
7
8 type
9 TResistWord = class;
10
11 TInputAssistDM = class(TDataModule)
12 procedure DataModuleDestroy(Sender: TObject);
13 procedure DataModuleCreate(Sender: TObject);
14 private
15 { Private ?辿?転 }
16 FInit : Boolean;
17 FDictionary : TStringList; ///< ?o?^?P???????^?????鼎??
18 function GetSorted: Boolean; ///< ?\?[?g???坦???????転
19 procedure SetSorted(Value: Boolean); ///< ?\?[?g?坦????????
20
21 public
22 { Public ?辿?転 }
23 property Sorted : Boolean read GetSorted write SetSorted;
24 procedure Init(FilePath: String);
25 procedure SaveToFile(FilePath: String);
26 function ResistWordCount : Integer; ///<?o?^?P???????転
27 function GetResistWord(Index: Integer): TResistWord; ///< ?o?^?P?????転
28 procedure DeleteResistWord(ResistWord: TResistWord); ///< ?o?^?P?????鱈??
29 function Add(Key: String): TResistWord; ///< ?o?^?P??????
30 procedure ChangeKey(ResistWord: TResistWord); ///< ?o?^?P?????L?[???X
31 //! Key???L?[???????o?^?????????辿?P???????転
32 function GetStartWithKeyResistWords(Key: String; var list: TStringList): Integer;
33 //! Key???J?e?S?????????o?^?????????辿?P???????転
34 function GetStartWithCategoryResistWords(Key: String; var list: TStringList): Integer;
35 //! Key???J?e?S?????o?^?????????辿?P???????転
36 function GetCategoryResistWords(Key: String; var list: TStringList): Integer;
37 //! ?o?^?????L?[???S?????J?e?S?????X?g???転
38 procedure GetCategoryList(var list: TStringList);
39
40 end;
41
42 TResistWord = class(TObject)
43 private
44 FKey : String; ///< ?????????L?[?????辿
45 FCategory : String; ///< ???鄭
46 FText : String; ///< ???^??
47 public
48 function GetKey: String;
49 procedure SetKey(Value: String);
50 function GetCategory: String;
51 procedure SetCategory(Value: String);
52 function GetText: String;
53 procedure SetText(Value: String);
54 property Key: String read FKey write FKey;
55 property Category: String read FCategory write FCategory;
56 property Text: String read GetText write SetText;
57 end;
58
59 function CategorySort(List: TStringList; Index1, Index2: Integer): Integer;
60 var
61 InputAssistDM: TInputAssistDM;
62
63 implementation
64
65 uses
66 MojuUtils, IniFiles;
67
68 {$R *.dfm}
69 //! FKey???????????????辿?l?????転???辿
70 function TResistWord.GetKey: String;
71 begin
72 //?G?X?P?[?v?直?????辿=?????????辿
73 Result := MojuUtils.CustomStringReplace(FKey, '&#61;', '=');
74 end;
75 //! FKey???l?????????辿
76 procedure TResistWord.SetKey(Value: String);
77 begin
78 //=???徹???????g?造???長?G?X?P?[?v???辿
79 FKey := MojuUtils.CustomStringReplace(Value, '=', '&#61;');
80 end;
81 //! FCategory???????????????辿?l?????転???辿
82 function TResistWord.GetCategory: String;
83 begin
84 //?G?X?P?[?v?直?????辿=?????????辿
85 Result := MojuUtils.CustomStringReplace(FCategory, '&#61;', '=');
86 end;
87 //! FCategory???l?????????辿
88 procedure TResistWord.SetCategory(Value: String);
89 begin
90 //=???徹???????g?造???長?G?X?P?[?v???辿
91 FCategory := MojuUtils.CustomStringReplace(Value, '=', '&#61;');
92 end;
93 //! FText???????????????辿?l?????転???辿
94 function TResistWord.GetText: String;
95 begin
96 //?G?X?P?[?v?直?????辿=?????????辿
97 Result := MojuUtils.CustomStringReplace(FText, '&#61;', '=');
98 // #1???直???端?s?R?[?h??#13#10?????????辿
99 Result := MojuUtils.CustomStringReplace(Result, #1, #13#10);
100 end;
101 procedure TResistWord.SetText(Value: String);
102 begin
103 //=???徹???????g?造???長?G?X?P?[?v???辿
104 FText := MojuUtils.CustomStringReplace(Value, '=', '&#61;');
105 //?端?s?R?[?h??#1?????辿?i1?s?????辿????)
106 FText := MojuUtils.CustomStringReplace(FText, #13#10, #1);
107 end;
108 //! ?t?@?C?????????????長???炭?泥???辿
109 procedure TInputAssistDM.Init(FilePath: String);
110 var
111 ini : TMemIniFile;
112 sections: TStringList;
113 keys: TStringList;
114 i, j : Integer;
115 resWord : TResistWord;
116 begin
117 FInit := True;
118 try
119 // ini?t?@?C???????纏?????A?f?t?H???g?????l?[?????辿
120 if not FileExists(FilePath) then begin
121 CopyFile(
122 PChar(ChangeFileExt(FilePath, '.default')),
123 PChar(FilePath), True);
124 end;
125
126 // ?t?@?C???????????m?F
127 if FileExists(FilePath) then begin
128 ini := TMemIniFile.Create(FilePath);
129 sections := TStringList.Create;
130 keys := TStringList.Create;
131 try
132 ini.ReadSections(sections);
133
134 for i :=0 to sections.Count - 1 do begin
135 keys.Clear;
136 ini.ReadSection(sections[i], keys);
137 for j := 0 to keys.Count - 1 do begin
138 resWord := TResistWord.Create;
139 resWord.SetCategory(sections[i]);
140 resWord.SetKey(keys[j]);
141 resWord.SetText(ini.ReadString(sections[i], keys[j], ''));
142 FDictionary.AddObject(resWord.GetKey, resWord);
143 end;
144 end;
145 finally
146 keys.Free;
147 sections.Free;
148 ini.Free;
149 end;
150 end;
151
152 except
153 FInit := False;
154 end;
155 end;
156 //! ?w?????????p?X???t?@?C?????徹?????辿
157 procedure TInputAssistDM.SaveToFile(FilePath: String);
158 var
159 ini : TMemIniFile;
160 i : Integer;
161 resWord : TResistWord;
162 begin
163 if FileExists(FilePath) then begin
164 try
165 SysUtils.DeleteFile(FilePath);
166 except
167 end;
168 end;
169 ini := TMemIniFile.Create(FilePath);
170 try
171 for i :=0 to FDictionary.Count - 1 do begin
172 resWord := TResistWord(FDictionary.Objects[i]);
173 ini.WriteString(resWord.FCategory, resWord.FKey, resWord.FText);
174 end;
175 ini.UpdateFile;
176 finally
177 ini.Free;
178 end;
179 end;
180 //! ?f?X?g???N?^
181 procedure TInputAssistDM.DataModuleDestroy(Sender: TObject);
182 var
183 i : Integer;
184 begin
185 if (FDictionary <> nil) then begin
186 for i := FDictionary.Count - 1 downto 0 do begin
187 TResistWord(FDictionary.Objects[i]).Free;
188 end;
189 FDictionary.Clear;
190 FDictionary.Capacity := 0;
191 FDictionary.Free;
192 end;
193 end;
194 //! ?R???X?g???N?^
195 procedure TInputAssistDM.DataModuleCreate(Sender: TObject);
196 begin
197 FDictionary := TStringList.Create;
198 FDictionary.Duplicates := dupAccept;
199 FDictionary.Sorted := True;
200 end;
201 //! ?o?^?P???????転
202 function TInputAssistDM.ResistWordCount : Integer;
203 begin
204 Result := 0;
205 if (FDictionary <> nil) then begin
206 Result := FDictionary.Count;
207 end;
208 end;
209 //! ?o?^?P?????転
210 function TInputAssistDM.GetResistWord(Index: Integer): TResistWord;
211 begin
212 Result := nil;
213 if (FDictionary <> nil) then begin
214 if (Index >= 0) and (Index < FDictionary.Count) then begin
215 Result := TResistWord(FDictionary.Objects[index]);
216 end;
217 end;
218 end;
219 //! ?o?^?P?????鱈??
220 procedure TInputAssistDM.DeleteResistWord(ResistWord: TResistWord);
221 var
222 i : Integer;
223 begin
224 if (FDictionary <> nil) then begin
225 for i := 0 to FDictionary.Count - 1 do begin
226 if (ResistWord = FDictionary.Objects[i]) then begin
227 TResistWord(FDictionary.Objects[i]).Free;
228 FDictionary.Delete(i);
229 break;
230 end;
231 end;
232 end;
233 end;
234 //! ?o?^?P??????
235 function TInputAssistDM.Add(Key: String): TResistWord;
236 var
237 resWord : TResistWord;
238 begin
239 Result := nil;
240 if (FDictionary <> nil) then begin
241 resWord := TResistWord.Create;
242 resWord.SetKey(Key);
243 resWord.SetCategory('?J?e?S??');
244 resWord.SetText('???^??');
245 FDictionary.AddObject(Key, resWord);
246 Result := resWord;
247 end;
248 end;
249 //! ?o?^?P?????L?[???X
250 procedure TInputAssistDM.ChangeKey(ResistWord: TResistWord);
251 var
252 i : Integer;
253 begin
254 if (FDictionary <> nil) then begin
255 for i := 0 to FDictionary.Count - 1 do begin
256 if (ResistWord = FDictionary.Objects[i]) then begin
257 FDictionary.Strings[i] := ResistWord.GetKey;
258 break;
259 end;
260 end;
261 end;
262 end;
263 //! Key???????o?^?????????辿?P???????転
264 function TInputAssistDM.GetStartWithKeyResistWords(Key: String; var list: TStringList): Integer;
265 var
266 i : Integer;
267 resWord : TResistWord;
268
269 begin
270 Result := 0;
271 if (FDictionary <> nil) and (list <> nil) then begin
272 Key := ZenToHan(Key);
273 for i := 0 to FDictionary.Count - 1 do begin
274 if (AnsiPos(Key, ZenToHan(FDictionary.Strings[i])) = 1) then begin
275 Inc(Result);
276 resWord := TResistWord(FDictionary.Objects[i]);
277 list.AddObject(resWord.GetKey + '(' +
278 resWord.GetCategory + ')', resWord);
279 end else if (Result > 0) then begin
280 //?\?[?g?????????辿???巽?A?q?b?g???????A?????辿???存
281 break;
282 end;
283 end;
284 end;
285 end;
286 //! Key???J?e?S?????????o?^?????????辿?P???????転
287 function TInputAssistDM.GetStartWithCategoryResistWords(Key: String; var list: TStringList): Integer;
288 var
289 i : Integer;
290 resWord : TResistWord;
291 begin
292 Result := 0;
293 if (FDictionary <> nil) and (list <> nil) then begin
294 Key := ZenToHan(Key);
295 for i := 0 to FDictionary.Count - 1 do begin
296 resWord := TResistWord(FDictionary.Objects[i]);
297 if (AnsiPos(Key, ZenToHan(resWord.GetCategory)) = 1) then begin
298 Inc(Result);
299 list.AddObject(resWord.GetKey + '(' +
300 resWord.GetCategory + ')', resWord);
301 end;
302 end;
303 list.CustomSort(CategorySort);
304 end;
305 end;
306
307 //! ?\?[?g???坦???????転
308 function TInputAssistDM.GetSorted: Boolean;
309 begin
310 Result := False;
311 if (FDictionary <> nil) then begin
312 Result := FDictionary.Sorted;
313 end;
314 end;
315 //! ?\?[?g?坦????????
316 procedure TInputAssistDM.SetSorted(Value: Boolean);
317 begin
318 if (FDictionary <> nil) then begin
319 FDictionary.Sorted := Value;
320 end;
321 end;
322 //! Key???J?e?S?????o?^?????????辿?P???????転
323 function TInputAssistDM.GetCategoryResistWords(Key: String; var list: TStringList): Integer;
324 var
325 i : Integer;
326 resWord : TResistWord;
327 begin
328 Result := 0;
329 if (FDictionary <> nil) and (list <> nil) then begin
330 for i := 0 to FDictionary.Count - 1 do begin
331 resWord := TResistWord(FDictionary.Objects[i]);
332 if (Key = resWord.GetCategory) then begin
333 Inc(Result);
334 list.AddObject(resWord.GetKey + '(' +
335 resWord.GetCategory + ')', resWord);
336 end;
337 end;
338 list.CustomSort(CategorySort);
339 end;
340 end;
341
342 //! ?o?^?????L?[???S?????J?e?S?????X?g???転
343 procedure TInputAssistDM.GetCategoryList(var list: TStringList);
344 var
345 i : Integer;
346 begin
347 if (FDictionary <> nil) and (list <> nil) then begin
348 // ?d???`?F?b?N??TStringList???@?\?長?s?造
349 list.Clear;
350 list.Duplicates := dupIgnore;
351 list.Sorted := true;
352 list.BeginUpdate;
353 for i := 0 to FDictionary.Count - 1 do begin
354 list.Add(TResistWord(FDictionary.Objects[i]).GetCategory);
355 end;
356 list.EndUpdate;
357 end;
358 end;
359
360 //! Key???J?e?S?????????o?^?P?????????????\?[?g?p?辰?r???\?b?h
361 function CategorySort(List: TStringList; Index1, Index2: Integer): Integer;
362 var
363 resWord1 : TResistWord;
364 resWord2 : TResistWord;
365 begin
366 Result := 0;
367 try
368 resWord1 := TResistWord(List.Objects[Index1]);
369 resWord2 := TResistWord(List.Objects[Index2]);
370 Result := AnsiCompareStr(resWord1.GetCategory, resWord2.GetCategory);
371 if (Result = 0) then begin
372 Result := AnsiCompareStr(resWord1.GetKey, resWord2.GetKey);
373 end;
374 except
375 end;
376 end;
377
378 end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26