Develop and Download Open Source Software

Browse Subversion Repository

Annotation of /trunk/Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (hide annotations) (download) (as text)
Mon Feb 23 09:43:21 2015 UTC (9 years, 1 month ago) by yamat0jp
File MIME type: text/x-pascal
File size: 9433 byte(s)


1 yamat0jp 2 unit Unit1;
2    
3     interface
4    
5     uses
6     Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7     Dialogs, StdCtrls, ExtCtrls, ComCtrls, StrUtils, ImgList, Buttons, Grids;
8    
9    
10     type
11     TStartCount = record
12     Start: integer;
13     Count: integer;
14     end;
15    
16     TForm1 = class(TForm)
17     TreeView1: TTreeView;
18     OpenDialog1: TOpenDialog;
19     Panel2: TPanel;
20     Memo1: TMemo;
21     Edit1: TEdit;
22     Button1: TButton;
23     Button2: TButton;
24     Button3: TButton;
25     Memo2: TMemo;
26     ImageList1: TImageList;
27     Button4: TButton;
28     SpeedButton1: TSpeedButton;
29     Button5: TButton;
30     Label1: TLabel;
31     Panel1: TPanel;
32     procedure Button3Click(Sender: TObject);
33     procedure Button1Click(Sender: TObject);
34     procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
35     procedure Button2Click(Sender: TObject);
36     procedure Button4Click(Sender: TObject);
37     procedure TreeView1Changing(Sender: TObject; Node: TTreeNode;
38     var AllowChange: Boolean);
39     procedure Button5Click(Sender: TObject);
40     procedure FormDestroy(Sender: TObject);
41     procedure SpeedButton1Click(Sender: TObject);
42     procedure FormCreate(Sender: TObject);
43     private
44     { Private ���� }
45     MemoIndex: integer;
46     TempList: TList;
47     procedure ListClear;
48     procedure SearchImplementation;
49     procedure SearchPrFn;
50     function SearchEnd: Boolean;
51     procedure SearchComment;
52     procedure RemendStart(Node: TTreeNode; Count: integer);
53     procedure ClearTreeViewData;
54     procedure Execute;
55     public
56     { Public ���� }
57     end;
58    
59     var
60     Form1: TForm1;
61    
62     implementation
63    
64     {$R *.dfm}
65    
66     procedure TForm1.Button3Click(Sender: TObject);
67     begin
68     Close;
69     end;
70    
71     procedure TForm1.Button1Click(Sender: TObject);
72     begin
73     if OpenDialog1.Execute then
74     begin
75     ClearTreeViewData;
76     ListClear;
77     Memo2.Lines.LoadFromFile(OpenDialog1.FileName);
78     MemoIndex:=0;
79     SearchImplementation;
80     while MemoIndex < Memo2.Lines.Count do
81     begin
82     Execute;
83     end;
84     if TempList.Count > 0 then
85     begin
86     ListClear;
87     end;
88     end;
89     end;
90    
91     procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
92     var
93     i: integer;
94     s: ^TStartCount;
95     begin
96     s:=Node.Data;
97     if Node.Level = 1 then
98     begin
99     Memo1.Clear;
100     for i:=s^.Start to s^.Start+s^.Count-1 do
101     begin
102     Memo1.Lines.Add(Memo2.Lines[i]);
103     end;
104     Memo1.Modified:=false;
105     end;
106     i:=SendMessage(Memo2.Handle,EM_GETFIRSTVISIBLELINE,0,0);
107     SendMessage(Memo2.Handle,EM_LINESCROLL,0,s^.Start-i);
108     end;
109    
110     procedure TForm1.Button2Click(Sender: TObject);
111     var
112     i: integer;
113     s: ^TStartCount;
114     t: string;
115     begin
116     if (TreeView1.SelectionCount > 0)and(TreeView1.Selected.Level = 1)and
117     (Memo1.Modified = true) then
118     begin
119     s:=TreeView1.Selected.Data;
120     for i:=1 to s^.Count do
121     begin
122     Memo2.Lines.Delete(s^.Start);
123     end;
124     for i:=Memo1.Lines.Count-1 downto 0 do
125     begin
126     if Copy(TrimLeft(Memo1.Lines[i]),1,2) = '//' then
127     begin
128     Memo2.Lines.Insert(s^.Start,Memo1.Lines[i]);
129     end else
130     begin
131     t:=Memo1.Lines[i];
132     if Copy(t,1,2) = ' ' then
133     begin
134     Delete(t,1,2);
135     end;
136     Memo2.Lines.Insert(s^.Start,'//'+t);
137     end;
138     end;
139     if Memo1.Lines.Count-s^.Count <> 0 then
140     begin
141     RemendStart(TreeView1.Selected,Memo1.Lines.Count-s^.Count);
142     end;
143     Memo1.Modified:=false;
144     s^.Count:=Memo1.Lines.Count;
145     TreeView1.Selected.StateIndex:=4;
146     TreeView1Change(Sender,TreeView1.Selected);
147     end;
148     end;
149    
150     procedure TForm1.Button4Click(Sender: TObject);
151     var
152     s: TTreeNode;
153     p: ^TStartCount;
154     begin
155     if (TreeView1.SelectionCount > 0)and(TreeView1.Selected.Level = 0) then
156     begin
157     s:=TreeView1.Selected;
158     New(p);
159     p^.Start:=TStartCount(s.Data^).Start;
160     p^.Count:=0;
161     TreeView1.Items.AddChildObject(s,IntToStr(s.Count+1),p).StateIndex:=1;
162     s.Expanded:=true;
163     end;
164     end;
165    
166     procedure TForm1.TreeView1Changing(Sender: TObject; Node: TTreeNode;
167     var AllowChange: Boolean);
168     begin
169     if Memo1.Modified = true then
170     begin
171     case MessageDlg('���X��������������',mtConfirmation,[mbYes,mbNo,mbCancel],0) of
172     mrYes:
173     Button2Click(Sender);
174     mrCancel:
175     AllowChange:=false;
176     end;
177     end;
178     Memo1.Clear;
179     end;
180    
181     procedure TForm1.Button5Click(Sender: TObject);
182     var
183     i, j: integer;
184     begin
185     if FileExists(OpenDialog1.FileName) = true then
186     begin
187     Memo2.Lines.SaveToFile(OpenDialog1.FileName);
188     for i:=0 to TreeView1.Items.Count-1 do
189     begin
190     for j:=0 to TreeView1.Items[i].Count-1 do
191     begin
192     TreeView1.Items[i].Item[j].StateIndex:=1;
193     end;
194     end;
195     end else
196     begin
197     Showmessage('�t�@�C������������������');
198     end;
199     end;
200    
201     procedure TForm1.FormDestroy(Sender: TObject);
202     begin
203     ClearTreeViewData;
204     TempList.Clear;
205     TempList.Free;
206     end;
207    
208     procedure TForm1.ClearTreeViewData;
209     var
210     i, j: integer;
211     s: TTreeNode;
212     t: ^TStartCount;
213     begin
214     for i:=0 to TreeView1.Items.Count-1 do
215     begin
216     s:=TreeView1.Items[i];
217     t:=s.Data;
218     Dispose(t);
219     end;
220     TreeView1.Items.Clear;
221     end;
222    
223     procedure TForm1.SpeedButton1Click(Sender: TObject);
224     var
225     i: integer;
226     p: ^TStartCount;
227     begin
228     if (Edit1.Text <> '')and(TreeView1.Selected.Level = 1) then
229     begin
230     p:=TreeView1.Selected.Data;
231     for i:=1 to p^.Count do
232     begin
233     Memo2.Lines.Delete(p^.Start);
234     end;
235     Memo2.Lines.Insert(p^.Start,'//~~~~~~~~~~~~~~~~~~~~~~~~~~//');
236     Memo2.Lines.Insert(p^.Start,'//////////////////////////////');
237     Memo2.Lines.Insert(p^.Start,'//');
238     Memo2.Lines.Insert(p^.Start,'// '+Edit1.Text);
239     Memo2.Lines.Insert(p^.Start,'//');
240     Memo2.Lines.Insert(p^.Start,'//////////////////////////////');
241     if 6-p^.Count <> 0 then
242     begin
243     RemendStart(TreeView1.Selected,6-p^.Count);
244     end;
245     p^.Count:=6;
246     TreeView1.Selected.StateIndex:=4;
247     TreeView1Change(Sender,TreeView1.Selected);
248     end;
249     end;
250    
251     procedure TForm1.RemendStart(Node: TTreeNode; Count: integer);
252     var
253     i: integer;
254     x: Boolean;
255     s: ^TStartCount;
256     begin
257     x:=false;
258     for i:=0 to TreeView1.Items.Count-1 do
259     begin
260     if x = true then
261     begin
262     s:=TreeView1.Items[i].Data;
263     s^.Start:=s^.Start+Count;
264     end else
265     if TreeView1.Items[i] = Node then
266     begin
267     x:=true;
268     end;
269     end;
270     end;
271    
272     function TForm1.SearchEnd: Boolean;
273     var
274     i: integer;
275     s: string;
276     begin
277     result:=false;
278     s:=Memo2.Lines[MemoIndex];
279     for i:=1 to Length(s)-2 do
280     begin
281     case s[i] of
282     'e','E':
283     if CompareText(Copy(s,i,3),'end') = 0 then
284     begin
285     result:=true;
286     break;
287     end;
288     end;
289     end;
290     end;
291    
292     procedure TForm1.SearchImplementation;
293     var
294     i: integer;
295     begin
296     for i:=0 to Memo2.Lines.Count-1 do
297     begin
298     if AnsiStartsText('implementation',TrimLeft(Memo2.Lines[i])) = true then
299     begin
300     MemoIndex:=i+1;
301     break;
302     end;
303     end;
304     end;
305    
306     procedure TForm1.SearchPrFn;
307     var
308     s: string;
309     n: TTreeNode;
310     procedure Main;
311     var
312     i, j: integer;
313     p: ^TStartCount;
314     begin
315     New(p);
316     p^.Start:=MemoIndex;
317     p^.Count:=0;
318     j:=0;
319     s:='';
320     while MemoIndex < Memo2.Lines.Count do
321     begin
322     s:=s+TrimLeft(Memo2.Lines[MemoIndex]);
323     for i:=j to Length(s)-1 do
324     begin
325     if IsDelimiter('(;',s,i) = true then
326     begin
327     n:=TreeView1.Items.AddObject(nil,TrimLeft(Copy(s,10,i-10)),p);
328     for j:=0 to TempList.Count-1 do
329     begin
330     TreeView1.Items.AddChildObject(n,IntToStr(j+1),TempList[j]);
331     end;
332     TempList.Clear;
333     inc(MemoIndex);
334     Exit;
335     end;
336     end;
337     j:=Length(s);
338     inc(MemoIndex);
339     end;
340     end;
341     begin
342     s:=TrimLeft(Memo2.Lines[MemoIndex]);
343     if AnsiStartsText('procedure ',s) = true then
344     begin
345     Main;
346     n.StateIndex:=2;
347     end else
348     if ANsiStartsText('function ',s) = true then
349     begin
350     Main;
351     n.StateIndex:=3;
352     end;
353     end;
354    
355     procedure TForm1.Execute;
356     begin
357     SearchPrFn;
358     SearchComment;
359     if (TempList.Count > 0)and(SearchEnd = true) then
360     begin
361     ListClear;
362     end;
363     end;
364    
365     procedure TForm1.SearchComment;
366     var
367     s: ^TStartCount;
368     begin
369     if Copy(TrimLeft(Memo2.Lines[MemoIndex]),1,2) = '//' then
370     begin
371     New(s);
372     s^.Start:=MemoIndex;
373     repeat
374     inc(MemoIndex);
375     until Copy(TrimLeft(Memo2.Lines[MemoIndex]),1,2) <> '//';
376     TempList.Add(s);
377     s^.Count:=MemoIndex-s^.Start;
378     end else
379     begin
380     inc(MemoIndex);
381     end;
382     end;
383    
384     procedure TForm1.FormCreate(Sender: TObject);
385     begin
386     TempList:=TList.Create;
387     end;
388    
389     procedure TForm1.ListClear;
390     var
391     i: integer;
392     begin
393     for i:=0 to TempList.Count-1 do
394     begin
395     Dispose(TempList[i]);//Memory Block : TStartCount = record
396     end;
397     TempList.Clear;
398     end;
399    
400     end.

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