RxFPC: implement metod TRxMemoryData.SortOnFieldsEx

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6794 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2019-01-18 06:45:33 +00:00
parent 9fac446b61
commit 205588f98c
6 changed files with 261 additions and 53 deletions
--- a/components/rx/trunk/demos/AutoSort/AutoSortDemo.lpi
+++ b/components/rx/trunk/demos/AutoSort/AutoSortDemo.lpi
@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
  <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="11"/>
    <General>
      <MainUnit Value="0"/>
      <ResourceType Value="res"/>
@ -17,15 +17,19 @@
    </BuildModes>
    <PublishOptions>
      <Version Value="2"/>
-      <IgnoreBinaries Value="False"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
    </PublishOptions>
    <RunParams>
      <local>
-        <FormatVersion Value="1"/>
        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
      </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+          </local>
+        </Mode0>
+      </Modes>
    </RunParams>
    <RequiredPackages Count="3">
      <Item1>
@ -40,12 +44,12 @@
        <PackageName Value="LCL"/>
      </Item3>
    </RequiredPackages>
-    <Units Count="6">
+    <Units Count="9">
      <Unit0>
        <Filename Value="AutoSortDemo.lpr"/>
        <IsPartOfProject Value="True"/>
        <CursorPos Y="20"/>
-        <UsageCount Value="20"/>
+        <UsageCount Value="21"/>
      </Unit0>
      <Unit1>
        <Filename Value="asdmainunit.pas"/>
@ -55,9 +59,9 @@
        <ResourceBaseClass Value="Form"/>
        <UnitName Value="asdMainUnit"/>
        <IsVisibleTab Value="True"/>
-        <TopLine Value="41"/>
-        <CursorPos X="50" Y="50"/>
-        <UsageCount Value="20"/>
+        <TopLine Value="50"/>
+        <CursorPos X="47" Y="65"/>
+        <UsageCount Value="21"/>
        <Loaded Value="True"/>
        <LoadedDesigner Value="True"/>
      </Unit1>
@ -87,12 +91,151 @@
        <CursorPos Y="1346"/>
        <UsageCount Value="10"/>
      </Unit5>
+      <Unit6>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <EditorIndex Value="1"/>
+        <TopLine Value="1837"/>
+        <CursorPos X="113" Y="1859"/>
+        <UsageCount Value="11"/>
+        <Loaded Value="True"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="../../rxdb/exsortmds.pas"/>
+        <EditorIndex Value="-1"/>
+        <TopLine Value="31"/>
+        <CursorPos X="15" Y="47"/>
+        <UsageCount Value="10"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="../../rxdb/rxsortmemds.pas"/>
+        <EditorIndex Value="2"/>
+        <TopLine Value="41"/>
+        <CursorPos X="47" Y="66"/>
+        <UsageCount Value="10"/>
+        <Loaded Value="True"/>
+      </Unit8>
    </Units>
-    <JumpHistory Count="1">
+    <JumpHistory Count="30" HistoryIndex="29">
      <Position1>
-        <Filename Value="asdmainunit.pas"/>
-        <Caret Line="39" Column="20" TopLine="22"/>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1837" TopLine="1817"/>
      </Position1>
+      <Position2>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1839" TopLine="1817"/>
+      </Position2>
+      <Position3>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1840" TopLine="1833"/>
+      </Position3>
+      <Position4>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1842" TopLine="1833"/>
+      </Position4>
+      <Position5>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1844" TopLine="1833"/>
+      </Position5>
+      <Position6>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1845" TopLine="1833"/>
+      </Position6>
+      <Position7>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1846" TopLine="1833"/>
+      </Position7>
+      <Position8>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1855" TopLine="1833"/>
+      </Position8>
+      <Position9>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1857" TopLine="1833"/>
+      </Position9>
+      <Position10>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1858" TopLine="1834"/>
+      </Position10>
+      <Position11>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1851" Column="24" TopLine="1835"/>
+      </Position11>
+      <Position12>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1866" TopLine="1842"/>
+      </Position12>
+      <Position13>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1833" TopLine="1817"/>
+      </Position13>
+      <Position14>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1835" TopLine="1817"/>
+      </Position14>
+      <Position15>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1836" TopLine="1817"/>
+      </Position15>
+      <Position16>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1837" TopLine="1817"/>
+      </Position16>
+      <Position17>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1839" TopLine="1817"/>
+      </Position17>
+      <Position18>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1840" TopLine="1827"/>
+      </Position18>
+      <Position19>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1842" TopLine="1827"/>
+      </Position19>
+      <Position20>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1844" TopLine="1827"/>
+      </Position20>
+      <Position21>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1845" TopLine="1827"/>
+      </Position21>
+      <Position22>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1846" TopLine="1827"/>
+      </Position22>
+      <Position23>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1855" TopLine="1831"/>
+      </Position23>
+      <Position24>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1857" TopLine="1833"/>
+      </Position24>
+      <Position25>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1858" TopLine="1834"/>
+      </Position25>
+      <Position26>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1866" TopLine="1851"/>
+      </Position26>
+      <Position27>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1833" TopLine="1843"/>
+      </Position27>
+      <Position28>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1857" TopLine="1845"/>
+      </Position28>
+      <Position29>
+        <Filename Value="../../rxdb/rxmemds.pas"/>
+        <Caret Line="1757" TopLine="1741"/>
+      </Position29>
+      <Position30>
+        <Filename Value="asdmainunit.pas"/>
+        <Caret Line="64" Column="47" TopLine="49"/>
+      </Position30>
    </JumpHistory>
  </ProjectOptions>
  <CompilerOptions>
