Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/Sort.pas

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

revision 1.16 by h677, Wed Feb 1 15:28:10 2006 UTC revision 1.17 by h677, Wed Feb 22 17:21:21 2006 UTC
# Line 14  uses Line 14  uses
14          function CompareDate(Item1, Item2: TDateTime): Integer;          function CompareDate(Item1, Item2: TDateTime): Integer;
15          procedure SetSortDate(Date: TDateTime);          procedure SetSortDate(Date: TDateTime);
16          function GetSortDate(): TDateTime;          function GetSortDate(): TDateTime;
17  var          procedure SetSortOrder(Order: Boolean);
18          SortOrder: Boolean;          function GetSortOrder: Boolean;
19          SortIndex: Integer;          procedure SetSortIndex(Index: Integer);
20          SortNoFlag: Boolean;          function GetSortIndex: Integer;
21            procedure SetSortNoFlag(Flag: Boolean);
22            function GetSortNoFlag: Boolean;
23    
24  implementation  implementation
25    
26  var  var
27          FSortDate: TDateTime;          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;  function CategorySortProc(Item1, Item2: Pointer): integer;
73  var  var
# Line 31  begin Line 77  begin
77          CategoryItem1 := TCategory(Item1);          CategoryItem1 := TCategory(Item1);
78          CategoryItem2 := TCategory(Item2);          CategoryItem2 := TCategory(Item2);
79    
80          case TGikoBBSColumnID( SortIndex ) of          case TGikoBBSColumnID( FSortIndex ) of
81          gbbscTitle:          gbbscTitle:
82                  if SortNoFlag then                  if FSortNoFlag then
83                          Result := CompareInt(CategoryItem1.No, CategoryItem2.No)                          Result := CompareInt(CategoryItem1.No, CategoryItem2.No)
84                  else                  else
85                          Result := AnsiCompareText(CategoryItem1.Title, CategoryItem2.Title);                          Result := AnsiCompareText(CategoryItem1.Title, CategoryItem2.Title);
# Line 41  begin Line 87  begin
87                  Result := CompareInt(CategoryItem1.No, CategoryItem2.No)                  Result := CompareInt(CategoryItem1.No, CategoryItem2.No)
88          end;          end;
89    
90          if not SortOrder then          if not FSortOrder then
91                  Result := Result * -1;                  Result := Result * -1;
92  end;  end;
93    
# Line 52  var Line 98  var
98  begin  begin
99          BoardItem1 := TBoard(List.Objects[Item1]);          BoardItem1 := TBoard(List.Objects[Item1]);
100          BoardItem2 := TBoard(List.Objects[Item2]);          BoardItem2 := TBoard(List.Objects[Item2]);
101          case TGikoCategoryColumnID( SortIndex ) of          case TGikoCategoryColumnID( FSortIndex ) of
102          gccTitle:          gccTitle:
103                  if SortNoFlag then                  if FSortNoFlag then
104                          Result := CompareInt(BoardItem1.No, BoardItem2.No)                          Result := CompareInt(BoardItem1.No, BoardItem2.No)
105                  else                  else
106                          Result := AnsiCompareText(BoardItem1.Title, BoardItem2.Title);                          Result := AnsiCompareText(BoardItem1.Title, BoardItem2.Title);
# Line 68  begin Line 114  begin
114                  Result := CompareInt(BoardItem1.No, BoardItem2.No)                  Result := CompareInt(BoardItem1.No, BoardItem2.No)
115          end;          end;
116    
117          if not SortOrder then          if not FSortOrder then
118                  Result := Result * -1;                  Result := Result * -1;
119  end;  end;
120    
# Line 76  function ThreadItemSortProc(List: TStrin Line 122  function ThreadItemSortProc(List: TStrin
122  var  var
123          ThreadItem1: TThreadItem;          ThreadItem1: TThreadItem;
124          ThreadItem2: TThreadItem;          ThreadItem2: TThreadItem;
         SpanDay1, SpanDay2: Double;  
