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.4 - (show annotations) (download) (as text)
Tue Apr 25 15:23:11 2006 UTC (17 years, 11 months ago) by h677
Branch: MAIN
Changes since 1.3: +6 -0 lines
File MIME type: text/x-pascal
インストール時の初期登録ファイルを.defaultにできるようにコードを追加

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

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