jvcllaz: Add TJvGridFilter incl demo.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7159 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/jvcllaz/design/JvJans/images/images.txt

@@ -1,3 +1,4 @@
+tjvgridfilter.bmp
 tjvyeargrid.png
 tjvyeargrid_150.png
 tjvyeargrid_200.png

components/jvcllaz/design/JvJans/jvjansreg.pas

@@ -18,6 +18,7 @@ uses
   JvYearGrid,
   //JvCSVData, JvCSVBaseControls, //JvCsvBaseEditor,
   JvMarkupViewer, JvMarkupLabel,
+  JvGridFilter,
   JvSimScope, JvSimIndicator, JvSimPID, JvSimPIDLinker, JvSimLogic,
   JvJanLED, JvJanToggle;
 
@@ -40,6 +41,11 @@ begin
     TJvMarkupViewer, TJvMarkupLabel
   ]);
 
+  // Grid-related components
+  RegisterComponents(RsPaletteJvclVisual, [
+    TJvGridFilter
+  ]);
+
                      (*
   // CSV Components
   RegisterComponents('Data Access', [TJvCSVDataset]);

components/jvcllaz/examples/JvGridFilter/JvGridFilterDemo.lpi

@@ -0,0 +1,80 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="JvGridFilterDemo"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+      <Icon Value="0"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="JvJansLazR"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="JvGridFilterDemo.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="main.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="..\..\bin\$(TargetCPU)-$(TargetOS)\JvGridFilterDemo"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

components/jvcllaz/examples/JvGridFilter/JvGridFilterDemo.lpr

@@ -0,0 +1,22 @@
+program JvGridFilterDemo;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, main
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

components/jvcllaz/examples/JvGridFilter/main.lfm

@@ -0,0 +1,342 @@
+object Form1: TForm1
+  Left = 340
+  Height = 552
+  Top = 127
+  Width = 569
+  Caption = 'JvGridFilter Demo'
+  ClientHeight = 552
+  ClientWidth = 569
+  LCLVersion = '2.1.0.0'
+  object StringGrid: TStringGrid
+    AnchorSideLeft.Control = Label2
+    AnchorSideTop.Control = Label2
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    AnchorSideBottom.Control = edFilter
+    Left = 8
+    Height = 467
+    Top = 46
+    Width = 561
+    Anchors = [akTop, akLeft, akRight, akBottom]
+    BorderSpacing.Top = 8
+    BorderSpacing.Bottom = 8
+    ColCount = 4
+    DefaultColWidth = 200
+    Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goSmoothScroll, goFixedRowNumbering]
+    RowCount = 25
+    TabOrder = 0
+    ColWidths = (
+      44
+      136
+      157
+      200
+    )
+    Cells = (
+      75
+      1
+      0
+      'First name'
+      1
+      1
+      'Abraham'
+      1
+      2
+      'Al'
+      1
+      3
+      'Albert'
+      1
+      4
+      'Alfred'
+      1
+      5
+      'Angelina'
+      1
+      6
+      'Audrey'
+      1
+      7
+      'Babe'
+      1
+      8
+      'Benjamin'
+      1
+      9
+      'Bill'
+      1
+      10
+      'Brad'
+      1
+      11
+      'C.S.'
+      1
+      12
+      'Charles'
+      1
+      13
+      'Cristiano'
+      1
+      14
+      'David'
+      1
+      15
+      'Elvis'
+      1
+      16
+      'Ernest'
+      1
+      17
+      'Franklin D.'
+      1
+      18
+      'Galileo'
+      1
+      19
+      'J.R.R.'
+      1
+      20
+      'JK'
+      1
+      21
+      'John F.'
+      1
+      22
+      'John'
+      1
+      23
+      'Ludwig Van'
+      1
+      24
+      'Mark'
+      2
+      0
+      'Last name'
+      2
+      1
+      'Lincoln'
+      2
+      2
+      'Gore'
+      2
+      3
+      'Einstein'
+      2
+      4
+      'Hitchcock'
+      2
+      5
+      'Jolie'
+      2
+      6
+      'Hepburn'
+      2
+      7
+      'Ruth'
+      2
+      8
+      'Franklin'
+      2
+      9
+      'Gates'
+      2
+      10
+      'Pitt'
+      2
+      11
+      'Lewis'
+      2
+      12
+      'Darwin'
+      2
+      13
+      'Ronaldo'
+      2
+      14
+      'Cameron'
+      2
+      15
+      'Presley'
+      2
+      16
+      'Hemingway'
+      2
+      17
+      'Roosevelt'
+      2
+      18
+      'Galilei'
+      2
+      19
+      'Tolkien'
+      2
+      20
+      'Rowling'
+      2
+      21
+      'Kennedy'
+      2
+      22
+      'Lennon'
+      2
+      23
+      'Beethoven'
+      2
+      24
+      'Zuckerberg'
+      3
+      0
+      'Business'
+      3
+      1
+      'Politics'
+      3
+      2
+      'Politics'
+      3
+      3
+      'Science'
+      3
+      4
+      'Movie'
+      3
+      5
+      'Movie'
+      3
+      6
+      'Movie'
+      3
+      7
+      'Sports'
+      3
+      8
+      'Science'
+      3
+      9
+      'Computer'
+      3
+      10
+      'Movie'
+      3
+      11
+      'Literature'
+      3
+      12
+      'Science'
+      3
+      13
+      'Sports'
+      3
+      14
+      'Politics'
+      3
+      15
+      'Music'
+      3
+      16
+      'Literature'
+      3
+      17
+      'Politics'
+      3
+      18
+      'Science'
+      3
+      19
+      'Literature'
+      3
+      20
+      'Literature'
+      3
+      21
+      'Politics'
+      3
+      22
+      'Music'
+      3
+      23
+      'Music'
+      3
+      24
+      'Computer'
+    )
+  end
+  object lblSomeFamousPeople: TLabel
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = Owner
+    Left = 8
+    Height = 15
+    Top = 8
+    Width = 117
+    BorderSpacing.Left = 8
+    BorderSpacing.Top = 8
+    Caption = 'Some famous people'
+    Font.Style = [fsBold]
+    ParentColor = False
+    ParentFont = False
+  end
+  object Label2: TLabel
+    AnchorSideLeft.Control = lblSomeFamousPeople
+    AnchorSideTop.Control = lblSomeFamousPeople
+    AnchorSideTop.Side = asrBottom
+    Left = 8
+    Height = 15
+    Top = 23
+    Width = 277
+    Caption = 'https://www.listchallenges.com/100-famous-people'
+    ParentColor = False
+  end
+  object lblFilter: TLabel
+    AnchorSideLeft.Control = StringGrid
+    AnchorSideTop.Control = edFilter
+    AnchorSideTop.Side = asrCenter
+    Left = 8
+    Height = 15
+    Top = 525
+    Width = 29
+    Caption = 'Filter:'
+    ParentColor = False
+  end
+  object edFilter: TEdit
+    AnchorSideTop.Side = asrBottom
+    AnchorSideBottom.Control = Owner
+    AnchorSideBottom.Side = asrBottom
+    Left = 48
+    Height = 23
+    Top = 521
+    Width = 264
+    Anchors = [akLeft, akBottom]
+    BorderSpacing.Bottom = 8
+    TabOrder = 1
+    Text = '[Business] = "Music"'
+  end
+  object btnFilter: TButton
+    AnchorSideTop.Side = asrCenter
+    Left = 320
+    Height = 25
+    Top = 519
+    Width = 94
+    AutoSize = True
+    Caption = 'Execute filter'
+    OnClick = btnFilterClick
+    TabOrder = 2
+  end
+  object btnResetFilter: TButton
+    AnchorSideLeft.Control = btnFilter
+    AnchorSideLeft.Side = asrBottom
+    AnchorSideTop.Control = btnFilter
+    Left = 422
+    Height = 25
+    Top = 519
+    Width = 75
+    BorderSpacing.Left = 8
+    Caption = 'Reset filter'
+    OnClick = btnResetFilterClick
+    TabOrder = 3
+  end
+  object JvGridFilter: TJvGridFilter
+    Grid = StringGrid
+    left = 264
+    top = 456
+  end
+end