125  begin  begin
126          ThreadItem1 := TThreadItem(List.Objects[ Item1 ]);          ThreadItem1 := TThreadItem(List.Objects[ Item1 ]);
127          ThreadItem2 := TThreadItem(List.Objects[ Item2 ]);          ThreadItem2 := TThreadItem(List.Objects[ Item2 ]);
128          case TGikoBoardColumnID( SortIndex ) of          case TGikoBoardColumnID( FSortIndex ) of
129                  gbcTitle:                  gbcTitle:
130                          begin                          begin
131                                  if SortNoFlag then                                  if FSortNoFlag then
132                                          Result := CompareInt(ThreadItem1.No, ThreadItem2.No)                                          Result := CompareInt(ThreadItem1.No, ThreadItem2.No)
133                                  else                                  else
134                                          Result := AnsiCompareText(ThreadItem1.Title, ThreadItem2.Title)                                          Result := AnsiCompareText(ThreadItem1.Title, ThreadItem2.Title)
# Line 109  begin Line 154  begin
154                  gbcRoundDate:   Result := CompareDateTime(ThreadItem1.RoundDate, ThreadItem2.RoundDate); {gbcLastModified:}                  gbcRoundDate:   Result := CompareDateTime(ThreadItem1.RoundDate, ThreadItem2.RoundDate); {gbcLastModified:}
155                  gbcCreated:                             Result := CompareDateTime(ThreadItem1.CreateDate, ThreadItem2.CreateDate);                  gbcCreated:                             Result := CompareDateTime(ThreadItem1.CreateDate, ThreadItem2.CreateDate);
156                  gbcLastModified:        Result := CompareDateTime(ThreadItem1.LastModified, ThreadItem2.LastModified); {gbcLastModified:}                  gbcLastModified:        Result := CompareDateTime(ThreadItem1.LastModified, ThreadItem2.LastModified); {gbcLastModified:}
157                  gbcVigor:                  gbcVigor:       Result := CompareValue(CaclVigor(ThreadItem1), CaclVigor(ThreadItem2));
                         begin  
                                 SpanDay1 := DaySpan(FSortDate, ThreadItem1.CreateDate);  
                                 SpanDay2 := DaySpan(FSortDate, ThreadItem2.CreateDate);  
                                 if (SpanDay1 > 0) and (SpanDay2 > 0) then begin  
                                         Result := CompareValue(  
                                                                 ThreadItem1.AllResCount / SpanDay1,  
                                                                 ThreadItem2.AllResCount / SpanDay2);  
                                 end else if (SpanDay1 > 0) then begin  
                                         Result := 1;  
                                 end else if (SpanDay2 > 0) then begin  
                                         Result := -1;  
                                 end else begin  
                                         Result := 0;  
                                 end;  
                         end;  
158          else          else
159                  Result := 0;                  Result := 0;
160          end;          end;
# Line 142  begin Line 172  begin
172          else          else
173                  Result := CompareDate(ThreadItem1.LastModified, ThreadItem2.LastModified);                  Result := CompareDate(ThreadItem1.LastModified, ThreadItem2.LastModified);
174  }  }
175          if not SortOrder then          if not FSortOrder then
176                  Result := Result * -1;                  Result := Result * -1;
177    
178          // ソート評価が同じ場合は、第1カラムの昇順にソート          // ソート評価が同じ場合は、第1カラムの昇順にソート
179          if Result = 0 then begin          if Result = 0 then begin
180                  if SortNoFlag then                  if FSortNoFlag then
181                          Result := CompareInt(ThreadItem1.No, ThreadItem2.No)                          Result := CompareInt(ThreadItem1.No, ThreadItem2.No)
182                  else                  else
183                          Result := AnsiCompareText(ThreadItem1.Title, ThreadItem2.Title)                          Result := AnsiCompareText(ThreadItem1.Title, ThreadItem2.Title)

Legend:
Removed from v.1.16  
changed lines
  Added in v.1.17

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