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 var
  18         SortOrder: Boolean;
  19         SortIndex: Integer;
  20         SortNoFlag: Boolean;
  21
  22 implementation
  23 var
  24         FSortDate: TDateTime;
  25
  26 function CategorySortProc(Item1, Item2: Pointer): integer;
  27 var
  28         CategoryItem1: TCategory;
  29         CategoryItem2: TCategory;
  30 begin
  31         CategoryItem1 := TCategory(Item1);
  32         CategoryItem2 := TCategory(Item2);
  33
  34         case TGikoBBSColumnID( SortIndex ) of
  35         gbbscTitle:
  36                 if SortNoFlag then
  37                         Result := CompareInt(CategoryItem1.No, CategoryItem2.No)
  38                 else
  39                         Result := AnsiCompareText(CategoryItem1.Title, CategoryItem2.Title);
  40         else
  41                 Result := CompareInt(CategoryItem1.No, CategoryItem2.No)
  42         end;
  43
  44         if not SortOrder then
  45                 Result := Result * -1;
  46 end;
  47
  48 function BoardSortProc(List: TStringList; Item1, Item2: Integer): integer;
  49 var
  50         BoardItem1: TBoard;
  51         BoardItem2: TBoard;
  52 begin
  53         BoardItem1 := TBoard(List.Objects[Item1]);
  54         BoardItem2 := TBoard(List.Objects[Item2]);
  55         case TGikoCategoryColumnID( SortIndex ) of
  56         gccTitle:
  57                 if SortNoFlag then
  58                         Result := CompareInt(BoardItem1.No, BoardItem2.No)
  59                 else
  60                         Result := AnsiCompareText(BoardItem1.Title, BoardItem2.Title);
  61
  62         gccRoundName:
  63                 Result := CompareInt(BoardItem1.Count, BoardItem2.Count);
  64
  65         gccLastModified:
  66                 Result := CompareDate(BoardItem1.RoundDate, BoardItem2.RoundDate);
  67         else
  68                 Result := CompareInt(BoardItem1.No, BoardItem2.No)
  69         end;
  70
  71         if not SortOrder then
  72                 Result := Result * -1;
  73 end;
  74
  75 function ThreadItemSortProc(List: TStringList; Item1, Item2: Integer): integer;
  76 var
  77         ThreadItem1: TThreadItem;
  78         ThreadItem2: TThreadItem;
  79         SpanDay1, SpanDay2: Double;
  80 begin
  81         ThreadItem1 := TThreadItem(List.Objects[ Item1 ]);
  82         ThreadItem2 := TThreadItem(List.Objects[ Item2 ]);
  83         case TGikoBoardColumnID( SortIndex ) of
  84                 gbcTitle:
  85                         begin
  86                                 if SortNoFlag then
  87                                         Result := CompareInt(ThreadItem1.No, ThreadItem2.No)
  88                                 else
  89                                         Result := AnsiCompareText(ThreadItem1.Title, ThreadItem2.Title)
  90                         end;
  91
  92                 gbcAllCount:                    Result := CompareInt(ThreadItem1.AllResCount, ThreadItem2.AllResCount);
  93                 gbcLocalCount:          Result := CompareInt(ThreadItem1.Count, ThreadItem2.Count);
  94                 gbcNonAcqCount:
  95                         begin
  96                                 if ThreadItem1.IsLogFile and ThreadItem2.IsLogFile then
  97                                         Result := CompareInt(ThreadItem1.AllResCount - ThreadItem1.Count, ThreadItem2.AllResCount - ThreadItem2.Count)
  98                                 else if ThreadItem1.IsLogFile then
  99                                         Result := 1
 100                                 else if ThreadItem2.IsLogFile then
 101                                         Result := -1
 102                                 else
 103                                         Result := 0;
 104                         end;
 105
 106                 gbcNewCount:                    Result := CompareInt(ThreadItem1.NewResCount, ThreadItem2.NewResCount);
 107                 gbcUnReadCount:         Result := 0;
 108                 gbcRoundName:           Result := AnsiCompareText(ThreadItem1.RoundName, ThreadItem2.RoundName);
 109                 gbcRoundDate:   Result := CompareDateTime(ThreadItem1.RoundDate, ThreadItem2.RoundDate); {gbcLastModified:}
 110                 gbcCreated:                             Result := CompareDateTime(ThreadItem1.CreateDate, ThreadItem2.CreateDate);
 111                 gbcLastModified:        Result := CompareDateTime(ThreadItem1.LastModified, ThreadItem2.LastModified); {gbcLastModified:}
 112                 gbcVigor:
 113                         begin
 114                                 SpanDay1 := DaySpan(FSortDate, ThreadItem1.CreateDate);
 115                                 SpanDay2 := DaySpan(FSortDate, ThreadItem2.CreateDate);
 116                                 if (SpanDay1 > 0) and (SpanDay2 > 0) then begin
 117                                         Result := CompareValue(
 118                                                                 ThreadItem1.AllResCount / SpanDay1,
 119                                                                 ThreadItem2.AllResCount / SpanDay2);
 120                                 end else if (SpanDay1 > 0) then begin
 121                                         Result := 1;
 122                                 end else if (SpanDay2 > 0) then begin
 123                                         Result := -1;
 124                                 end else begin
 125                                         Result := 0;
 126                                 end;
 127                         end;
 128         else
 129                 Result := 0;
 130         end;
 131
 132 {       if SortIndex = 0 then
 133                 if SortNoFlag then
 134                         Result := CompareInt(ThreadItem1.No, ThreadItem2.No)
 135                 else
 136                         Result := CompareText(ThreadItem1.Title, ThreadItem2.Title)
 137         else if SortIndex = 1 then
 138                 Result := CompareInt(ThreadItem1.Count, ThreadItem2.Count)
 139         else if SortIndex = 2 then
 140 //              Result := CompareInt(ThreadItem1.RoundNo, ThreadItem2.RoundNo)
 141                 Result := CompareText(ThreadItem1.RoundName, ThreadItem2.RoundName)
 142         else
 143                 Result := CompareDate(ThreadItem1.LastModified, ThreadItem2.LastModified);
 144 }
 145         if not SortOrder then
 146                 Result := Result * -1;
 147
 148         // \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
 149         if Result = 0 then begin
 150                 if SortNoFlag then
 151                         Result := CompareInt(ThreadItem1.No, ThreadItem2.No)
 152                 else
 153                         Result := AnsiCompareText(ThreadItem1.Title, ThreadItem2.Title)
 154         end;
 155 end;
 156
 157 function CompareBool(Item1, Item2: Boolean): Integer;
 158 begin
 159         if (Item1 = True) and (Item2 = False) then
 160                 Result := 1
 161         else if (Item2 = False) and (Item2 = True) then
 162                 Result := -1
 163         else
 164                 Result := 0;
 165 end;
 166
 167 function CompareInt(Item1, Item2: Integer): Integer;
 168 begin
 169         if Item1 > Item2 then
 170                 Result := 1
 171         else if Item1 < Item2 then
 172                 Result := -1
 173         else
 174                 Result := 0;
 175 end;
 176
 177 function CompareDate(Item1, Item2: TDateTime): Integer;
 178 begin
 179         if Item1 > Item2 then
 180                 Result := 1
 181         else if Item1 < Item2 then
 182                 Result := -1
 183         else
 184                 Result := 0;
 185 end;
 186 procedure SetSortDate(Date: TDateTime);
 187 begin
 188         FSortDate := Date;
 189 end;
 190 function GetSortDate(): TDateTime;
 191 begin
 192         Result := FSortDate;
 193 end;
 194 end.