components/jvcllaz/examples/JvGridFilter/main.pas

@@ -0,0 +1,52 @@
+unit main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Grids, StdCtrls,
+  JvGridFilter;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    btnFilter: TButton;
+    btnResetFilter: TButton;
+    edFilter: TEdit;
+    JvGridFilter: TJvGridFilter;
+    lblSomeFamousPeople: TLabel;
+    Label2: TLabel;
+    lblFilter: TLabel;
+    StringGrid: TStringGrid;
+    procedure btnFilterClick(Sender: TObject);
+    procedure btnResetFilterClick(Sender: TObject);
+  private
+
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.btnFilterClick(Sender: TObject);
+begin
+  JvGridFilter.Filter(edFilter.Text);
+end;
+
+procedure TForm1.btnResetFilterClick(Sender: TObject);
+begin
+  JvGridFilter.ShowRows;
+end;
+
+end.
+

components/jvcllaz/packages/jvjanslazr.lpk

@@ -17,7 +17,7 @@
 - Simulation components"/>
     <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
     <Version Major="1" Release="6"/>
-    <Files Count="12">
+    <Files Count="13">
       <Item1>
         <Filename Value="..\run\JvJans\jvyeargrid.pas"/>
         <UnitName Value="JvYearGrid"/>
@@ -66,6 +66,10 @@
         <Filename Value="..\run\JvJans\jvjantoggle.pas"/>
         <UnitName Value="JvJanToggle"/>
       </Item12>
