まちBBSで削除レスがあるレス番号とスレの件数がずれる不具合を修正

[gikonavigoeson/gikonavi.git] / Sort.pas

diff --git a/Sort.pas b/Sort.pas
index a695b5d..d013076 100644 (file)
--- a/Sort.pas
+++ b/Sort.pas
@@ -4,7 +4,7 @@ interface
 uses
        Windows, Messages, SysUtils, Classes, Controls, Forms,
        BoardGroup,DateUtils,
-       Setting;
+       Setting, Math;
 
        function CategorySortProc(Item1, Item2: Pointer): integer;
        function BoardSortProc(List: TStringList; Item1, Item2: Integer): integer;
@@ -12,14 +12,62 @@ uses
        function CompareBool(Item1, Item2: Boolean): integer;
        function CompareInt(Item1, Item2: Integer): Integer;
        function CompareDate(Item1, Item2: TDateTime): Integer;
+       procedure SetSortDate(Date: TDateTime);
+       function GetSortDate(): TDateTime;
+       procedure SetSortOrder(Order: Boolean);
+       function GetSortOrder: Boolean;
+       procedure SetSortIndex(Index: Integer);
+       function GetSortIndex: Integer;
+       procedure SetSortNoFlag(Flag: Boolean);
+       function GetSortNoFlag: Boolean;
+
+implementation
 
 var
-       SortOrder: Boolean;
-       SortIndex: Integer;
-       SortNoFlag: Boolean;
-       SortNonAcquiredCountFlag: Boolean;
+       FSortDate: TDateTime;
+       FSortOrder: Boolean;
+       FSortIndex: Integer;
+       FSortNoFlag: Boolean;
 
-implementation
+function CaclVigor(Thread: TThreadItem): Double;
+var
+       span : Double;
+begin
+       if (Thread.AgeSage <> gasArch) then begin
+               span := DaySpan(Sort.GetSortDate, Thread.CreateDate);
+       end else begin
+               span := DaySpan(Thread.LastModified, Thread.CreateDate);
+       end;
+       if (span > 0) then begin
+               Result := Thread.AllResCount / span;
+       end else begin
+               Result := 0;
+       end;
+end;
+procedure SetSortOrder(Order: Boolean);
+begin
+       FSortOrder := Order;
+end;
+function GetSortOrder: Boolean;
+begin
+       Result := FSortOrder;
+end;
+procedure SetSortIndex(Index: Integer);
+begin
+       FSortIndex := Index;
+end;
+function GetSortIndex: Integer;
+begin
+       Result := FSortIndex;
+end;
+procedure SetSortNoFlag(Flag: Boolean);
+begin
+       FSortNoFlag := Flag;
+end;
+function GetSortNoFlag: Boolean;
+begin
+       Result := FSortNoFlag;
+end;
 
 function CategorySortProc(Item1, Item2: Pointer): integer;
 var
@@ -29,15 +77,17 @@ begin
        CategoryItem1 := TCategory(Item1);
        CategoryItem2 := TCategory(Item2);
 
-       case TGikoBBSColumnID( SortIndex ) of
+       case TGikoBBSColumnID( FSortIndex ) of
        gbbscTitle:
-               if SortNoFlag then
+               if FSortNoFlag then
                        Result := CompareInt(CategoryItem1.No, CategoryItem2.No)
                else
                        Result := AnsiCompareText(CategoryItem1.Title, CategoryItem2.Title);
+       else
+               Result := CompareInt(CategoryItem1.No, CategoryItem2.No)
        end;
 
-       if not SortOrder then
+       if not FSortOrder then
                Result := Result * -1;
 end;
 
@@ -48,9 +98,9 @@ var
 begin
        BoardItem1 := TBoard(List.Objects[Item1]);
        BoardItem2 := TBoard(List.Objects[Item2]);
-       case TGikoCategoryColumnID( SortIndex ) of
+       case TGikoCategoryColumnID( FSortIndex ) of
        gccTitle:
-               if SortNoFlag then
+               if FSortNoFlag then
                        Result := CompareInt(BoardItem1.No, BoardItem2.No)
                else
                        Result := AnsiCompareText(BoardItem1.Title, BoardItem2.Title);
@@ -60,9 +110,11 @@ begin
 
        gccLastModified:
                Result := CompareDate(BoardItem1.RoundDate, BoardItem2.RoundDate);
+       else
+               Result := CompareInt(BoardItem1.No, BoardItem2.No)
        end;
 
-       if not SortOrder then
+       if not FSortOrder then
                Result := Result * -1;
 end;
 
@@ -73,10 +125,10 @@ var
 begin
        ThreadItem1 := TThreadItem(List.Objects[ Item1 ]);
        ThreadItem2 := TThreadItem(List.Objects[ Item2 ]);
-       case TGikoBoardColumnID( SortIndex ) of
+       case TGikoBoardColumnID( FSortIndex ) of
                gbcTitle:
                        begin
-                               if SortNoFlag then
+                               if FSortNoFlag then
                                        Result := CompareInt(ThreadItem1.No, ThreadItem2.No)
                                else
                                        Result := AnsiCompareText(ThreadItem1.Title, ThreadItem2.Title)
@@ -99,8 +151,10 @@ begin
                gbcNewCount:                    Result := CompareInt(ThreadItem1.NewResCount, ThreadItem2.NewResCount);
                gbcUnReadCount:         Result := 0;
                gbcRoundName:           Result := AnsiCompareText(ThreadItem1.RoundName, ThreadItem2.RoundName);
-               gbcLastModified:        Result := CompareDateTime(ThreadItem1.RoundDate, ThreadItem2.RoundDate);
+               gbcRoundDate:   Result := CompareDateTime(ThreadItem1.RoundDate, ThreadItem2.RoundDate); {gbcLastModified:}
                gbcCreated:                             Result := CompareDateTime(ThreadItem1.CreateDate, ThreadItem2.CreateDate);
+               gbcLastModified:        Result := CompareDateTime(ThreadItem1.LastModified, ThreadItem2.LastModified); {gbcLastModified:}
+               gbcVigor:       Result := CompareValue(CaclVigor(ThreadItem1), CaclVigor(ThreadItem2));
        else
                Result := 0;
        end;
@@ -118,12 +172,12 @@ begin
        else
                Result := CompareDate(ThreadItem1.LastModified, ThreadItem2.LastModified);
 }
-       if not SortOrder then
+       if not FSortOrder then
                Result := Result * -1;
 
        // \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
        if Result = 0 then begin
-               if SortNoFlag then
+               if FSortNoFlag then
                        Result := CompareInt(ThreadItem1.No, ThreadItem2.No)
                else
                        Result := AnsiCompareText(ThreadItem1.Title, ThreadItem2.Title)
@@ -159,5 +213,12 @@ begin
        else
                Result := 0;
 end;
-
+procedure SetSortDate(Date: TDateTime);
+begin
+       FSortDate := Date;
+end;
+function GetSortDate(): TDateTime;
+begin
+       Result := FSortDate;
+end;
 end.