Sort.pas

   1 unit Sort;
   2
   3 interface
   4 uses
   5         Windows, Messages, SysUtils, Classes, Controls, Forms,
   6         BoardGroup,DateUtils,
   7         Setting, Math;
   8
   9         function CategorySortProc(Item1, Item2: Pointer): integer;
  10         function BoardSortProc(List: TStringList; Item1, Item2: Integer): integer;
  11         function ThreadItemSortProc(List: TStringList; Item1, Item2: Integer): integer;
  12         function CompareBool(Item1, Item2: Boolean): integer;
  13         function CompareInt(Item1, Item2: Integer): Integer;
  14         function CompareDate(Item1, Item2: TDateTime): Integer;
  15         procedure SetSortDate(Date: TDateTime);
  16         function GetSortDate(): TDateTime;
  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
  24 implementation
  25
  26 var
  27         FSortDate: TDateTime;
  28         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
  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         case TGikoBBSColumnID( FSortIndex ) of
  81         gbbscTitle:
  82                 if FSortNoFlag then
  83                         Result := CompareInt(CategoryItem1.No, CategoryItem2.No)
  84                 else
  85                         Result := AnsiCompareText(CategoryItem1.Title, CategoryItem2.Title);
  86         else
  87                 Result := CompareInt(CategoryItem1.No, CategoryItem2.No)
  88         end;
  89
  90         if not FSortOrder then
  91                 Result := Result * -1;
  92 end;
  93
  94 function BoardSortProc(List: TStringList; Item1, Item2: Integer): integer;
  95 var
  96         BoardItem1: TBoard;
  97         BoardItem2: TBoard;
  98 begin
  99         BoardItem1 := TBoard(List.Objects[Item1]);
 100         BoardItem2 := TBoard(List.Objects[Item2]);
 101         case TGikoCategoryColumnID( FSortIndex ) of
 102         gccTitle:
 103                 if FSortNoFlag then
 104                         Result := CompareInt(BoardItem1.No, BoardItem2.No)
 105                 else
 106                         Result := AnsiCompareText(BoardItem1.Title, BoardItem2.Title);
 107
 108         gccRoundName:
 109                 Result := CompareInt(BoardItem1.Count, BoardItem2.Count);
 110
 111         gccLastModified:
 112                 Result := CompareDate(BoardItem1.RoundDate, BoardItem2.RoundDate);
 113         else
 114                 Result := CompareInt(BoardItem1.No, BoardItem2.No)
 115         end;
 116
 117         if not FSortOrder then
 118                 Result := Result * -1;
 119 end;
 120
 121 function ThreadItemSortProc(List: TStringList; Item1, Item2: Integer): integer;
 122 var
 123         ThreadItem1: TThreadItem;
 124         ThreadItem2: TThreadItem;
 125 begin
 126         ThreadItem1 := TThreadItem(List.Objects[ Item1 ]);
 127         ThreadItem2 := TThreadItem(List.Objects[ Item2 ]);
 128         case TGikoBoardColumnID( FSortIndex ) of
 129                 gbcTitle:
 130                         begin
 131                                 if FSortNoFlag then
 132                                         Result := CompareInt(ThreadItem1.No, ThreadItem2.No)
 133                                 else
 134                                         Result := AnsiCompareText(ThreadItem1.Title, ThreadItem2.Title)
 135                         end;
 136
 137                 gbcAllCount:                    Result := CompareInt(ThreadItem1.AllResCount, ThreadItem2.AllResCount);
 138                 gbcLocalCount:          Result := CompareInt(ThreadItem1.Count, ThreadItem2.Count);
 139                 gbcNonAcqCount:
 140                         begin
 141                                 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                                 else
 148                                         Result := 0;
 149                         end;
 150
 151                 gbcNewCount:                    Result := CompareInt(ThreadItem1.NewResCount, ThreadItem2.NewResCount);
 152                 gbcUnReadCount:         Result := 0;
 153                 gbcRoundName:           Result := AnsiCompareText(ThreadItem1.RoundName, ThreadItem2.RoundName);
 154                 gbcRoundDate:   Result := CompareDateTime(ThreadItem1.RoundDate, ThreadItem2.RoundDate); {gbcLastModified:}
 155                 gbcCreated:                             Result := CompareDateTime(ThreadItem1.CreateDate, ThreadItem2.CreateDate);
 156                 gbcLastModified:        Result := CompareDateTime(ThreadItem1.LastModified, ThreadItem2.LastModified); {gbcLastModified:}
 157                 gbcVigor:       Result := CompareValue(CaclVigor(ThreadItem1), CaclVigor(ThreadItem2));
 158         else
 159                 Result := 0;
 160         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         if not FSortOrder then
 176                 Result := Result * -1;
 177
 178         // \83\\81[\83g\95]\89¿\82ª\93¯\82¶\8fê\8d\87\82Í\81A\91æ1\83J\83\89\83\80\82Ì\8f¸\8f\87\82É\83\\81[\83g
 179         if Result = 0 then begin
 180                 if FSortNoFlag then
 181                         Result := CompareInt(ThreadItem1.No, ThreadItem2.No)
 182                 else
 183                         Result := AnsiCompareText(ThreadItem1.Title, ThreadItem2.Title)
 184         end;
 185 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 procedure SetSortDate(Date: TDateTime);
 217 begin
 218         FSortDate := Date;
 219 end;
 220 function GetSortDate(): TDateTime;
 221 begin
 222         Result := FSortDate;
 223 end;
 224 end.