+      <Item13>
+        <Filename Value="..\run\JvJans\jvgridfilter.pas"/>
+        <UnitName Value="JvGridFilter"/>
+      </Item13>
     </Files>
     <RequiredPkgs Count="1">
       <Item1>

components/jvcllaz/run/JvJans/jvgridfilter.pas

@@ -0,0 +1,245 @@
+{-----------------------------------------------------------------------------
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+http://www.mozilla.org/MPL/MPL-1.1.html
+
+Software distributed under the License is distributed on an "AS IS" basis,
+WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
+the specific language governing rights and limitations under the License.
+
+The Original Code is: JvGridFilter.PAS, released on 2002-06-15.
+
+The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]
+Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven.
+All Rights Reserved.
+
+Contributor(s): Robert Love [rlove att slcdug dott org].
+
+You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
+located at http://jvcl.delphi-jedi.org
+
+Known Issues:
+  When Position 0 you can not click on the far left of the button to move.
+  When Position 100 you can not click on the far right of the button to move.
+
+-----------------------------------------------------------------------------}
+// $Id$
+
+unit JvGridFilter;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  //Windows, Messages, 
+  Graphics, Controls, Forms, Grids,
+  SysUtils, Classes;
+
+type
+  TJvGridFilter = class(TComponent)
+  private
+    FGrid: TStringGrid;
+    FGridRowFilter: TList;
+    procedure ApplyFilter;
+    function ParseFilter(const AFilter: string): Boolean;
+    procedure SetGrid(const Value: TStringGrid);
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Filter(const AFilter: string);
+    procedure ShowRows;
+  published
+    property Grid: TStringGrid read FGrid write SetGrid;
+  end;
+
+implementation
+
+uses
+  JvConsts;
+
+type
+  TGridFilterFunc = function(const FieldValue, FilterValue: string): Boolean;
+
+  PGridFieldFilter = ^TGridFieldFilter;
+  TGridFieldFilter = record
+    FilterFunc: TGridFilterFunc;
+    FilterField: Integer;
+    FilterValue: string;
+  end;
+
+function FilterEQ(const FieldValue, FilterValue: string): Boolean;
+begin
+  Result := FieldValue = FilterValue;
+end;
+
+function FilterNE(const FieldValue, FilterValue: string): Boolean;
+begin
+  Result := FieldValue <> FilterValue;
+end;
+
+function FilterGT(const FieldValue, FilterValue: string): Boolean;
+begin
+  Result := FieldValue > FilterValue;
+end;
+
+function FilterLT(const FieldValue, FilterValue: string): Boolean;
+begin
+  Result := FieldValue < FilterValue;
+end;
+
+function FilterLIKE(const FieldValue, FilterValue: string): Boolean;
+begin
+  Result := Pos(LowerCase(FilterValue), LowerCase(FieldValue)) > 0;
+end;
+
+constructor TJvGridFilter.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FGridRowFilter := TList.Create;
+end;
+
+destructor TJvGridFilter.Destroy;
+var
+  I: Integer;
+  Filt: PGridFieldFilter;
+begin
+  for I := 0 to FGridRowFilter.Count-1 do
+  begin
+    Filt := PGridFieldFilter(FGridRowFilter[I]);
+    Dispose(Filt);
+  end;
+  FGridRowFilter.Free;
+  inherited Destroy;
+end;
+
+function TJvGridFilter.ParseFilter(const AFilter: string): Boolean;
+var
+  Op, S: string;
+  Func: TGridFilterFunc = nil;
+  FieldNr, I, P: Integer;
+  FieldName, FilterValue: string;
+  Filt: PGridFieldFilter;
+begin
+  Result := False;
+  for I := 0 to FGridRowFilter.Count-1 do
+  begin
+    Filt := PGridFieldFilter(FGridRowFilter[I]);
+    Dispose(Filt);
+  end;
+  FGridRowFilter.Clear;
+
+  S := Trim(AFilter);
+  if S = '' then
+    Exit;
+  // parse field name
+  repeat
+    P := Pos('[', S);
+
+    if P = 0 then
+      Exit;
+    S := Copy(S, P + 1, Length(S));
+    P := Pos(']', S);
+    if P = 0 then
+      Exit;
+    FieldName := Copy(S, 1, P - 1);
+    S := Trim(Copy(S, P + 1, Length(S)));
+    if FieldName = '' then
+      Exit;
+    // find fieldnumber
+    FieldNr := 0;
+    for I := 1 to Grid.ColCount - 1 do
+      if Grid.Cells[I, 0] = FieldName then
+      begin
+        FieldNr := I;
+        Break;
+      end;
+    if FieldNr = 0 then
+      Exit;
+    // we have the field number, now check operand
+    P := Pos('"', S); // " marks the beginning of the filter value
+    if P = 0 then
+      Exit;
+    Op := LowerCase(Trim(Copy(S, 1, P - 1)));
+    S := Copy(S, P + 1, Length(S));
+    P := Pos('"', S); // find the end of the FilterValue
+    if P = 0 then
+      Exit;
+    FilterValue := Copy(S, 1, P - 1);
+    S := Trim(Copy(S, P + 1, Length(S)));
+//    Func := nil;
+    if Op = '=' then
+      Func := @FilterEQ
+    else
+    if Op = '<>' then
+      Func := @FilterNE
+    else
+    if Op = '>' then
+      Func := @FilterGT
+    else
+    if Op = '<' then
+      Func := @FilterLT
+    else
+    if Op = 'like' then
+      Func := @FilterLIKE
+    else
+      Exit;
+
+    New(Filt);
+    Filt^.FilterFunc := Func;
+    Filt^.FilterField := FieldNr;
+    Filt^.FilterValue := FilterValue;
+    FGridRowFilter.Add(Filt);
+  until S = '';
+  Result := True;
+end;
+
+procedure TJvGridFilter.ApplyFilter;
+var
+  Row, I: Integer;
+  FieldValue: string;
+  CanHide: Boolean;
+  Filt: PGridFieldFilter;
+begin
+  if FGridRowFilter.Count = 0 then
+    Exit;
+  for Row := 1 to Grid.RowCount - 1 do
+  begin
+    CanHide := False;
+    for I := 0 to FGridRowFilter.Count - 1 do
+    begin
+      Filt := FGridRowFilter[I];
+      FieldValue := Grid.Cells[Filt^.FilterField, Row];
+      if not Filt^.FilterFunc(FieldValue, Filt^.FilterValue) then
+      begin
+        CanHide := True;
+        Break;
+      end;
+    end;
+    if CanHide then
+      Grid.RowHeights[Row] := 0;
+  end;
+end;
+
+procedure TJvGridFilter.Filter(const AFilter: string);
+begin
+  if Assigned(FGrid) then
+    if ParseFilter(AFilter) then
+      ApplyFilter;
+end;
+
+procedure TJvGridFilter.SetGrid(const Value: TStringGrid);
+begin
+  FGrid := Value;
+end;
+
+procedure TJvGridFilter.ShowRows;
+var
+  Row: Integer;
+begin
+  for Row := 0 to Grid.RowCount - 1 do
+    Grid.RowHeights[Row] := Grid.DefaultRowHeight;
+end;
+
+end.