Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/Sort.pas

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


Revision 1.17 - (hide annotations) (download) (as text)
Wed Feb 22 17:21:21 2006 UTC (18 years, 1 month ago) by h677
Branch: MAIN
CVS Tags: v1_59_0_771, v1_59_0_770, v1_59_0_773, v1_59_0_772, v1_59_0_775, v1_59_0_774, v1_59_0_777, v1_59_0_776, v1_56_0_715, v1_59_0_778, v1_63_1_819, v1_57_0_737, v1_62_0_812, v1_57_0_735, v1_57_0_734, v1_57_0_733, v1_57_0_732, v1_57_0_731, v1_57_0_730, v1_57_0_739, v1_57_0_738, v1_59_1_765, v1_53_0_671, v1_60_0_788, v1_60_0_789, v1_54_0_677, v1_54_0_676, v1_58_0_748, v1_58_0_745, v1_60_0_781, v1_60_0_782, v1_58_0_746, v1_60_0_784, v1_54_0_678, v1_60_0_786, v1_60_0_787, v1_56_0_707, v1_59_0_767, v1_56_0_705, v1_56_0_704, v1_56_0_703, v1_56_0_702, v1_56_0_701, v1_56_0_700, v1_59_1_778, v1_57_0_723, v1_52_1_658, v1_59_0_768, v1_59_0_769, v1_57_0_725, v1_57_0_726, v1_57_0_727, v1_57_0_720, v1_57_0_722, v1_57_1_744, v1_57_0_728, v1_57_0_729, v1_57_0_736, v1_58_0_752, v1_58_0_750, v1_58_0_751, v1_58_0_756, v1_58_0_757, v1_58_0_754, v1_58_0_755, v1_58_0_759, v1_57_0_719, v1_57_0_718, v1_56_0_716, v1_54_0_687, v1_56_0_710, v1_56_0_711, v1_56_1_717, v1_56_1_716, v1_54_0_688, v1_54_0_689, v1_54_0_684, v1_54_0_685, v1_53_0_664, v1_61_0_796, v1_61_0_797, v1_61_0_795, v1_52_0_647, v1_61_0_798, v1_61_0_799, v1_52_0_648, v1_53_0_661, v1_53_0_663, v1_53_0_662, v1_53_0_665, v1_53_0_667, v1_53_0_666, v1_53_0_669, v1_53_0_668, v1_55_0_692, v1_55_0_693, v1_55_0_696, v1_55_0_697, v1_55_0_694, v1_55_0_695, v1_52_0_651, v1_54_1_691, v1_52_0_650, v1_56_2_724, v1_56_2_722, v1_52_0_652, v1_55_1_697, v1_52_0_654, v1_56_0_714, v1_53_0_672, v1_53_0_670, v1_63_0_818, v1_63_0_817, v1_63_0_816, v1_63_0_815, v1_54_0_686, v1_54_0_680, v1_54_0_681, v1_62_0_805, v1_62_0_804, v1_62_0_807, v1_62_0_806, v1_56_0_712, v1_62_0_803, v1_62_0_802, v1_56_0_713, v1_62_0_809, v1_54_0_682, v1_56_0_721, v1_54_0_683, v1_60_0_780, v1_60_0_779, v1_62_0_810, v1_62_0_811, v1_58_0_747, v1_60_0_783, v1_54_0_679, v1_59_2_785, marged_bRESPOPUP, v1_54_0_675, v1_56_0_706, root-of-Bb53, v1_52_1_657, v1_54_0_674, v1_52_0_660, v1_60_1_793, v1_54_0_690, v1_58_0_763, v1_58_0_762, v1_58_0_761, v1_58_0_760, v1_62_1_813, v1_57_2_749, v1_57_0_742, v1_57_0_743, v1_57_0_740, v1_57_0_741, v1_52_0_655, v1_56_0_709, v1_57_0_744, v1_52_0_656, v1_56_0_708, v1_52_0_649, v1_61_0_800, v1_53_1_673, v1_56_0_699, v1_56_0_698, v1_60_0_793, v1_60_0_792, v1_60_0_791, v1_60_0_790, v1_60_2_794, v1_61_1_801, HEAD
Branch point for: Bb57, Bb56, Bb55, Bb53, Bb52, Bb62, Bb63, Bb60, Bb61, Bb59, Bb58, bRESPOPUP, bListSU, Bb54
Changes since 1.16: +61 -31 lines
File MIME type: text/x-pascal
dat落ちスレの区別を追加したので、スレッド一覧をそれで絞り込めるようにした

