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.3 - (hide annotations) (download) (as text)
Sat Feb 18 18:09:47 2006 UTC (18 years, 2 months ago) by h677
Branch: MAIN
CVS Tags: v1_52_0_646, v1_52_0_647, v1_52_0_648, v1_52_0_645, v1_52_0_651, v1_52_0_650, v1_52_0_649
Changes since 1.2: +42 -0 lines
File MIME type: text/x-pascal
レスエディタから入力アシストフォーム経由で入力できるように修正

1 h677 1.1 unit InputAssistDataModule;
2    
3     interface
4    
5     uses
6     SysUtils, Classes;
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 h677 1.2
21 h677 1.1 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 h677 1.3 //! 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 h677 1.1 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 h677 1.2
59     function CategorySort(List: TStringList; Index1, Index2: Integer): Integer;
60 h677 1.1 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     // ?t?@?C???????????m?F
120     if FileExists(FilePath) then begin
121     ini := TMemIniFile.Create(FilePath);
122     sections := TStringList.Create;
123     keys := TStringList.Create;
124     try
125     ini.ReadSections(sections);
126    
127     for i :=0 to sections.Count - 1 do begin
128     keys.Clear;
129     ini.ReadSection(sections[i], keys);
130     for j := 0 to keys.Count - 1 do begin
131     resWord := TResistWord.Create;
132     resWord.SetCategory(sections[i]);
133     resWord.SetKey(keys[j]);
134     resWord.SetText(ini.ReadString(sections[i], keys[j], ''));
135     FDictionary.AddObject(resWord.GetKey, resWord);
136     end;
137     end;
138     finally
139     keys.Free;
140     sections.Free;
141     ini.Free;
142     end;
143     end;
144    
145     except
146     FInit := False;
147     end;
148     end;
149     //! ?w?????????p?X???t?@?C?????徹?????辿
150     procedure TInputAssistDM.SaveToFile(FilePath: String);
151     var
152     ini : TMemIniFile;
153     i : Integer;
154     resWord : TResistWord;
155     begin
156     if FileExists(FilePath) then begin
157     try
158     DeleteFile(FilePath);
159     except
160     end;
161     end;
162     ini := TMemIniFile.Create(FilePath);
163     try
164     for i :=0 to FDictionary.Count - 1 do begin
165     resWord := TResistWord(FDictionary.Objects[i]);
166     ini.WriteString(resWord.FCategory, resWord.FKey, resWord.FText);
167     end;
168     ini.UpdateFile;
169     finally
170     ini.Free;
171     end;
172     end;
173     //! ?f?X?g???N?^
174     procedure TInputAssistDM.DataModuleDestroy(Sender: TObject);
175     var
176     i : Integer;
177     begin
178     if (FDictionary <> nil) then begin
179     for i := FDictionary.Count - 1 downto 0 do begin
180     TResistWord(FDictionary.Objects[i]).Free;
181     end;
182     FDictionary.Clear;
183     FDictionary.Capacity := 0;
184     FDictionary.Free;
185     end;
186     end;
187     //! ?R???X?g???N?^
188     procedure TInputAssistDM.DataModuleCreate(Sender: TObject);
189     begin
190     FDictionary := TStringList.Create;
191     FDictionary.Duplicates := dupAccept;
192     FDictionary.Sorted := True;
193     end;
194     //! ?o?^?P???????転
195     function TInputAssistDM.ResistWordCount : Integer;
196     begin
197     Result := 0;
198     if (FDictionary <> nil) then begin
199     Result := FDictionary.Count;
200     end;
201     end;
202     //! ?o?^?P?????転
203     function TInputAssistDM.GetResistWord(Index: Integer): TResistWord;
204     begin
205     Result := nil;
206     if (FDictionary <> nil) then begin
207     if (Index >= 0) and (Index < FDictionary.Count) then begin
208     Result := TResistWord(FDictionary.Objects[index]);
209     end;
210     end;
211     end;
212     //! ?o?^?P?????鱈??
213     procedure TInputAssistDM.DeleteResistWord(ResistWord: TResistWord);
214     var
215     i : Integer;
216     begin
217     if (FDictionary <> nil) then begin
218     for i := 0 to FDictionary.Count - 1 do begin
219     if (ResistWord = FDictionary.Objects[i]) then begin
220     TResistWord(FDictionary.Objects[i]).Free;
221     FDictionary.Delete(i);
222     break;
223     end;
224     end;
225     end;
226     end;
227     //! ?o?^?P??????
228     function TInputAssistDM.Add(Key: String): TResistWord;
229     var
230     resWord : TResistWord;
231     begin
232     Result := nil;
233     if (FDictionary <> nil) then begin
234     resWord := TResistWord.Create;
235     resWord.SetKey(Key);
236     resWord.SetCategory('?J?e?S??');
237     resWord.SetText('???^??');
238     FDictionary.AddObject(Key, resWord);
239     Result := resWord;
240     end;
241     end;
242     //! ?o?^?P?????L?[???X
243     procedure TInputAssistDM.ChangeKey(ResistWord: TResistWord);
244     var
245     i : Integer;
246     begin
247     if (FDictionary <> nil) then begin
248     for i := 0 to FDictionary.Count - 1 do begin
249     if (ResistWord = FDictionary.Objects[i]) then begin
250     FDictionary.Strings[i] := ResistWord.GetKey;
251     break;
252     end;
253     end;
254     end;
255     end;
256     //! Key???????o?^?????????辿?P???????転
257     function TInputAssistDM.GetStartWithKeyResistWords(Key: String; var list: TStringList): Integer;
258     var
259     i : Integer;
260     resWord : TResistWord;
261    
262     begin
263     Result := 0;
264     if (FDictionary <> nil) and (list <> nil) then begin
265     Key := ZenToHan(Key);
266     for i := 0 to FDictionary.Count - 1 do begin
267     if (AnsiPos(Key, ZenToHan(FDictionary.Strings[i])) = 1) then begin
268     Inc(Result);
269     resWord := TResistWord(FDictionary.Objects[i]);
270     list.AddObject(resWord.GetKey + '(' +
271     resWord.GetCategory + ')', resWord);
272     end else if (Result > 0) then begin
273     //?\?[?g?????????辿???巽?A?q?b?g???????A?????辿???存
274     break;
275     end;
276     end;
277     end;
278     end;
279     //! Key???J?e?S?????????o?^?????????辿?P???????転
280     function TInputAssistDM.GetStartWithCategoryResistWords(Key: String; var list: TStringList): Integer;
281     var
282     i : Integer;
283     resWord : TResistWord;
284     begin
285     Result := 0;
286     if (FDictionary <> nil) and (list <> nil) then begin
287     Key := ZenToHan(Key);
288     for i := 0 to FDictionary.Count - 1 do begin
289     resWord := TResistWord(FDictionary.Objects[i]);
290     if (AnsiPos(Key, ZenToHan(resWord.GetCategory)) = 1) then begin
291     Inc(Result);
292     list.AddObject(resWord.GetKey + '(' +
293     resWord.GetCategory + ')', resWord);
294     end;
295     end;
296 h677 1.2 list.CustomSort(CategorySort);
297 h677 1.1 end;
298     end;
299 h677 1.2
300 h677 1.1 //! ?\?[?g???坦???????転
301     function TInputAssistDM.GetSorted: Boolean;
302     begin
303     Result := False;
304     if (FDictionary <> nil) then begin
305     Result := FDictionary.Sorted;
306     end;
307     end;
308     //! ?\?[?g?坦????????
309     procedure TInputAssistDM.SetSorted(Value: Boolean);
310     begin
311     if (FDictionary <> nil) then begin
312     FDictionary.Sorted := Value;
313     end;
314     end;
315 h677 1.3 //! Key???J?e?S?????o?^?????????辿?P???????転
316     function TInputAssistDM.GetCategoryResistWords(Key: String; var list: TStringList): Integer;
317     var
318     i : Integer;
319     resWord : TResistWord;
320     begin
321     Result := 0;
322     if (FDictionary <> nil) and (list <> nil) then begin
323     for i := 0 to FDictionary.Count - 1 do begin
324     resWord := TResistWord(FDictionary.Objects[i]);
325     if (Key = resWord.GetCategory) then begin
326     Inc(Result);
327     list.AddObject(resWord.GetKey + '(' +
328     resWord.GetCategory + ')', resWord);
329     end;
330     end;
331     list.CustomSort(CategorySort);
332     end;
333     end;
334    
335     //! ?o?^?????L?[???S?????J?e?S?????X?g???転
336     procedure TInputAssistDM.GetCategoryList(var list: TStringList);
337     var
338     i : Integer;
339     begin
340     if (FDictionary <> nil) and (list <> nil) then begin
341     // ?d???`?F?b?N??TStringList???@?\?長?s?造
342     list.Clear;
343     list.Duplicates := dupIgnore;
344     list.Sorted := true;
345     list.BeginUpdate;
346     for i := 0 to FDictionary.Count - 1 do begin
347     list.Add(TResistWord(FDictionary.Objects[i]).GetCategory);
348     end;
349     list.EndUpdate;
350     end;
351     end;
352 h677 1.1
353 h677 1.2 //! Key???J?e?S?????????o?^?P?????????????\?[?g?p?辰?r???\?b?h
354     function CategorySort(List: TStringList; Index1, Index2: Integer): Integer;
355     var
356     resWord1 : TResistWord;
357     resWord2 : TResistWord;
358     begin
359     Result := 0;
360     try
361     resWord1 := TResistWord(List.Objects[Index1]);
362     resWord2 := TResistWord(List.Objects[Index2]);
363     Result := AnsiCompareStr(resWord1.GetCategory, resWord2.GetCategory);
364     if (Result = 0) then begin
365     Result := AnsiCompareStr(resWord1.GetKey, resWord2.GetKey);
366     end;
367     except
368     end;
369     end;
370    
371 h677 1.1 end.

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