Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/Sort.pas

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


Revision 1.4 - (show annotations) (download) (as text)
Fri Dec 19 12:33:06 2003 UTC (20 years, 4 months ago) by h677
Branch: MAIN
Changes since 1.3: +2 -2 lines
File MIME type: text/x-pascal
取得時刻で正しくソートしない不具合を修正

1 unit Sort;
2
3 interface
4 uses
5 Windows, Messages, SysUtils, Classes, Controls, Forms,
6 BoardGroup,DateUtils;
7
8 function CategorySortProc(Item1, Item2: Pointer): integer;
9 function BoardSortProc(Item1, Item2: Pointer): integer;
10 function ThreadItemSortProc(Item1, Item2: Pointer): integer;
11 function CompareBool(Item1, Item2: Boolean): integer;
12 function CompareInt(Item1, Item2: Integer): Integer;
13 function CompareDate(Item1, Item2: TDateTime): Integer;
14
15 var
16 SortOrder: Boolean;
17 SortIndex: Integer;
18 SortNoFlag: Boolean;
19
20 implementation
21
22 function CategorySortProc(Item1, Item2: Pointer): integer;
23 var
24 CategoryItem1: TCategory;
25 CategoryItem2: TCategory;
26 begin
27 CategoryItem1 := TCategory(Item1);
28 CategoryItem2 := TCategory(Item2);
29
30 if SortNoFlag then
31 Result := CompareInt(CategoryItem1.No, CategoryItem2.No)
32 else
33 Result := AnsiCompareText(CategoryItem1.Title, CategoryItem2.Title);
34
35 if not SortOrder then
36 Result := Result * -1;
37 end;
38
39 function BoardSortProc(Item1, Item2: Pointer): integer;
40 var
41 BoardItem1: TBoard;
42 BoardItem2: TBoard;
43 begin
44 BoardItem1 := TBoard(Item1);
45 BoardItem2 := TBoard(Item2);
46 if SortIndex = 0 then
47 if SortNoFlag then
48 Result := CompareInt(BoardItem1.No, BoardItem2.No)
49 else
50 Result := AnsiCompareText(BoardItem1.Title, BoardItem2.Title)
51 else if SortIndex = 1 then
52 Result := CompareInt(BoardItem1.Count, BoardItem2.Count)
53 else
54 Result := CompareDate(BoardItem1.RoundDate, BoardItem2.RoundDate);
55
56 if not SortOrder then
57 Result := Result * -1;
58 end;
59
60 function ThreadItemSortProc(Item1, Item2: Pointer): integer;
61 var
62 ThreadItem1: TThreadItem;
63 ThreadItem2: TThreadItem;
64 begin
65 ThreadItem1 := TThreadItem(Item1);
66 ThreadItem2 := TThreadItem(Item2);
67 case SortIndex of
68 0:
69 begin
70 if SortNoFlag then
71 Result := CompareInt(ThreadItem1.No, ThreadItem2.No)
72 else
73 Result := AnsiCompareText(ThreadItem1.Title, ThreadItem2.Title)
74 end;
75 1: Result := CompareInt(ThreadItem1.AllResCount, ThreadItem2.AllResCount);
76 2: Result := CompareInt(ThreadItem1.Count, ThreadItem2.Count);
77 3: Result := CompareInt(ThreadItem1.NewResCount, ThreadItem2.NewResCount);
78 4: Result := 0;
79 5: Result := AnsiCompareText(ThreadItem1.RoundName, ThreadItem2.RoundName);
80 6: Result := CompareDateTime(ThreadItem1.RoundDate, ThreadItem2.RoundDate);
81 else
82 Result := 0;
83 end;
84
85 { if SortIndex = 0 then
86 if SortNoFlag then
87 Result := CompareInt(ThreadItem1.No, ThreadItem2.No)
88 else
89 Result := CompareText(ThreadItem1.Title, ThreadItem2.Title)
90 else if SortIndex = 1 then
91 Result := CompareInt(ThreadItem1.Count, ThreadItem2.Count)
92 else if SortIndex = 2 then
93 // Result := CompareInt(ThreadItem1.RoundNo, ThreadItem2.RoundNo)
94 Result := CompareText(ThreadItem1.RoundName, ThreadItem2.RoundName)
95 else
96 Result := CompareDate(ThreadItem1.LastModified, ThreadItem2.LastModified);
97 }
98 if not SortOrder then
99 Result := Result * -1;
100 end;
101
102 function CompareBool(Item1, Item2: Boolean): Integer;
103 begin
104 if (Item1 = True) and (Item2 = False) then
105 Result := 1
106 else if (Item2 = False) and (Item2 = True) then
107 Result := -1
108 else
109 Result := 0;
110 end;
111
112 function CompareInt(Item1, Item2: Integer): Integer;
113 begin
114 if Item1 > Item2 then
115 Result := 1
116 else if Item1 < Item2 then
117 Result := -1
118 else
119 Result := 0;
120 end;
121
122 function CompareDate(Item1, Item2: TDateTime): Integer;
123 begin
124 if Item1 > Item2 then
125 Result := 1
126 else if Item1 < Item2 then
127 Result := -1
128 else
129 Result := 0;
130 end;
131
132 end.

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