@ -110,6 +253,9 @@
      </SyntaxOptions>
    </Parsing>
    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
      <Options>
        <Win32>
          <GraphicApplication Value="True"/>
@ -118,6 +264,11 @@
    </Linking>
  </CompilerOptions>
  <Debugging>
+    <Watches Count="1">
+      <Item1>
+        <Expression Value="FAscSortList"/>
+      </Item1>
+    </Watches>
    <Exceptions Count="3">
      <Item1>
        <Name Value="EAbort"/>
--- a/components/rx/trunk/demos/AutoSort/asdmainunit.lfm
+++ b/components/rx/trunk/demos/AutoSort/asdmainunit.lfm
@ -7,7 +7,7 @@ object Form1: TForm1
  ClientHeight = 524
  ClientWidth = 780
  OnCreate = FormCreate
-  LCLVersion = '1.7'
+  LCLVersion = '2.1.0.0'
  object RxDBGrid1: TRxDBGrid
    AnchorSideLeft.Control = Owner
    AnchorSideTop.Control = CheckBox1
@ -17,8 +17,8 @@ object Form1: TForm1
    AnchorSideBottom.Control = Owner
    AnchorSideBottom.Side = asrBottom
    Left = 6
-    Height = 452
-    Top = 66
+    Height = 454
+    Top = 64
    Width = 768
    ColumnDefValues.BlobText = '(данные)'
    TitleButtons = True
@ -31,15 +31,29 @@ object Form1: TForm1
        Width = 88
        FieldName = 'ID'
        EditButtons = <>
-        Filter.IsNull = False
-        Filter.IsAll = True
        Filter.DropDownRows = 0
        Filter.EmptyValue = '(Пусто)'
+        Filter.NotEmptyValue = '(Не пусто)'
        Filter.AllValue = '(All values)'
        Filter.EmptyFont.Style = [fsItalic]
        Filter.ItemIndex = -1
        Footers = <>
      end    
+      item
+        Title.Alignment = taCenter
+        Title.Orientation = toHorizontal
+        Title.Caption = 'TYPE'
+        Width = 70
+        FieldName = 'TYPE'
+        EditButtons = <>
+        Filter.DropDownRows = 0
+        Filter.EmptyValue = '(Пусто)'
+        Filter.NotEmptyValue = '(Не пусто)'
+        Filter.AllValue = '(Все значения)'
+        Filter.EmptyFont.Style = [fsItalic]
+        Filter.ItemIndex = -1
+        Footers = <>
+      end    
      item
        Title.Alignment = taCenter
        Title.Orientation = toHorizontal
@ -47,10 +61,9 @@ object Form1: TForm1
        Width = 350
        FieldName = 'NAME'
        EditButtons = <>
-        Filter.IsNull = False
-        Filter.IsAll = True
        Filter.DropDownRows = 0
        Filter.EmptyValue = '(Пусто)'
+        Filter.NotEmptyValue = '(Не пусто)'
        Filter.AllValue = '(All values)'
        Filter.EmptyFont.Style = [fsItalic]
        Filter.ItemIndex = -1
@ -63,10 +76,9 @@ object Form1: TForm1
        Width = 100
        FieldName = 'DATE_ENTER'
        EditButtons = <>
-        Filter.IsNull = False
-        Filter.IsAll = True
        Filter.DropDownRows = 0
        Filter.EmptyValue = '(Пусто)'
+        Filter.NotEmptyValue = '(Не пусто)'
        Filter.AllValue = '(All values)'
        Filter.EmptyFont.Style = [fsItalic]
        Filter.ItemIndex = -1
@ -129,6 +141,8 @@ object Form1: TForm1
        Enabled = True
      end>
    FooterOptions.DrawFullLine = False