1 hi_ 1.1 unit Sort;
2    
3     interface
4     uses
5     Windows, Messages, SysUtils, Classes, Controls, Forms,
6 yoffy 1.9 BoardGroup,DateUtils,
7 h677 1.14 Setting, Math;
8 hi_ 1.1
9     function CategorySortProc(Item1, Item2: Pointer): integer;
10 yoffy 1.6 function BoardSortProc(List: TStringList; Item1, Item2: Integer): integer;
11     function ThreadItemSortProc(List: TStringList; Item1, Item2: Integer): integer;
12 hi_ 1.1 function CompareBool(Item1, Item2: Boolean): integer;
13     function CompareInt(Item1, Item2: Integer): Integer;
14     function CompareDate(Item1, Item2: TDateTime): Integer;
15 h677 1.15 procedure SetSortDate(Date: TDateTime);
16     function GetSortDate(): TDateTime;
17 h677 1.17 procedure SetSortOrder(Order: Boolean);
18     function GetSortOrder: Boolean;
19     procedure SetSortIndex(Index: Integer);
20     function GetSortIndex: Integer;
21     procedure SetSortNoFlag(Flag: Boolean);
22     function GetSortNoFlag: Boolean;
23 hi_ 1.1
24     implementation
25 h677 1.17
26 h677 1.15 var
27     FSortDate: TDateTime;
28 h677 1.17 FSortOrder: Boolean;
29     FSortIndex: Integer;
30     FSortNoFlag: Boolean;
31    
32     function CaclVigor(Thread: TThreadItem): Double;
33     var
34     span : Double;
35     begin
36     if (Thread.AgeSage <> gasArch) then begin
37     span := DaySpan(Sort.GetSortDate, Thread.CreateDate);
38     end else begin
39     span := DaySpan(Thread.LastModified, Thread.CreateDate);
40     end;
41     if (span > 0) then begin
42     Result := Thread.AllResCount / span;
43     end else begin
44     Result := 0;
45     end;
46     end;
47     procedure SetSortOrder(Order: Boolean);
48     begin
49     FSortOrder := Order;
50     end;
51     function GetSortOrder: Boolean;
52     begin
53     Result := FSortOrder;
54     end;
55     procedure SetSortIndex(Index: Integer);
56     begin
57     FSortIndex := Index;
58     end;
59     function GetSortIndex: Integer;
60     begin
61     Result := FSortIndex;
62     end;
63     procedure SetSortNoFlag(Flag: Boolean);
64     begin
65     FSortNoFlag := Flag;
66     end;
67     function GetSortNoFlag: Boolean;
68     begin
69     Result := FSortNoFlag;
70     end;
71 hi_ 1.1
72     function CategorySortProc(Item1, Item2: Pointer): integer;
73     var
74     CategoryItem1: TCategory;
75     CategoryItem2: TCategory;
76     begin
77     CategoryItem1 := TCategory(Item1);
78     CategoryItem2 := TCategory(Item2);
79    
80 h677 1.17 case TGikoBBSColumnID( FSortIndex ) of
81 yoffy 1.9 gbbscTitle:
82 h677 1.17 if FSortNoFlag then
83 yoffy 1.9 Result := CompareInt(CategoryItem1.No, CategoryItem2.No)
84     else
85     Result := AnsiCompareText(CategoryItem1.Title, CategoryItem2.Title);
86 yoffy 1.10 else
87     Result := CompareInt(CategoryItem1.No, CategoryItem2.No)
88 yoffy 1.9 end;
89 hi_ 1.1
90 h677 1.17 if not FSortOrder then
91 hi_ 1.1 Result := Result * -1;
92     end;
93    
94 yoffy 1.6 function BoardSortProc(List: TStringList; Item1, Item2: Integer): integer;
95 hi_ 1.1 var
96     BoardItem1: TBoard;
97     BoardItem2: TBoard;
98     begin
99 yoffy 1.6 BoardItem1 := TBoard(List.Objects[Item1]);
100     BoardItem2 := TBoard(List.Objects[Item2]);
101 h677 1.17 case TGikoCategoryColumnID( FSortIndex ) of
102 yoffy 1.9 gccTitle:
103 h677 1.17 if FSortNoFlag then
104 hi_ 1.1 Result := CompareInt(BoardItem1.No, BoardItem2.No)
105     else
106 yoffy 1.9 Result := AnsiCompareText(BoardItem1.Title, BoardItem2.Title);
107    
108     gccRoundName:
109     Result := CompareInt(BoardItem1.Count, BoardItem2.Count);
110    
111     gccLastModified:
112 hi_ 1.1 Result := CompareDate(BoardItem1.RoundDate, BoardItem2.RoundDate);
113 yoffy 1.10 else
114     Result := CompareInt(BoardItem1.No, BoardItem2.No)
115 yoffy 1.9 end;
116 hi_ 1.1
117 h677 1.17 if not FSortOrder then
118 hi_ 1.1 Result := Result * -1;
119     end;
120    
121 yoffy 1.6 function ThreadItemSortProc(List: TStringList; Item1, Item2: Integer): integer;
122 hi_ 1.1 var
123     ThreadItem1: TThreadItem;
124     ThreadItem2: TThreadItem;
125     begin
126 yoffy 1.6 ThreadItem1 := TThreadItem(List.Objects[ Item1 ]);
127     ThreadItem2 := TThreadItem(List.Objects[ Item2 ]);
128 h677 1.17 case TGikoBoardColumnID( FSortIndex ) of
129 yoffy 1.9 gbcTitle:
130 hi_ 1.1 begin
131 h677 1.17 if FSortNoFlag then
132 hi_ 1.1 Result := CompareInt(ThreadItem1.No, ThreadItem2.No)
133     else
134     Result := AnsiCompareText(ThreadItem1.Title, ThreadItem2.Title)
135     end;
136 yoffy 1.9
137     gbcAllCount: Result := CompareInt(ThreadItem1.AllResCount, ThreadItem2.AllResCount);
138     gbcLocalCount: Result := CompareInt(ThreadItem1.Count, ThreadItem2.Count);
139     gbcNonAcqCount:
140 q9_ 1.7 begin
141 yoffy 1.9 if ThreadItem1.IsLogFile and ThreadItem2.IsLogFile then
142     Result := CompareInt(ThreadItem1.AllResCount - ThreadItem1.Count, ThreadItem2.AllResCount - ThreadItem2.Count)
143     else if ThreadItem1.IsLogFile then
144     Result := 1
145     else if ThreadItem2.IsLogFile then
146     Result := -1
147 q9_ 1.7 else
148 yoffy 1.9 Result := 0;
149 q9_ 1.7 end;
150 yoffy 1.9
151     gbcNewCount: Result := CompareInt(ThreadItem1.NewResCount, ThreadItem2.NewResCount);
152     gbcUnReadCount: Result := 0;
153     gbcRoundName: Result := AnsiCompareText(ThreadItem1.RoundName, ThreadItem2.RoundName);
154 h677 1.11 gbcRoundDate: Result := CompareDateTime(ThreadItem1.RoundDate, ThreadItem2.RoundDate); {gbcLastModified:}
155 yoffy 1.9 gbcCreated: Result := CompareDateTime(ThreadItem1.CreateDate, ThreadItem2.CreateDate);
156 h677 1.12 gbcLastModified: Result := CompareDateTime(ThreadItem1.LastModified, ThreadItem2.LastModified); {gbcLastModified:}
157 h677 1.17 gbcVigor: Result := CompareValue(CaclVigor(ThreadItem1), CaclVigor(ThreadItem2));
158 q9_ 1.7 else
159     Result := 0;
160 hi_ 1.1 end;
161    
162     { if SortIndex = 0 then
163     if SortNoFlag then
164     Result := CompareInt(ThreadItem1.No, ThreadItem2.No)
165     else
166     Result := CompareText(ThreadItem1.Title, ThreadItem2.Title)
167     else if SortIndex = 1 then
168     Result := CompareInt(ThreadItem1.Count, ThreadItem2.Count)
169     else if SortIndex = 2 then
170     // Result := CompareInt(ThreadItem1.RoundNo, ThreadItem2.RoundNo)
171     Result := CompareText(ThreadItem1.RoundName, ThreadItem2.RoundName)
172     else
173     Result := CompareDate(ThreadItem1.LastModified, ThreadItem2.LastModified);
174     }
175 h677 1.17 if not FSortOrder then
176 hi_ 1.1 Result := Result * -1;
177 q9_ 1.8
178     // 鐃?鐃?鐃?鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃緒申1鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃?鐃?
179     if Result = 0 then begin
180 h677 1.17 if FSortNoFlag then
181 q9_ 1.8 Result := CompareInt(ThreadItem1.No, ThreadItem2.No)
182     else
183     Result := AnsiCompareText(ThreadItem1.Title, ThreadItem2.Title)
184     end;
185 hi_ 1.1 end;
186    
187     function CompareBool(Item1, Item2: Boolean): Integer;
188     begin
189     if (Item1 = True) and (Item2 = False) then
190     Result := 1
191     else if (Item2 = False) and (Item2 = True) then
192     Result := -1
193     else
194     Result := 0;
195     end;
196    
197     function CompareInt(Item1, Item2: Integer): Integer;
198     begin
199     if Item1 > Item2 then
200     Result := 1
201     else if Item1 < Item2 then
202     Result := -1
203     else
204     Result := 0;
205     end;
206    
207     function CompareDate(Item1, Item2: TDateTime): Integer;
208     begin
209     if Item1 > Item2 then
210     Result := 1
211     else if Item1 < Item2 then
212     Result := -1
213     else
214     Result := 0;
215     end;
216 h677 1.15 procedure SetSortDate(Date: TDateTime);
217     begin
218     FSortDate := Date;
219     end;
220     function GetSortDate(): TDateTime;
221     begin
222     Result := FSortDate;
223     end;
224 hi_ 1.1 end.

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