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.3 - (show 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 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
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 // ?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 list.CustomSort(CategorySort);
297 end;
298 end;
299
300 //! ?\?[?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 //! 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
353 //! 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 end.

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