+    SearchOptions.QuickSearchOptions = [loCaseInsensitive, loPartialKey]
+    SearchOptions.FromStart = False
    OptionsRx = []
    Anchors = [akTop, akLeft, akRight, akBottom]
    BorderSpacing.Around = 6
@ -139,7 +153,6 @@ object Form1: TForm1
    GridLineStyle = psSolid
    DataSource = Datasource1
    Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColumnMove, dgColLines, dgRowLines, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit, dgHeaderPushedLook]
-    ParentColor = False
    TabOrder = 0
    TitleStyle = tsNative
  end
@ -148,9 +161,9 @@ object Form1: TForm1
    AnchorSideTop.Control = CheckBox2
    AnchorSideTop.Side = asrBottom
    Left = 6
-    Height = 24
-    Top = 36
-    Width = 107
+    Height = 23
+    Top = 35
+    Width = 108
    BorderSpacing.Around = 6
    Caption = 'Title buttons'
    OnChange = CheckBox2Change
@ -160,9 +173,9 @@ object Form1: TForm1
    AnchorSideLeft.Control = Owner
    AnchorSideTop.Control = Owner
    Left = 6
-    Height = 24
+    Height = 23
    Top = 6
-    Width = 85
+    Width = 86
    BorderSpacing.Around = 6
    Caption = 'Auto sort'
    OnChange = CheckBox2Change
@ -176,6 +189,10 @@ object Form1: TForm1
        DataType = ftInteger
        Precision = -1
      end    
+      item
+        Name = 'TYPE'
+        DataType = ftInteger
+      end    
      item
        Name = 'NAME'
        DataType = ftString
@ -188,8 +205,8 @@ object Form1: TForm1
        Precision = -1
      end>
    PacketRecords = 0
-    left = 192
-    top = 16
+    Left = 192
+    Top = 16
    object RxMemoryData1ID: TLongintField
      DisplayWidth = 10
      FieldKind = fkData
@ -200,11 +217,20 @@ object Form1: TForm1
      ReadOnly = False
      Required = False
    end
+    object RxMemoryData1TYPE: TLongintField
+      FieldKind = fkData
+      FieldName = 'TYPE'
+      Index = 1
+      LookupCache = False
+      ProviderFlags = [pfInUpdate, pfInWhere]
+      ReadOnly = False
+      Required = False
+    end
    object RxMemoryData1NAME: TStringField
      DisplayWidth = 100
      FieldKind = fkData
      FieldName = 'NAME'
-      Index = 1
+      Index = 2
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
@ -215,7 +241,7 @@ object Form1: TForm1
      DisplayWidth = 10
      FieldKind = fkData
      FieldName = 'DATE_ENTER'
-      Index = 2
+      Index = 3
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
@ -224,7 +250,7 @@ object Form1: TForm1
  end
  object Datasource1: TDataSource
    DataSet = RxMemoryData1
-    left = 152
-    top = 16
+    Left = 152
+    Top = 16
  end
 end
--- a/components/rx/trunk/demos/AutoSort/asdmainunit.pas
+++ b/components/rx/trunk/demos/AutoSort/asdmainunit.pas
@ -41,6 +41,7 @@ type
    RxMemoryData1DATE_ENTER: TDateField;
    RxMemoryData1ID: TLongintField;
    RxMemoryData1NAME: TStringField;
+    RxMemoryData1TYPE: TLongintField;
    procedure CheckBox2Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
@ -60,10 +61,10 @@ implementation
 procedure TForm1.FormCreate(Sender: TObject);
 begin
  RxMemoryData1.Open;
-  RxMemoryData1.AppendRecord([1, 'Delphi', EncodeDate(1995, 8, 1)]);
-  RxMemoryData1.AppendRecord([2, 'Turbo Pascal', EncodeDate(1983, 8, 1)]);
-  RxMemoryData1.AppendRecord([3, 'Free Pascal', EncodeDate(1993, 1, 1)]);
-  RxMemoryData1.AppendRecord([4, 'Lazarus', Now]);
+  RxMemoryData1.AppendRecord([1, 1, 'Delphi', EncodeDate(1995, 8, 1)]);
+  RxMemoryData1.AppendRecord([2, 1, 'Turbo Pascal', EncodeDate(1983, 8, 1)]);
+  RxMemoryData1.AppendRecord([3, 2, 'Free Pascal', EncodeDate(1993, 1, 1)]);
+  RxMemoryData1.AppendRecord([4, 2, 'Lazarus', Now]);

  CheckBox2.Checked:=RxDBGrid1.AutoSort;
  CheckBox1.Checked:=RxDBGrid1.TitleButtons;
--- a/components/rx/trunk/demos/RxMDI/unit1.pas
+++ b/components/rx/trunk/demos/RxMDI/unit1.pas
@ -97,7 +97,7 @@ begin
  else
    RxMDITasks1.Options:=RxMDITasks1.Options - [rxtoMidleClickClose];

