Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/InputAssistDataModule.pas

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


Revision 1.7 - (hide 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 h677 1.1 unit InputAssistDataModule;
2    
3     interface
4    
5     uses
6 h677 1.6 SysUtils, Classes, Windows;
7 h677 1.1
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 h677 1.7 FSorted : Boolean;
19 h677 1.1 function GetSorted: Boolean; ///< ?\?[?g???坦???????転
20     procedure SetSorted(Value: Boolean); ///< ?\?[?g?坦????????
21 h677 1.2
22 h677 1.1 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 h677 1.3 //! 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 h677 1.1 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 h677 1.2
60     function CategorySort(List: TStringList; Index1, Index2: Integer): Integer;
61 h677 1.7 function KeySort(List: TStringList; Index1, Index2: Integer): Integer;
62 h677 1.1 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 h677 1.4 // ini?t?@?C???????纏?????A?f?t?H???g?????l?[?????辿
122     if not FileExists(FilePath) then begin
123 h677 1.6 CopyFile(
124     PChar(ChangeFileExt(FilePath, '.default')),
125     PChar(FilePath), True);
126 h677 1.4 end;
127    
128 h677 1.1 // ?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 h677 1.7 if FSorted Then begin
153     FDictionary.CustomSort(KeySort);
154     end;
155 h677 1.1 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 h677 1.6 SysUtils.DeleteFile(FilePath);
171 h677 1.1 except
172     end;
173     end;
174 h677 1.7
175 h677 1.1 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 h677 1.7 FDictionary.Sorted := False;
205     FSorted := True;
206 h677 1.1 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 h677 1.7 if FSorted Then begin
239     FDictionary.CustomSort(KeySort);
240     end;
241 h677 1.1 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 h677 1.7 if FSorted Then begin
257     FDictionary.CustomSort(KeySort);
258     end;
259 h677 1.1 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 h677 1.7 if FSorted Then begin
274     FDictionary.CustomSort(KeySort);
275     end;
276    
277 h677 1.1 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 h677 1.2 list.CustomSort(CategorySort);
320 h677 1.1 end;
321     end;
322 h677 1.2
323 h677 1.1 //! ?\?[?g???坦???????転
324     function TInputAssistDM.GetSorted: Boolean;
325     begin
326 h677 1.7 Result := FSorted;
327 h677 1.1 end;
328     //! ?\?[?g?坦????????
329     procedure TInputAssistDM.SetSorted(Value: Boolean);
330     begin
331 h677 1.7 if (not FSorted) and (Value) then begin
332     FDictionary.CustomSort(KeySort);
333 h677 1.1 end;
334 h677 1.7 FSorted := Value;
335 h677 1.1 end;
336 h677 1.3 //! 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 h677 1.1
374 h677 1.2 //! 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 h677 1.7 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 h677 1.2 if (Result = 0) then begin
406 h677 1.7 Result := CompareStr(ZenToHan(resWord1.GetCategory),
407     ZenToHan(resWord2.GetCategory));
408 h677 1.2 end;
409     except
410     end;
411     end;
412    
413 h677 1.1 end.

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