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

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