-  RxMDIPanel1.HideCloseButton:=optHideCloseButton.Checked;
+  RxMDIPanel1.HideCloseButton:=optHideCloseButton.Checked; ;
 end;

 procedure TForm1.Action1Execute(Sender: TObject);
--- a/components/rx/trunk/rxdb/rxmemds.pas
+++ b/components/rx/trunk/rxdb/rxmemds.pas
@ -64,6 +64,7 @@ type
    FIndexList: TList;
    FCaseInsensitiveSort: Boolean;
    FDescendingSort: Boolean;
+    FAscSortList: array of boolean;

    FFileName: string;
    FFileStream     : TFileStream;
@ -505,6 +506,7 @@ begin
  FRecords.Free;
  ReallocMem(FOffsets, 0);
  if Assigned(FParser) then FreeAndNil(FParser);
+  SetLength(FAscSortList, 0);
 end;

 { Records Management }
@ -1733,6 +1735,7 @@ end;
 procedure TRxMemoryData.SortOnFields(const FieldNames: string;
  CaseInsensitive: Boolean = True; Descending: Boolean = False);
 begin
+  SetLength(FAscSortList, 0);
  CreateIndexList(FieldNames);
  FCaseInsensitiveSort := CaseInsensitive;
  FDescendingSort := Descending;
@ -1746,16 +1749,26 @@ end;

 procedure TRxMemoryData.SortOnFieldsEx(const FieldNames: string;
  CaseInsensitive: Boolean; Asc: array of boolean);
+var
+  i: Integer;
 begin
-(*  CreateIndexList(FieldNames);
+  FDescendingSort := false;
+  SetLength(FAscSortList, Length(Asc));
+  if Length(Asc)>0 then
+  begin
+    for i:=0 to Length(Asc)-1 do
+      FAscSortList[i]:=Asc[i];
+  end;
+
+  CreateIndexList(FieldNames);
  FCaseInsensitiveSort := CaseInsensitive;
-  FDescendingSort := Descending;
  try
    Sort;
  except
    FreeIndexList;
    raise;
-  end; *)
+  end;
+  SetLength(FAscSortList, 0);
 end;

 procedure TRxMemoryData.Sort;
@ -1815,22 +1828,39 @@ var
  I: Integer;
 begin
  Result := 0;
-  if FIndexList <> nil then begin
-    for I := 0 to FIndexList.Count - 1 do begin
+  if FIndexList <> nil then
+  begin
+    for I := 0 to FIndexList.Count - 1 do
+    begin
      F := TField(FIndexList[I]);
      Data1 := FindFieldData(Item1.Data, F);
-      if Data1 <> nil then begin
+      if Data1 <> nil then
+      begin
        Data2 := FindFieldData(Item2.Data, F);
-        if Data2 <> nil then begin
-          if Boolean(Data1[0]) and Boolean(Data2[0]) then begin
+        if Data2 <> nil then
+        begin
+          if Boolean(Data1[0]) and Boolean(Data2[0]) then
+          begin
            Inc(Data1);
            Inc(Data2);
-            Result := CompareFields(Data1, Data2, F.DataType,
-              FCaseInsensitiveSort);
+            Result := CompareFields(Data1, Data2, F.DataType, FCaseInsensitiveSort);
          end
-          else if Boolean(Data1[0]) then Result := 1
-          else if Boolean(Data2[0]) then Result := -1;
-          if FDescendingSort then Result := -Result;
+          else
+          if Boolean(Data1[0]) then
+            Result := 1
+          else
+          if Boolean(Data2[0]) then
+            Result := -1;
+
+          if (Length(FAscSortList)>0) then
+          begin
+            if I<Length(FAscSortList) then
+              if not FAscSortList[i] then
+                Result := -Result;
+          end
+          else
+          if FDescendingSort then
+            Result := -Result;
        end;
      end;
      if Result <> 0 then Exit;
--- a/components/rx/trunk/rxdb/rxsortmemds.pas
+++ b/components/rx/trunk/rxdb/rxsortmemds.pas
@ -63,7 +63,7 @@ procedure TRxMemoryDataSortEngine.SortList(ListField: string;
  ADataSet: TDataSet; Asc: array of boolean; SortOptions: TRxSortEngineOptions);
 begin
  if Assigned(ADataSet) then
-    (ADataSet as TRxMemoryData).SortOnFields(ListField, seoCaseInsensitiveSort in SortOptions, Asc[0]);
+    (ADataSet as TRxMemoryData).SortOnFieldsEx(ListField, seoCaseInsensitiveSort in SortOptions, Asc);
 end;

 initialization