Browse Source

Integrate: Sphere10 PascalFramework (latest)

Herman Schoenfeld 7 years ago
parent
commit
d65a2bf3c0

+ 22 - 14
PascalCoinWallet.lpi

@@ -38,7 +38,7 @@
         <PackageName Value="LCL"/>
         <PackageName Value="LCL"/>
       </Item1>
       </Item1>
     </RequiredPackages>
     </RequiredPackages>
-    <Units Count="67">
+    <Units Count="69">
       <Unit0>
       <Unit0>
         <Filename Value="PascalCoinWallet.dpr"/>
         <Filename Value="PascalCoinWallet.dpr"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
@@ -330,46 +330,54 @@
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
       </Unit58>
       </Unit58>
       <Unit59>
       <Unit59>
-        <Filename Value="Units\Utils\UWizard.lfm"/>
+        <Filename Value="Units\Forms\UFRMAccountInfo.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
+        <HasResources Value="True"/>
       </Unit59>
       </Unit59>
       <Unit60>
       <Unit60>
-        <Filename Value="Units\Forms\UFRMAccountInfo.pas"/>
+        <Filename Value="Units\Forms\UFRMMemoText.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <HasResources Value="True"/>
         <HasResources Value="True"/>
       </Unit60>
       </Unit60>
       <Unit61>
       <Unit61>
-        <Filename Value="Units\Forms\UFRMMemoText.pas"/>
+        <Filename Value="Units\Forms\UFRMSaleAccounts.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
-        <HasResources Value="True"/>
       </Unit61>
       </Unit61>
       <Unit62>
       <Unit62>
-        <Filename Value="Units\Forms\UFRMSaleAccounts.pas"/>
+        <Filename Value="Units\Forms\UFRMWalletKeys2.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
       </Unit62>
       </Unit62>
       <Unit63>
       <Unit63>
-        <Filename Value="Units\Forms\UFRMWalletKeys2.pas"/>
-        <IsPartOfProject Value="True"/>
-      </Unit63>
-      <Unit64>
         <Filename Value="Units\Forms\UCTRLBanner.pas"/>
         <Filename Value="Units\Forms\UCTRLBanner.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="CTRLBanner"/>
         <ComponentName Value="CTRLBanner"/>
         <HasResources Value="True"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
         <ResourceBaseClass Value="Form"/>
-      </Unit64>
-      <Unit65>
+      </Unit63>
+      <Unit64>
         <Filename Value="Units\Forms\UFRMMainForm.pas"/>
         <Filename Value="Units\Forms\UFRMMainForm.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="FRMMainForm"/>
         <ComponentName Value="FRMMainForm"/>
         <HasResources Value="True"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
         <ResourceBaseClass Value="Form"/>
-      </Unit65>
-      <Unit66>
+      </Unit64>
+      <Unit65>
         <Filename Value="Units\Forms\UFRMSyncronizationForm.pas"/>
         <Filename Value="Units\Forms\UFRMSyncronizationForm.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <HasResources Value="True"/>
         <HasResources Value="True"/>
+      </Unit65>
+      <Unit66>
+        <Filename Value="Units\Utils\UAutoScope.pas"/>
+        <IsPartOfProject Value="True"/>
       </Unit66>
       </Unit66>
+      <Unit67>
+        <Filename Value="Units\Utils\UVisualGrid.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit67>
+      <Unit68>
+        <Filename Value="Units\Utils\UVisualGrid.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit68>
     </Units>
     </Units>
   </ProjectOptions>
   </ProjectOptions>
   <CompilerOptions>
   <CompilerOptions>

+ 0 - 1
Units/Forms/UFRMSyncronizationForm.pas

@@ -186,7 +186,6 @@ begin
   TUserInterface.ShowWallet;
   TUserInterface.ShowWallet;
 end;
 end;
 
 
-
 {%endregion}
 {%endregion}
 
 
 end.
 end.

+ 398 - 0
Units/Utils/UAutoScope.pas

@@ -0,0 +1,398 @@
+{**********************************************************************
+    ● Copyright(c) 2017 Dmitriy Pomerantsev <[email protected]>
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+    https://github.com/pda0/AutoScope
+    Ver 1.0.2
+    + Added some new tests.
+    + Added `paranoia' mode (disabled by default). Define WITH_PARANOIA if you
+      want. TScoped will place a reference to itself in an external variable to
+      prevent too smart compiler from removing the record prematurely.
+    Ver 1.0.1
+    * Now cleanup process is protected from destructor's exceptions.
+      It may not work temporarily in llvm-based compiler because of the bug
+      https://quality.embarcadero.com/browse/RSP-18031
+    Ver 1.0.0
+    * Initial release.
+ **********************************************************************}
+unit AutoScope;
+{$IFDEF FPC}
+  {$CODEPAGE UTF8}
+  {$MODE DELPHI}{$H+}
+  {$MODESWITCH ADVANCEDRECORDS}
+{$ENDIF}
+
+interface
+
+{$IFDEF FPC}
+  { #%^$! delphi compiller!!! }
+  {$IFDEF VER1}{$ERROR Too old compiller.}{$ENDIF}
+  {$IFDEF VER2}
+    {$IFDEF VER2_0}{$ERROR Too old compiller.}{$ENDIF}
+    {$IFDEF VER2_2}{$ERROR Too old compiller.}{$ENDIF}
+    {$IFDEF VER2_4}{$ERROR Too old compiller.}{$ENDIF}
+  {$ENDIF}
+  {$DEFINE USE_INTERFACE}
+  {$IFNDEF VER_3_0}
+    {$IFDEF USE_INTERFACE}{$UNDEF USE_INTERFACE}{$ENDIF}
+    {$DEFINE USE_OPERATORS}
+  {$ENDIF}
+{$ELSE}
+  {$DEFINE USE_INTERFACE}
+{$ENDIF}
+
+type
+  TScopedPtr = record
+    Ptr: Pointer;
+    {$IFNDEF NEXTGEN}
+    IsObject: Boolean;
+    {$ENDIF}
+  end;
+  {$IFDEF USE_INTERFACE}
+    {$DEFINE NEED_SCOPED_PTR}
+  {$ENDIF}
+  {$IFDEF WITH_PARANOIA}
+    {$IFNDEF NEED_SCOPED_PTR}{$DEFINE NEED_SCOPED_PTR}{$ENDIF}
+  {$ENDIF}
+
+  {$IFDEF NEED_SCOPED_PTR}
+  PScoped = ^TScoped;
+  {$ENDIF}
+
+  /// <summary>The automatic memory deallocation object.</summary>
+  /// <remarks>
+  ///   TScoped automatically free memory when it's instance runs out of scope.
+  ///   Do not declare it as const or threadvar variable.
+  /// </remarks>
+  /// <threadsafety static="false" instance="false" />
+  TScoped = record
+  {$IFDEF USE_INTERFACE}
+  private type
+    TScopedGuardian = class(TInterfacedObject)
+    private
+      FScopedRec: PScoped;
+    public
+      constructor Create(ScopedRec: PScoped);
+      destructor Destroy; override;
+    end;
+  {$ENDIF}
+  private
+    {$IFDEF USE_INTERFACE}
+    FGuardian: IInterface;
+    {$ENDIF}
+    FPointers: array of TScopedPtr;
+    FLastIndex: {$IFDEF FPC}TDynArrayIndex{$ELSE}Integer{$ENDIF};
+    {$IFDEF USE_OPERATORS}
+    class operator Initialize(var AScope: TScoped);
+    class operator Finalize(var AScope: TScoped);
+    {$ENDIF}
+    {$IFDEF USE_INTERFACE}
+    class procedure Initialize(var AScope: TScoped); static;
+    class procedure Finalize(var AScope: TScoped); static;
+    {$ENDIF}
+    procedure RegisterPointer(Ptr: Pointer; IsObject: Boolean);
+    procedure UnregisterPointer(Ptr: Pointer);
+  public
+    /// <summary>Adds the object to the automatic deletion list.</summary>
+    /// <param name="AnObject">A class instance for automatic deletion.</param>
+    /// <returns><c>AnObject</c> value as is.</returns>
+    /// <remarks>
+    ///   <para>
+    ///     When an instance of <c>TScoped</c> runs out of a scope, all objects
+    ///     will be deleted in the reverse order to the addition.
+    ///   </para>
+    ///   <para>
+    ///     Does nothing in NextGen mode due of ARC.
+    ///   </para>
+    /// </remarks>
+    function AddObject(const AnObject: TObject): TObject;
+    /// <summary>Removes the object from the automatic deletion list.</summary>
+    /// <param name="AnObject">A class instance for removal from list.</param>
+    /// <remarks>
+    ///   <para>
+    ///     After calling this method, you have to remove the class instance
+    ///     by yourself.
+    ///   </para>
+    ///   <para>
+    ///     This method have O(n) complexity because it's not a primary case
+    ///     scenario of <c>TScoped</c> usage. If you want to create and destroy
+    ///     some class often, please use normal methods like
+    ///     <c>Create</c>/<c>Free</c>.
+    ///   </para>
+    ///   <para>
+    ///     Does nothing in NextGen mode due of ARC.
+    ///   </para>
+    /// </remarks>
+    procedure RemoveObject(const AnObject: TObject);
+    /// <summary>Allocates an automatically releasing memory block.</summary>
+    /// <param name="P">Returns a pointer to allocated memory block.</param>
+    /// <param name="Size">Is a size in bytes of required memory.</param>
+    /// <remarks>
+    ///   When an instance of <c>TScoped</c> runs out of a scope, all memory
+    ///   block will be released in the reverse order to the allocation.
+    /// </remarks>
+    procedure GetMem(out P: Pointer; Size: {$IFDEF FPC}PtrUInt{$ELSE}Integer{$ENDIF});
+    /// <summary>Releases previously allocated memory block.</summary>
+    /// <param name="P">
+    ///   Is a pointer to memory block, allocated by
+    ///   <see cref="TScoped.GetMem"/> or added by <see cref="TScoped.AddMem"/>.
+    /// </param>
+    /// <remarks>
+    ///   This method have O(n) complexity because it's not a primary case
+    ///   scenario of <c>TScoped</c> usage. If you want to allocate and release
+    ///   memory often, please use normal functions like
+    ///   <c>System.GetMem</c>/<c>System.FreeMem</c>.
+    /// </remarks>
+    procedure FreeMem(var P: Pointer);
+    /// <summary>Adds a memory block to the automatically releasing list.</summary>
+    /// <param name="P">
+    ///   Is a pointer to memory block, allocated by somewhere else.
+    /// </param>
+    /// <remarks>
+    ///   <para>
+    ///     When an instance of <c>TScoped</c> runs out of a scope, all memory
+    ///     block will be released in the reverse order to the addition.
+    ///   </para>
+    ///   <para>
+    ///     Do not try to add pointer to memory block, allocated by
+    ///     <see cref="TScoped.GetMem"/>, do not add some pointer more than one
+    ///     time.
+    ///   </para>
+    ///   <para>
+    ///     Use only pointer which have to be releasev via
+    ///     <see cref="System.FreeMem"/>. Do not use typed pointers, allocated
+    ///     by <see cref="New"/>. <c>TScoped</c> is incompatible with typed
+    ///     pointers.
+    ///   </para>
+    /// </remarks>
+    procedure AddMem(const P: Pointer);
+    /// <summary>Reallocates a memory block.</summary>
+    /// <param name="P">
+    ///   Is a pointer to memory block, allocated by
+    ///   <see cref="TScoped.GetMem"/> or added by <see cref="TScoped.AddMem"/>.
+    /// </param>
+    /// <remarks>
+    ///   This method have O(n) complexity because it's not a primary case
+    ///   scenario of <c>TScoped</c> usage. If you want to allocate and release
+    ///   memory often, please use normal functions like
+    ///   <c>System.GetMem</c>/<c>System.FreeMem</c>.
+    /// </remarks>
+    procedure ReallocMem(var P: Pointer; Size: {$IFDEF FPC}PtrUInt{$ELSE}Integer{$ENDIF});
+    /// <summary>Removes a memory block from the automatic deletion list.</summary>
+    /// <param name="P">
+    ///   Is a pointer to memory block, allocated by
+    ///   <see cref="TScoped.GetMem"/> or added by <see cref="TScoped.AddMem"/>.
+    /// </param>
+    /// <remarks>
+    ///   <para>
+    ///     After calling this method, you have to release the memory block
+    ///     by yourself.
+    ///   </para>
+    ///   <para>
+    ///     This method have O(n) complexity because it's not a primary case
+    ///     scenario of <c>TScoped</c> usage. If you want to allocate and
+    ///     release memory often, please use normal functions like
+    ///     <c>System.GetMem</c>/<c>System.FreeMem</c>.
+    ///   </para>
+    /// </remarks>
+    procedure RemoveMem(const P: Pointer);
+    /// <summary>A syntax sugar for the AddObject method.</summary>
+    property Objects[const AnObject: TObject]: TObject read AddObject; default;
+  end;
+
+{$IFDEF WITH_PARANOIA}
+var
+  __no_use_ptr: PScoped;
+{$ENDIF}
+
+implementation
+
+{ TScoped }
+
+{$IFDEF USE_INTERFACE}
+constructor TScoped.TScopedGuardian.Create(ScopedRec: PScoped);
+begin
+  FScopedRec := ScopedRec;
+  TScoped.Initialize(FScopedRec^);
+end;
+
+destructor TScoped.TScopedGuardian.Destroy;
+begin
+  inherited;
+  try
+    TScoped.Finalize(FScopedRec^);
+  except
+    FreeInstance;
+    raise;
+  end;
+end;
+{$ENDIF}
+
+{$IFDEF USE_OPERATORS}
+class operator TScoped.Initialize(var AScope: TScoped);
+{$ENDIF}
+{$IFDEF USE_INTERFACE}
+class procedure TScoped.Initialize(var AScope: TScoped);
+{$ENDIF}
+begin
+  {$IFDEF WITH_PARANOIA}
+   __no_use_ptr := @AScope;
+  {$ENDIF}
+  AScope.FLastIndex := -1;
+  SetLength(AScope.FPointers, 16);
+end;
+
+{$IFDEF USE_OPERATORS}
+class operator TScoped.Finalize(var AScope: TScoped);
+{$ENDIF}
+{$IFDEF USE_INTERFACE}
+class procedure TScoped.Finalize(var AScope: TScoped);
+{$ENDIF}
+var
+  {$IFNDEF NEXTGEN}
+  FirstException: Pointer;
+  {$ENDIF}
+  i: {$IFDEF FPC}TDynArrayIndex{$ELSE}Integer{$ENDIF};
+begin
+  FirstException := nil;
+
+  for i := AScope.FLastIndex downto 0 do
+  {$IFNDEF NEXTGEN}
+  try
+    if AScope.FPointers[i].IsObject then
+      TObject(AScope.FPointers[i].Ptr).Free
+    else begin
+  {$ENDIF}
+      if Assigned(AScope.FPointers[i].Ptr) then
+        System.FreeMem(AScope.FPointers[i].Ptr);
+  {$IFNDEF NEXTGEN}
+    end;
+  except
+    if not Assigned(FirstException) then
+      FirstException := AcquireExceptionObject;
+  end;
+
+  if Assigned(FirstException) then
+  begin
+    SetLength(AScope.FPointers, 0);
+    raise TObject(FirstException);
+  end;
+  {$ENDIF}
+end;
+
+{ TScoped is for small amount of local objects or memory blocks, which will be
+  created at start of a routine, deleted at the end, and very rarely at the
+  middle of the execution. Therefore there is no need for complex methods of
+  low `big O' complexity. The simplicity and fast of primary case scenario speed
+  is preferred. }
+
+procedure TScoped.RegisterPointer(Ptr: Pointer; IsObject: Boolean);
+begin
+  if FLastIndex > High(FPointers) then
+    SetLength(FPointers, Length(FPointers) * 2);
+
+  Inc(FLastIndex);
+  FPointers[FLastIndex].Ptr := Ptr;
+  {$IFNDEF NEXTGEN}
+  FPointers[FLastIndex].IsObject := IsObject;
+  {$ENDIF}
+end;
+
+procedure TScoped.UnregisterPointer(Ptr: Pointer);
+var
+  i: {$IFDEF FPC}TDynArrayIndex{$ELSE}Integer{$ENDIF};
+begin
+  for i := 0 to FLastIndex do
+    if FPointers[i].Ptr = Ptr then
+    begin
+      FPointers[i].Ptr := nil;
+      Break;
+    end;
+end;
+
+function TScoped.AddObject(const AnObject: TObject): TObject;
+begin
+  {$IFNDEF NEXTGEN}
+    {$IFDEF USE_INTERFACE}
+    if not Assigned(FGuardian) then
+      FGuardian := TScopedGuardian.Create(@Self);
+    {$ENDIF}
+
+  RegisterPointer(Pointer(AnObject), True);
+  {$ENDIF}
+  Result := AnObject;
+end;
+
+procedure TScoped.RemoveObject(const AnObject: TObject);
+begin
+  {$IFNDEF NEXTGEN}
+    {$IFDEF USE_INTERFACE}
+    if not Assigned(FGuardian) then
+      FGuardian := TScopedGuardian.Create(@Self);
+    {$ENDIF}
+
+  UnregisterPointer(Pointer(AnObject));
+  {$ENDIF}
+end;
+
+procedure TScoped.GetMem(out P: Pointer; Size:
+  {$IFDEF FPC}PtrUInt{$ELSE}Integer{$ENDIF});
+begin
+  System.GetMem(P, Size);
+  AddMem(P);
+end;
+
+procedure TScoped.FreeMem(var P: Pointer);
+begin
+  {$IFDEF USE_INTERFACE}
+  if not Assigned(FGuardian) then
+    FGuardian := TScopedGuardian.Create(@Self);
+  {$ENDIF}
+
+  UnregisterPointer(P);
+  System.FreeMem(P);
+end;
+
+procedure TScoped.AddMem(const P: Pointer);
+begin
+  {$IFDEF USE_INTERFACE}
+  if not Assigned(FGuardian) then
+    FGuardian := TScopedGuardian.Create(@Self);
+  {$ENDIF}
+
+  RegisterPointer(P, False);
+end;
+
+procedure TScoped.ReallocMem(var P: Pointer; Size:
+  {$IFDEF FPC}PtrUInt{$ELSE}Integer{$ENDIF});
+var
+  i: {$IFDEF FPC}TDynArrayIndex{$ELSE}Integer{$ENDIF};
+begin
+  {$IFDEF USE_INTERFACE}
+  if not Assigned(FGuardian) then
+    FGuardian := TScopedGuardian.Create(@Self);
+  {$ENDIF}
+
+  for i := FLastIndex downto 0 do
+    if not FPointers[i].IsObject and (FPointers[i].Ptr = P) then
+    begin
+      System.ReallocMem(FPointers[i].Ptr, Size);
+      P := FPointers[i].Ptr;
+      Break;
+    end;
+end;
+
+procedure TScoped.RemoveMem(const P: Pointer);
+begin
+  {$IFDEF USE_INTERFACE}
+  if not Assigned(FGuardian) then
+    FGuardian := TScopedGuardian.Create(@Self);
+  {$ENDIF}
+
+  UnregisterPointer(P);
+end;
+
+end.

+ 528 - 14
Units/Utils/UCommon.pas

@@ -1,25 +1,27 @@
 {
 {
   Copyright (c) 2017 Sphere 10 Software
   Copyright (c) 2017 Sphere 10 Software
 
 
-  Author: Herman Schoenfeld <[email protected]>
+  Common unit usable across all tiers.
 
 
   Distributed under the MIT software license, see the accompanying file LICENSE
   Distributed under the MIT software license, see the accompanying file LICENSE
   or visit http://www.opensource.org/licenses/mit-license.php.
   or visit http://www.opensource.org/licenses/mit-license.php.
 
 
-  Additional Credits:
-    <contributors add yourselves here>
+  Acknowledgements:
+    Herman Schoenfeld
+    Maciej Izak (hnb)
 }
 }
 
 
 unit UCommon;
 unit UCommon;
 
 
-{$mode delphi}
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
 
 
 interface
 interface
 
 
-{$I ./../PascalCoin/config.inc}
-
 uses
 uses
-  Classes, SysUtils, Generics.Collections, Generics.Defaults;
+  Classes, SysUtils, Generics.Collections, Generics.Defaults,
+  Variants, LazUTF8;
 
 
 { GLOBAL FUNCTIONS }
 { GLOBAL FUNCTIONS }
 
 
@@ -39,6 +41,7 @@ function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: string)
 function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: TObject): TObject; overload;
 function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: TObject): TObject; overload;
 function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: variant): variant; overload;
 function IIF(const ACondition: Boolean; const ATrueResult, AFalseResult: variant): variant; overload;
 
 
+{ Clip Value }
 function ClipValue( AValue, MinValue, MaxValue: Integer) : Integer;
 function ClipValue( AValue, MinValue, MaxValue: Integer) : Integer;
 
 
 { DateTime functions }
 { DateTime functions }
@@ -96,8 +99,93 @@ type
     procedure Invoke(sender : TObject);
     procedure Invoke(sender : TObject);
   end;
   end;
 
 
+  { TTable types }
+
+  TTableColumns = TArray<utf8string>;
+  PTableColumns = ^TTableColumns;
+  ETableRow = class(Exception);
+
+  { TTableRow }
+
+  TTableRow = class(TInvokeableVariantType)
+  private
+    class constructor Create;
+    class destructor Destroy;
+  protected type
+    TColumnMapToIndex = TDictionary<utf8string, Integer>;
+    TColumnsDictionary = TObjectDictionary<PTableColumns, TColumnMapToIndex>;
+  protected class var
+    FColumns: TColumnsDictionary;
+  protected
+    class function MapColumns(AColumns: PTableColumns): TColumnMapToIndex;
+  public
+    function GetProperty(var Dest: TVarData; const V: TVarData; const Name: string): Boolean; override;
+    function SetProperty(var V: TVarData; const Name: string; const Value: TVarData): Boolean; override;
+    procedure Clear(var V: TVarData); override;
+    procedure Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); override;
+    function DoFunction(var Dest: TVarData; const V: TVarData; const Name: string; const Arguments: TVarDataArray): Boolean; override;
+    class function New(AColumns: PTableColumns): Variant;
+  end;
+
+  TTableRowData = packed record
+  public
+    vtype: tvartype;
+  private
+    vfiller1 : word;
+    vfiller2: int32;
+  public
+    vcolumnmap: TTableRow.TColumnMapToIndex;
+    vvalues: TArray<Variant>;
+  end;
+
+  TExpressionKind = (ekUnknown, ekText, ekNum, ekSet);
+  TTextMatchKind = (tmkUnknown, tmkMatchTextExact, tmkMatchTextBeginning, tmkMatchTextEnd, tmkMatchTextAnywhere);
+  TNumericComparisionKind = (nckUnknown, nckNumericEQ, nckNumericLT, nckNumericLTE, nckNumericGT, nckNumericGTE);
+  TSetKind = (skUnknown, skNumericBetweenInclusive, skNumericBetweenExclusive);
+
+  TExpressionRecord = record
+    Values: array of utf8string;
+  case Kind: TExpressionKind of
+    ekUnknown: ();
+    ekText: (TextMatchKind: TTextMatchKind);
+    ekNum: (NumericComparisionKind: TNumericComparisionKind);
+    ekSet: (SetKind: TSetKind);
+  end;
+
+  ESearchExpressionParserException = class(Exception);
+
+  { TSearchExpressionService }
+
+  TSearchExpressionService = class
+  public
+    class procedure Parse(const AExpression: utf8string; const AExpressionKind: TExpressionKind; out AExpressionRecord: TExpressionRecord); overload;
+    class function Parse(const AExpression: utf8string): TExpressionRecord; overload;
+  end;
+
+resourcestring
+  sNotImplemented = 'Not implemented';
+  sInvalidParameter_OutOfBounds = 'Invalid Parameter: %s out of bounds';
+  sAColumnsCantBeNil = 'AColumns can''t be nil!';
+  sTooManyValues = 'Too many values';
+  sInvalidUTF8String = 'Invalid UTF8 string';
+  sBadNumericExpression = 'Bad numeric expression';
+  sUnexpectedNumberFormat = 'Unexpected number format';
+  sBadSyntaxForEscapeCharacter = 'Bad syntax for escape character "\"';
+  sUnexpectedCharInExpression = 'Unexpected char in expression';
+  sInvaildExpression_CharDetectedAfterClosingBracket = 'Invaild expression (char detected after closing bracket)';
+  sUnexpectedTokenFound = 'Unexpected token found : "%s"';
+  sUnexpectedStringLiteralInExpression = 'Unexpected string literal in expression';
+  sBadlyClosedBetweenExpression = 'Badly closed "between" expression';
+  sMissingNumberInExpression = 'Missing number in expression';
+  sUnexpectedOccurrenceOf_Found = 'Unexpected occurrence of "%s" found';
+  sBadBetweenExpression_UnexpectedToken = 'Bad "between" expression. Unexpected "%s"';
+  sExpressionError_NoValue = 'Expression error (no value)';
+
 implementation
 implementation
 
 
+var
+  TableRowType: TTableRow = nil;
+
 {%region Global functions %}
 {%region Global functions %}
 
 
 function String2Hex(const Buffer: AnsiString): AnsiString;
 function String2Hex(const Buffer: AnsiString): AnsiString;
@@ -109,6 +197,7 @@ begin
     Result := LowerCase(Result + IntToHex(Ord(Buffer[n]), 2));
     Result := LowerCase(Result + IntToHex(Ord(Buffer[n]), 2));
 end;
 end;
 
 
+
 function BinStrComp(const Str1, Str2: AnsiString): integer;
 function BinStrComp(const Str1, Str2: AnsiString): integer;
 var Str1Len, Str2Len, i : Integer;
 var Str1Len, Str2Len, i : Integer;
 begin
 begin
@@ -199,7 +288,7 @@ begin
     Result := AFalseResult;
     Result := AFalseResult;
 end;
 end;
 
 
-{ Value Clipping }
+{ Clip Value }
 
 
 function ClipValue( AValue, MinValue, MaxValue: Integer) : Integer;
 function ClipValue( AValue, MinValue, MaxValue: Integer) : Integer;
 begin
 begin
@@ -220,7 +309,7 @@ end;
 
 
 function UtcTimeStamp : AnsiString;
 function UtcTimeStamp : AnsiString;
 begin
 begin
-  raise Exception.Create('Not implemented');
+  raise Exception.Create(sNotImplemented);
 end;
 end;
 
 
 {%endregion}
 {%endregion}
@@ -336,7 +425,7 @@ end;
 class procedure TArrayTool<T>.InsertAt(var Values : TArray<T>; ItemIndex : SizeInt; const Item : T);
 class procedure TArrayTool<T>.InsertAt(var Values : TArray<T>; ItemIndex : SizeInt; const Item : T);
 var i : Integer;
 var i : Integer;
 begin
 begin
-  if (ItemIndex < Low(Values)) OR (ItemIndex > High(Values)) then Raise Exception.Create('Invalid Parameter: ItemIndex out of bounds');
+  if (ItemIndex < Low(Values)) OR (ItemIndex > High(Values)) then Raise Exception.CreateFmt(sInvalidParameter_OutOfBounds, ['ItemIndex']);
   SetLength(Values, Length(Values)+1);
   SetLength(Values, Length(Values)+1);
   for i := High(Values)-1 downto ItemIndex do
   for i := High(Values)-1 downto ItemIndex do
     Values[i+1] := Values[i];
     Values[i+1] := Values[i];
@@ -348,8 +437,8 @@ var temp : T; len, recSize : SizeInt; itemSize : SizeInt;
 begin
 begin
   len := Length(Values);
   len := Length(Values);
   recSize := SizeOf(T);
   recSize := SizeOf(T);
-  if (Item1Index < 0) OR (Item1Index > len) then Raise Exception.Create('Invalid Parameter: Item1Index out of bounds');
-  if (Item2Index < 0) OR (Item2Index > len) then Raise Exception.Create('Invalid Parameter: Item2Index out of bounds');
+  if (Item1Index < 0) OR (Item1Index > len) then Raise Exception.CreateFmt(sInvalidParameter_OutOfBounds, ['Item1Index']);
+  if (Item2Index < 0) OR (Item2Index > len) then Raise Exception.CreateFmt(sInvalidParameter_OutOfBounds, ['Item2Index']);
   temp := Values[Item1Index];
   temp := Values[Item1Index];
   Values[Item1Index] := Values[Item2Index];
   Values[Item1Index] := Values[Item2Index];
   Values[Item2Index] := temp;
   Values[Item2Index] := temp;
@@ -358,8 +447,8 @@ end;
 class procedure TArrayTool<T>.MoveItem(var Values : array of T; FromIndex, ToIndex : SizeInt);
 class procedure TArrayTool<T>.MoveItem(var Values : array of T; FromIndex, ToIndex : SizeInt);
 var i : Integer; item : T;
 var i : Integer; item : T;
 begin
 begin
-  if (FromIndex < Low(Values)) OR (FromIndex > High(Values)) then Raise Exception.Create('Invalid Parameter: FromIndex out of bounds');
-  if (ToIndex < Low(Values)) OR (ToIndex > High(Values)) then Raise Exception.Create('Invalid Parameter: ToIndex out of bounds');
+  if (FromIndex < Low(Values)) OR (FromIndex > High(Values)) then Raise Exception.CreateFmt(sInvalidParameter_OutOfBounds, ['FromIndex']);
+  if (ToIndex < Low(Values)) OR (ToIndex > High(Values)) then Raise Exception.CreateFmt(sInvalidParameter_OutOfBounds, ['ToIndex']);
 
 
   item := Values[FromIndex];
   item := Values[FromIndex];
   if FromIndex < ToIndex then begin
   if FromIndex < ToIndex then begin
@@ -414,6 +503,98 @@ end;
 
 
 {%endregion}
 {%endregion}
 
 
+{ TTableRow }
+
+class constructor TTableRow.Create;
+begin
+  FColumns := TColumnsDictionary.Create([doOwnsValues]);
+end;
+
+class destructor TTableRow.Destroy;
+begin
+  FColumns.Free;
+end;
+
+class function TTableRow.MapColumns(AColumns: PTableColumns): TColumnMapToIndex;
+var
+  i: Integer;
+begin
+  Result := TColumnMapToIndex.Create;
+  for i := 0 to High(AColumns^) do
+    Result.Add(AColumns^[i], i);
+  FColumns.Add(AColumns, Result);
+end;
+
+function TTableRow.GetProperty(var Dest: TVarData;
+  const V: TVarData; const Name: string): Boolean;
+var
+  LRow: TTableRowData absolute V;
+begin
+  Variant(Dest) := LRow.vvalues[LRow.vcolumnmap[Name]];
+  Result := true;
+end;
+
+function TTableRow.SetProperty(var V: TVarData; const Name: string;
+  const Value: TVarData): Boolean;
+var
+  LRow: TTableRowData absolute V;
+begin
+  LRow.vvalues[LRow.vcolumnmap[Name]] := Variant(Value);
+  Result := true;
+end;
+
+procedure TTableRow.Clear(var V: TVarData);
+begin
+  Finalize(TTableRowData(V));
+  FillChar(V, SizeOf(V), #0);
+end;
+
+procedure TTableRow.Copy(var Dest: TVarData; const Source: TVarData;
+  const Indirect: Boolean);
+var
+  LDestRow: TTableRowData absolute Dest;
+  LSourceRow: TTableRowData absolute Source;
+begin
+  if Indirect then
+    SimplisticCopy(Dest,Source,true)
+  else
+  begin
+    VarClear(variant(Dest));
+    FillChar(LDestRow, SizeOf(LDestRow), #0);
+    LDestRow.vtype := LSourceRow.vtype;
+    LDestRow.vcolumnmap := LSourceRow.vcolumnmap;
+    LDestRow.vvalues := system.copy(TTableRowData(LSourceRow).vvalues);
+  end;
+end;
+
+function TTableRow.DoFunction(var Dest: TVarData; const V: TVarData;
+  const Name: string; const Arguments: TVarDataArray): Boolean;
+var
+  LRow: TTableRowData absolute V;
+begin
+  Result := (Name = '_') and (Length(Arguments)=1);
+  if Result then
+    Variant(Dest) := LRow.vvalues[Variant(Arguments[0])];
+end;
+
+class function TTableRow.New(AColumns: PTableColumns): Variant;
+var
+  LColumnMap: TColumnMapToIndex;
+begin
+  if not Assigned(AColumns) then
+    raise ETableRow.Create(sAColumnsCantBeNil);
+
+  VarClear(Result);
+  FillChar(Result, SizeOf(Result), #0);
+  TTableRowData(Result).vtype:=TableRowType.VarType;
+
+  if not FColumns.TryGetValue(AColumns, LColumnMap) then
+    LColumnMap := MapColumns(AColumns);
+
+  TTableRowData(Result).vcolumnmap:=LColumnMap;
+  SetLength(TTableRowData(Result).vvalues, Length(AColumns^));
+end;
+
 {%region TNotifyManyEventHelper}
 {%region TNotifyManyEventHelper}
 
 
 procedure TNotifyManyEventHelper.Add(listener : TNotifyEvent);
 procedure TNotifyManyEventHelper.Add(listener : TNotifyEvent);
@@ -437,5 +618,338 @@ end;
 
 
 {%endregion}
 {%endregion}
 
 
+{ TSearchExpressionService }
+
+class procedure TSearchExpressionService.Parse(const AExpression: utf8string;
+  const AExpressionKind: TExpressionKind; out
+  AExpressionRecord: TExpressionRecord);
+const
+  MAX_VALUES = 2;
+type
+  TToken = (tkNone, tkPercent, tkLess, tkGreater, tkEqual, tkLessOrEqual,
+    tkGreaterOrEqual, tkOpeningParenthesis, tkClosingParenthesis,
+    tkOpeningBracket, tkClosingBracket,  tkText, tkNum, tkComma);
+
+  TUTF8Char = record
+    Length: byte;
+    Char: array [0..3] of AnsiChar;
+  end;
+
+const
+  CONVERTABLE_TOKENS_TO_STR = [tkLess..tkClosingBracket, tkComma];
+  NUM_OPERATORS = [tkLess..tkGreaterOrEqual];
+
+  procedure GetChar(APos: PAnsiChar; out AChar: TUTF8Char);
+  begin
+    AChar.Length := UTF8CharacterLength(APos);
+
+    if AChar.Length >= 1 then AChar.Char[0] := APos[0];
+    if AChar.Length >= 2 then AChar.Char[1] := APos[1];
+    if AChar.Length >= 3 then AChar.Char[2] := APos[2];
+    if AChar.Length = 4 then AChar.Char[3] := APos[3];
+  end;
+
+  function TokenToStr(AToken: TToken): utf8string;
+  const
+    CONVERTER: array[TToken] of utf8string = (
+      'NONE', '%', '<', '>', '=', '<=', '>=', '(', ')', '[', ']', 'TEXT',
+      'NUMBER', ','
+    );
+  begin
+    Result := CONVERTER[AToken];
+  end;
+
+var
+  c, nc: PAnsiChar;
+  i: Integer;
+  LDot: boolean = false;
+  LChar: TUTF8Char;
+  LValueIdx: Integer = -1;
+  LValues: array[0..MAX_VALUES-1] of utf8string; // for now only 2 values for set "between"
+  LValue: PUTF8String;
+  LToken: TToken = tkNone;
+  LPrevToken: TToken = tkNone;
+  LExpression: utf8string;
+  LLastPercent: boolean = false;
+  LExpressionKind: TExpressionKind;
+
+  procedure NextValue;
+  begin
+    Inc(LValueIdx);
+    if LValueIdx > MAX_VALUES - 1 then
+      raise ESearchExpressionParserException.Create(sTooManyValues);
+    LValue := @LValues[LValueIdx];
+  end;
+
+  procedure EscapeSequence(AChar: Char);
+  begin
+    LToken := tkText;
+    LValue^ := LValue^ + AChar;
+    Inc(c);
+  end;
+
+begin
+  AExpressionRecord := Default(TExpressionRecord);
+  if AExpression = '' then
+    Exit;
+
+  LExpressionKind := AExpressionKind;
+  // more simple parsing loop
+  if AExpressionKind in [ekSet, ekNum] then
+    LExpression:=Trim(AExpression)
+  else
+    LExpression:=AExpression;
+
+  c := @LExpression[1];
+  if FindInvalidUTF8Character(c, Length(LExpression)) <> -1 then
+    raise ESearchExpressionParserException.Create(sInvalidUTF8String);
+
+  NextValue;
+  repeat
+    // simple scanner
+    GetChar(c, LChar);
+    if LChar.Length = 1 then
+      case LChar.Char[0] of
+        #0: Break;
+        #1..#32:
+          case LExpressionKind of
+            ekSet:
+              begin
+                while c^ in [#1..#32] do Inc(c);
+                Continue;
+              end;
+            ekText, ekUnknown:
+              begin
+                LValue^:=LValue^+LChar.Char[0];
+                LToken:=tkText;
+              end;
+            ekNum:
+              if not (LPrevToken in NUM_OPERATORS) then
+                raise ESearchExpressionParserException.Create(sBadNumericExpression)
+              else
+              begin
+                while c^ in [#1..#32] do Inc(c);
+                continue;
+              end;
+          end;
+        '0'..'9':
+          begin
+            repeat
+              if c^ = '.' then
+                if LDot then
+                  raise ESearchExpressionParserException.Create(sUnexpectedNumberFormat)
+                else
+                  LDot:=true;
+              LValue^:=LValue^+c^;
+              Inc(c);
+            until not (c^ in ['0'..'9', '.']);
+            Dec(c);
+            case LExpressionKind of
+              ekUnknown, ekSet, ekNum: LToken:=tkNum;
+              ekText: LToken:=tkText;
+            end;
+          end;
+        '%':
+          begin
+            if not (LExpressionKind in [ekText,ekUnknown]) then
+              ESearchExpressionParserException.Create(sBadNumericExpression);
+
+            LToken := tkPercent;
+          end;
+        '\':
+          begin
+            if not (LExpressionKind in [ekText,ekUnknown]) then
+              ESearchExpressionParserException.Create(sBadNumericExpression);
+            case (c+1)^ of
+              '%': EscapeSequence('%');
+              '\': EscapeSequence('\');
+              '[': EscapeSequence('[');
+              '(': EscapeSequence('(');
+              ']': EscapeSequence(']');
+              ')': EscapeSequence(')');
+              '<': EscapeSequence('<');
+              '>': EscapeSequence('>');
+              '=': EscapeSequence('=');
+            else
+              raise ESearchExpressionParserException.Create(sBadSyntaxForEscapeCharacter);
+            end
+          end;
+        '<':
+          if (c+1)^ = '=' then
+          begin
+            LToken := tkLessOrEqual;
+            Inc(c);
+          end
+          else
+            LToken := tkLess;
+        '>':
+          if (c+1)^ = '=' then
+          begin
+            LToken := tkGreaterOrEqual;
+            Inc(c);
+          end
+          else
+            LToken := tkGreater;
+        '=': LToken := tkEqual;
+        '(': LToken := tkOpeningParenthesis;
+        ')': LToken := tkClosingParenthesis;
+        '[': LToken := tkOpeningBracket;
+        ']': LToken := tkClosingBracket;
+        ',': LToken := tkComma;
+      else
+        LValue^ := LValue^ + LChar.Char[0];
+        LToken:=tkText;
+      end
+    else
+    begin
+      if not (LExpressionKind in [ekUnknown, ekText]) then
+        raise ESearchExpressionParserException.Create(sUnexpectedCharInExpression);
+      SetLength(LValue^, Length(LValue^) + LChar.Length);
+      Move(LChar.Char[0], LValue^[Succ(Length(LValue^) - LChar.Length)], LChar.Length);
+      LToken:=tkText;
+    end;
+
+    // parser is able to deduce expression kind (if needed)
+    if LExpressionKind = ekUnknown then
+    case LToken of
+      tkPercent, tkText, tkComma: LExpressionKind:=ekText;
+      tkOpeningBracket, tkOpeningParenthesis: LExpressionKind:=ekSet;
+      tkLess..tkGreaterOrEqual, tkNum: LExpressionKind:=ekNum;
+    else
+      raise ESearchExpressionParserException.Create(sUnexpectedCharInExpression);
+    end;
+
+    // text mode has precedence (parsing the expressions like: 123abs)
+    if (LExpressionKind = ekNum) and (AExpressionKind = ekUnknown)
+      and (LToken in [tkText, tkPercent]) and (AExpressionRecord.NumericComparisionKind = nckUnknown) then
+    begin
+      LExpressionKind := ekText;
+    end;
+
+    // text mode is special so part of tokens are used as normal characters
+    if (LExpressionKind = ekText) and (LToken in CONVERTABLE_TOKENS_TO_STR) then
+      LValue^:=LValue^+TokenToStr(LToken);
+
+    if LPrevToken in [tkClosingBracket, tkClosingParenthesis] then
+      raise ESearchExpressionParserException.Create(sInvaildExpression_CharDetectedAfterClosingBracket);
+
+    // rules
+    case LToken of
+      tkNum:
+        if LExpressionKind = ekSet then
+          if not (LPrevToken in [tkOpeningBracket, tkOpeningParenthesis, tkComma]) then
+            raise ESearchExpressionParserException.CreateFmt(sUnexpectedTokenFound, [TokenToStr(LToken)]);
+      tkText:
+        if LExpressionKind in [ekSet, ekNum] then
+          raise ESearchExpressionParserException.Create(sUnexpectedStringLiteralInExpression);
+      tkClosingBracket:
+        if (LExpressionKind = ekSet) then
+          if (AExpressionRecord.SetKind<>skNumericBetweenInclusive) then
+            raise ESearchExpressionParserException.Create(sBadlyClosedBetweenExpression)
+          else if LPrevToken <> tkNum then
+            raise ESearchExpressionParserException.Create(sMissingNumberInExpression);
+      tkClosingParenthesis:
+        if (LExpressionKind = ekSet) then
+          if (AExpressionRecord.SetKind<>skNumericBetweenExclusive) then
+            raise ESearchExpressionParserException.Create(sBadlyClosedBetweenExpression)
+          else if LPrevToken <> tkNum then
+            raise ESearchExpressionParserException.Create(sMissingNumberInExpression);
+      tkComma:
+        if LExpressionKind = ekSet then
+          if not (LPrevToken = tkNum) then
+            raise ESearchExpressionParserException.CreateFmt(sUnexpectedOccurrenceOf_Found, [','])
+          else
+            NextValue;
+      tkPercent:
+        if LExpressionKind = ekText then
+        begin
+          if LLastPercent then
+            raise ESearchExpressionParserException.CreateFmt(sUnexpectedOccurrenceOf_Found, ['%']);
+          case LPrevToken of
+            tkText, tkNum: // tkNum is here because is possible to parse: 123%
+              begin
+                if (AExpressionRecord.TextMatchKind = tmkUnknown) then
+                  AExpressionRecord.TextMatchKind:=tmkMatchTextEnd
+                else
+                  AExpressionRecord.TextMatchKind:=tmkMatchTextAnywhere;
+                LLastPercent:=true;
+              end;
+            tkNone:
+              AExpressionRecord.TextMatchKind:=tmkMatchTextBeginning;
+            tkPercent:
+              raise ESearchExpressionParserException.CreateFmt(sUnexpectedOccurrenceOf_Found, ['%']);
+          end;
+        end
+        else
+          raise ESearchExpressionParserException.CreateFmt(sUnexpectedOccurrenceOf_Found, ['%']);
+      tkLess..tkGreaterOrEqual:
+        case LExpressionKind of
+          ekNum:
+            if LPrevToken <> tkNone then
+              raise ESearchExpressionParserException.Create(sBadNumericExpression)
+            else
+              with AExpressionRecord do
+              case LToken of
+                tkLess: NumericComparisionKind:=nckNumericLT;
+                tkGreater: NumericComparisionKind:=nckNumericGT;
+                tkEqual: NumericComparisionKind:=nckNumericEQ;
+                tkLessOrEqual: NumericComparisionKind:=nckNumericLTE;
+                tkGreaterOrEqual: NumericComparisionKind:=nckNumericGTE;
+              end;
+          ekSet:
+            raise ESearchExpressionParserException.CreateFmt(sUnexpectedTokenFound, [TokenToStr(LToken)]);
+        end;
+      tkOpeningParenthesis, tkOpeningBracket:
+        if LExpressionKind = ekSet then
+          if LPrevToken <> tkNone then
+            raise ESearchExpressionParserException.CreateFmt(sBadBetweenExpression_UnexpectedToken, [TokenToStr(LToken)])
+          else
+          with AExpressionRecord do
+          case LToken of
+            tkOpeningParenthesis: SetKind:=skNumericBetweenExclusive;
+            tkOpeningBracket: SetKind:=skNumericBetweenInclusive;
+          end;
+    end;
+    LPrevToken := LToken;
+    Inc(c, LChar.Length);
+  until (LChar.Length=0) or (c^ = #0);
+
+  case LExpressionKind of
+    ekText:
+      if AExpressionRecord.TextMatchKind = tmkUnknown then
+        AExpressionRecord.TextMatchKind:=tmkMatchTextExact;
+    ekSet:
+      case AExpressionRecord.SetKind of
+        skNumericBetweenInclusive:
+          if LPrevToken <> tkClosingBracket then
+            raise ESearchExpressionParserException.Create(sBadlyClosedBetweenExpression);
+        skNumericBetweenExclusive:
+          if LPrevToken <> tkClosingParenthesis then
+            raise ESearchExpressionParserException.Create(sBadlyClosedBetweenExpression);
+      end;
+  end;
+
+  if (LValueIdx = 0) and (LValue^='') then
+    raise ESearchExpressionParserException.Create(sExpressionError_NoValue);
+
+  SetLength(AExpressionRecord.Values, LValueIdx + 1);
+  for i := 0 to LValueIdx do
+    AExpressionRecord.Values[i] := LValues[i];
+
+  AExpressionRecord.Kind := LExpressionKind;
+end;
+
+class function TSearchExpressionService.Parse(const AExpression: utf8string
+  ): TExpressionRecord;
+begin
+  Result.Kind := ekUnknown;
+  Parse(AExpression, Result.Kind, Result);
+end;
+
+
+initialization
+  TableRowType := TTableRow.Create;
+finalization
+  TableRowType.Free;
 end.
 end.
 
 

+ 4 - 4
Units/Utils/UCommonUI.pas

@@ -1,18 +1,17 @@
 {
 {
   Copyright (c) 2017 Sphere 10 Software
   Copyright (c) 2017 Sphere 10 Software
 
 
-  Author: Herman Schoenfeld <[email protected]>
+  Common unit usable across all tiers.
 
 
   Distributed under the MIT software license, see the accompanying file LICENSE
   Distributed under the MIT software license, see the accompanying file LICENSE
   or visit http://www.opensource.org/licenses/mit-license.php.
   or visit http://www.opensource.org/licenses/mit-license.php.
 
 
-  Additional Credits:
-    <contributors add yourselves here>
+  Acknowledgements:
+    Herman Schoenfeld
 }
 }
 
 
 unit UCommonUI;
 unit UCommonUI;
 
 
-
 {$mode delphi}
 {$mode delphi}
 
 
 interface
 interface
@@ -189,3 +188,4 @@ end;
 
 
 end.
 end.
 
 
+

+ 33 - 0
Units/Utils/UVisualGrid.inc

@@ -0,0 +1,33 @@
+LazarusResources.Add('VISUALGRID_SEARCH','PNG',[
+  #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#16#0#0#0#16#8#6#0#0#0#31#243#255'a'
+  +#0#0#0#6'bKGD'#0#255#0#255#0#255#160#189#167#147#0#0#0#9'pHYs'#0#0#11#19#0#0
+  +#11#19#1#0#154#156#24#0#0#0#7'tIME'#7#225#9#28#18#2#13'U6'#129#240#0#0#2'~ID'
+  +'AT8'#203#149#147']'#136'La'#24#199#127#231#204#217'Y'#179'v'#172'E'#145#143
+  +#214'6>.'#164'0%'#229'#7>'#175'h'#163'Dj'#239#220'p#'#210#250#136'$'#202'%'
+  +#151'X'#236#133#18'.'#165'X['#18#246#194'F$'#181#164#176';'#198#238#217#153
+  +'9gf'#206#158#247#211#197#236#135#149#148#183'~'#245#190#245'>'#191#254#239
+  +#219#243#0'`'#173#229#127#215'x'#141'g'#172'e{{G'#235#197#187'o'#30'O'#155
+  +#222#152'qp'#254']'#136'e'#180'R'#254#188#163#189'c'#139#176#246#139#231':'
+  +#14#199#174#245#246'('#175#185#165#18#215'.)c'#17#202#2#150#164#231#226#185
+  +'S'#165#214'k'#206#172#220#176#171''''#233'8'#139'='#128#200#164'ZLE'#2#208
+  +#152't'#217#183'a.'#203#231'7'#0#240'q'#176#202#157#231'y*'#194'L'#145#196'&'
+  +#213#2#224#2#142#31'JF'#2#137#20#134#179'{[)'#6#146#142#155#253't'#220#234
+  +''''#12'%'#231#246#182'"b'#205'H '#241'K'#162'F('#1#28#23#192#15#4'9'#127#148
+  +#131#155#230#242#226'}'#129#19']'#159'x'#151#139'x7'#24'q'#252#246'''z?'#20
+  +'9'#176'q'#30#185#145'Q'#134#3#193'p '#240#3#193'x'#2#10'%'#193#183'|Dv'#201
+  +#12':'#159#12#16#27#139'_'#138#241'K1'#177#177'tv'#15#176'v'#217#12#190#231
+  +#163#177#4#146'B'#169'&'#240#0#190#231'#'#20#10#13#132#177#166#24#10#192#130
+  +#5#28#135'r'#156'D'#0#133'R'#140'4'#6#165','#213'0'#154'L'#160#149'F'#27#203
+  +#131#190'!'#218#182'.` _'#165#24'J'#138'e'#201#224#207'*{'#182'-'#228#222#171
+  +#31'DBS'#8#4'aU'#162#149#158#20'X'#165#241#28#203#233'+o'#217#188'z'#14#215
+  +'O'#174'bM&MvI'#154#206'S'#171'Y'#183'r'#22'sfO'#3#173'A'#213#176#127#10#140
+  +#210#248'e'#205#250#253#143'P'#177#224#230#153',7Ng'#9#131#136'7'#31'}V,'#157
+  +#201#189#203#235#144#163#2#243#155#192#1#156#217';'#239#27#234'S'#19#189'&cE'
+  +'4'#214'U'#169#233#245'`4'#15#174'nfY'#166#153#158#151'9'#142'\'#234#195'S1'
+  +#254#195'6'#183#150'@k'#140'Rch'#18#9#135'tS'#138'tS'#138'D'#194#193'K'#214
+  +#177#251'P7'#221#207#190'r'#244#252#11#18'X'#172#158'|'#130'U'#225'P'#206#26
+  +#139'5f'#2#163'5F'#235#137#189'W'#159#228#240#133#215'h'#183#14#163#13'*'#28
+  +#202#1'6'#1#160#134#135#158'z'#233'Em'#14#201#6#164#228'oX)q'#141#194'J'#137
+  +')'#13#12'W'#223'v'#237#176'j'#240#199#159#163#215'4'#246'/'#255#30'H('#141
+  +#31'~'#1#3'8'#133'x#1@Z'#0#0#0#0'IEND'#174'B`'#130
+]);

+ 1852 - 0
Units/Utils/UVisualGrid.pas

@@ -0,0 +1,1852 @@
+{
+  Copyright (c) 2017 Sphere 10 Software
+
+  TVisualGrid is an enterprise-class grid component with datasource, paging, searching capability.
+
+  Distributed under the MIT software license, see the accompanying file LICENSE
+  or visit http://www.opensource.org/licenses/mit-license.php.
+
+  Credits:
+     Herman Schoenfeld (designer)
+     Maciej Izak (hnb) (developer)
+}
+
+unit UVisualGrid;
+
+{$MODE DELPHI}
+{.$DEFINE VISUALGRID_DEBUG}
+
+interface
+
+uses
+  Classes, SysUtils, StdCtrls, ExtCtrls, Controls, Grids, Types, Graphics,
+  UCommon, Generics.Collections, Menus, ComboEx, Buttons, Math
+  {$IFNDEF WINDOWS}, LResources{$ENDIF};
+
+type
+  TSelectionType = (stNone, stCell, stRow, stMultiRow);
+  TSortDirection = (sdNone, sdAscending, sdDescending);
+  TVisualGridFilter = (vgfMatchTextExact, vgfMatchTextBeginning, vgfMatchTextEnd,
+    vgfMatchTextAnywhere, vgfNumericEQ, vgfNumericLT, vgfNumericLTE, vgfNumericGT,
+    vgfNumericGTE, vgfNumericBetweenInclusive, vgfNumericBetweenExclusive, vgfSortable);
+  TVisualGridFilters = set of TVisualGridFilter;
+
+const
+  TEXT_FILTER = [vgfMatchTextExact, vgfMatchTextBeginning, vgfMatchTextEnd, vgfMatchTextAnywhere];
+  NUMERIC_FILTER = [vgfNumericEQ, vgfNumericLT, vgfNumericLTE, vgfNumericGT, vgfNumericGTE, vgfNumericBetweenInclusive, vgfNumericBetweenExclusive];
+  SORTABLE_TEXT_FILTER = TEXT_FILTER + [vgfSortable];
+  SORTABLE_NUMERIC_FILTER = NUMERIC_FILTER + [vgfSortable];
+
+type
+  TColumnFilter = record
+    ColumnName: utf8string;
+    Sort: TSortDirection;
+    Filter: TVisualGridFilter;
+    Values: array of Variant;
+  end;
+
+  TFilterCriteria = TArray<TColumnFilter>;
+
+  PDataTable = ^TDataTable;
+  TDataTable = record
+  public
+    Columns: TTableColumns;
+    Rows : TArray<Variant>;
+  end;
+
+  { TPageFetchParams }
+
+  TPageFetchParams = record
+    PageIndex: Integer;
+    PageSize: Integer;
+    Filter: TFilterCriteria;
+    constructor Create(AIndex: Integer; ASize: Integer; AFilter: TFilterCriteria);
+  end;
+
+  { TPageFetchResult }
+
+  TPageFetchResult = record
+    PageIndex: Integer;
+    PageCount: Integer;
+    TotalDataCount: Integer;
+  end;
+
+  { TSearchCapability }
+
+  PSearchCapability = ^TSearchCapability;
+  TSearchCapability = record
+    ColumnName : utf8string;
+    SupportedFilters : TVisualGridFilters;
+    class function From(const AName : utf8string; AFilterType : TVisualGridFilters) : TSearchCapability; static;
+  end;
+
+  TSearchCapabilities = array of TSearchCapability;
+
+  { IDataSource }
+
+  IDataSource = interface
+    function FetchPage(constref AParams: TPageFetchParams; var ADataTable: TDataTable): TPageFetchResult;
+    function GetSearchCapabilities: TSearchCapabilities;
+    property SearchCapabilities : TSearchCapabilities read GetSearchCapabilities;
+  end;
+
+  { TVisualGridSelection }
+
+  TVisualGridSelection = record
+  private
+    function GetCol: longint;
+    function GetColCount: longint;
+    function GetRow: longint;
+    function GetRowCount: longint;
+  public
+    Selections: array of TRect;
+    property Col: longint read GetCol;
+    property Row: longint read GetRow;
+    property RowCount: longint read GetRowCount;
+    property ColCount: longint read GetColCount;
+  end;
+
+  { TColumnOptions }
+
+  { TVisualColumn }
+
+  TVisualColumn = class
+  private
+    function GetStretchedToFill: boolean; inline;
+    function GetWidth: Integer; inline;
+    procedure SetStretchedToFill(AValue: boolean); inline;
+    procedure SetWidth(AValue: Integer); inline;
+  protected
+    FColumn: TGridColumn;
+  public
+    constructor Create(AColumn: TGridColumn);
+    property StretchedToFill: boolean read GetStretchedToFill write SetStretchedToFill;
+    property Width: Integer read GetWidth write SetWidth;
+  end;
+
+  TPreparePopupMenuEvent = procedure(Sender: TObject; constref ASelection: TVisualGridSelection; out APopupMenu: TPopupMenu) of object;
+  TSelectionEvent = procedure(Sender: TObject; constref ASelection: TVisualGridSelection) of object;
+  TDrawVisualCellEvent = procedure(Sender: TObject; ACol, ARow: Longint;
+    Canvas: TCanvas; Rect: TRect; State: TGridDrawState; const RowData: Variant; var Handled: boolean) of object;
+
+  EVisualGridError = class(Exception);
+
+  TVisualGridOptions = set of (vgoColAutoFill, vgoColSizing, vgoMultiSearchCheckComboBox);
+
+  TCustomVisualGrid = class;
+
+  { TVisualGridCaption }
+
+  TVisualGridCaption = class(TPersistent)
+  private
+    FOwner: TCustomVisualGrid;
+    FLabel: TLabel;
+
+    function GetText: TCaption;
+    function GetAlignment: TAlignment;
+    function GetFont: TFont;
+    function GetVisible: boolean;
+    procedure SetText(AValue: TCaption);
+    procedure SetAlignment(AValue: TAlignment);
+    procedure SetFont(AValue: TFont);
+    procedure SetVisible(AValue: boolean);
+  public
+    constructor Create(AOwner: TCustomVisualGrid);
+  published
+    property Text: TCaption read GetText write SetText;
+    property Visible: boolean read GetVisible write SetVisible;
+    property Font: TFont read GetFont write SetFont;
+    property Alignment: TAlignment read GetAlignment write SetAlignment default taLeftJustify;
+  end;
+
+  { TCustomVisualGrid }
+
+  TCustomVisualGrid = class(TCustomControl)
+  protected type
+    TUpdateOfVisualGridGUI = set of (updPageIndex, updPageSize);
+
+    TLastFetchDataResult = record
+      FromThread: boolean;
+      RefreshColumns: boolean;
+      FetchResult: TPageFetchResult;
+    end;
+
+    { TSearchEdit }
+
+    TSearchEdit = class
+    private
+      FGrid: TCustomVisualGrid;
+      FPanel: TPanel;
+      FEdit: TEdit;
+      FButton: TButton;
+
+      function GetEditVisible: boolean;
+      function GetVisible: boolean;
+      procedure SetEditVisible(AValue: boolean);
+      procedure SetVisible(AValue: boolean);
+    public
+      SearchCapability: PSearchCapability;
+      constructor Create(AParent: TWinControl; AGrid: TCustomVisualGrid);
+      destructor Destroy; override;
+
+      property EditVisible: boolean read GetEditVisible write SetEditVisible;
+      property Visible: boolean read GetVisible write SetVisible;
+    end;
+
+  protected const
+    PAGE_NAVIGATION_FIRST    = 1;
+    PAGE_NAVIGATION_PREVIOUS = 2;
+    PAGE_NAVIGATION_NEXT     = 3;
+    PAGE_NAVIGATION_LAST     = 4;
+  protected { component interface part }
+    FMainPanel: TPanel;
+    FSearchLabel: TLabel;
+    FSearchEdit: TEdit;
+    FSearchButton: TSpeedButton;
+    FMultiSearchCheckComboBox: TCheckComboBox;
+    FTopPanel: TPanel;
+    FTopPanelMultiSearch: TPanel;
+    FTopPanelMultiSearchFixed: TPanel;
+    FTopPanelMultiSearchClient: TPanel;
+    FTopPanelMultiSearchRight: TPanel;
+    FTopPanelRight: TPanel;
+    FClientPanel: TPanel;
+    FLoadDataPanel: TPanel;
+    FLoadDataLabel: TLabel;
+    FLoadDataProgressLabel: TLabel;
+    FBottomPanel: TPanel;
+    FBottomCenterPanel: TPanel;
+    FBottomRightPanel: TPanel;
+
+    FButtonFirst: TButton;
+    FButtonLast: TButton;
+    FButtonNext: TButton;
+    FButtonPrevious: TButton;
+
+    FPageIndexEdit: TEdit;
+    FPageCountLabel: TLabel;
+
+    FPageSizeEdit: TEdit;
+    FPageSizeLabel: TLabel;
+    FAllRecordsCountLabel: TLabel;
+
+    FDrawGrid: TDrawGrid;
+    FDelayedBoundsChangeTimer: TTimer;
+    FFetchDataThreadTimer: TTimer;
+    FEditingDoneTimer: TTimer;
+    FSearchKindPopupMenu: TPopupMenu;
+    FSingleSearchMenuItem: TMenuItem;
+    FMultiSearchMenuItem: TMenuItem;
+
+    FMultiSearchEdits: TObjectList<TSearchEdit>;
+    FColumns: TObjectList<TVisualColumn>;
+  protected { events for UI }
+    procedure StandardDrawCell(Sender: TObject; ACol, ARow: Longint;
+      Rect: TRect; State: TGridDrawState);
+    procedure GridMouseUp(Sender: TObject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+    procedure SearchKindPopupMenuClick(Sender: TObject);
+    procedure GridSelection(Sender: TObject; aCol, aRow: Integer);
+    procedure PageIndexEditingDone(Sender: TObject);
+    procedure PageSizeEditingDone(Sender: TObject);
+    procedure PageNavigationClick(Sender: TObject);
+    procedure MultiSearchCheckComboBoxChange(Sender: TObject; AIndex: Integer);
+    procedure DelayedBoundsChange(Sender: TObject);
+    procedure FetchDataThreadProgress(Sender: TObject);
+    procedure SearchButtonClick(Sender: TObject);
+  private
+    FCaption: TVisualGridCaption;
+    FFetchDataInThread: boolean;
+    FOnPreparePopupMenu: TPreparePopupMenuEvent;
+    FOnSelection: TSelectionEvent;
+    FOptions: TVisualGridOptions;
+    FShowAllData: boolean;
+    FAutoPageSize: boolean;
+    FCanPage: boolean;
+    FCanSearch: boolean;
+    FSelectionType: TSelectionType;
+    function GetCells(ACol, ARow: Integer): Variant;
+    function GetColCount: Integer; inline;
+    function GetColumns(Index: Integer): TVisualColumn;
+    function GetActiveDataTable: PDataTable;
+    function GetRowCount: Integer; inline;
+    function GetRows(ARow: Integer): Variant;
+    function GetSelection: TVisualGridSelection;
+    procedure ControlsEnable(AEnable: boolean);
+    function GetCanvas: TCanvas;
+    procedure SetCells(ACol, ARow: Integer; AValue: Variant);
+    procedure SetFetchDataInThread(AValue: boolean);
+    procedure SetOptions(AValue: TVisualGridOptions);
+    procedure SetRows(ARow: Integer; AValue: Variant);
+    procedure SetShowAllData(AValue: boolean);
+    procedure SetAutoPageSize(AValue: boolean);
+    procedure SetCanPage(AValue: boolean);
+    procedure SetCanSearch(AValue: boolean);
+{$IFDEF VISUALGRID_DEBUG}
+    procedure ClickTest(Sender: TObject);
+{$ENDIF}
+    procedure SetPageIndex(Value: Integer);
+    procedure SetPageSize(Value: Integer);
+    procedure SetSelectionType(AValue: TSelectionType);
+  protected { TComponent }
+    procedure Loaded; override;
+  protected { TControl }
+    procedure BoundsChanged; override;
+  protected
+    FGUIUpdates: TUpdateOfVisualGridGUI;
+    FDataTable: TDataTable;
+    FCachedDataTable: PDataTable;
+    FDataSource: IDataSource;
+    FStrFilter: UTF8String;
+    FFilter: TFilterCriteria;
+    FSearchCapabilities: TSearchCapabilities;
+    FPageSize: Integer;
+    FPageIndex: Integer;
+    FPageCount: Integer;
+    FDefaultDrawGridOptions: TGridOptions;
+    FTotalDataCount: Integer;
+    FLastFetchDataResult: TLastFetchDataResult;
+
+    FOnDrawVisualCell: TDrawVisualCellEvent;
+
+    procedure RefreshGrid;
+    procedure ReloadColumns;
+    procedure LayoutChanged;
+    function ClientRowCount: Integer;
+    procedure HidePageSizeControls(AVisible: boolean);
+    procedure HidePageNavigationControls(AVisible: boolean);
+    // return true if range is correct
+    function CheckRangeForPageSize(var APageSize: Integer): boolean;
+    procedure SetDataSource(ADataSource: IDataSource);
+    procedure DoDrawCell(Sender: TObject; ACol, ARow: Longint;
+      Rect: TRect; State: TGridDrawState; const RowData: Variant);
+    procedure RefreshPageIndexAndGridInterface;
+    procedure RefreshPageIndexData(ARefreshColumns: boolean);
+    procedure ResizeSearchEdit(ACol: Integer);
+    procedure SetPageIndexEditText(const AStr: utf8string);
+    procedure SetPageSizeEditText(const AStr: utf8string);
+    procedure BeforeFetchPage;
+    procedure FetchPage(out AResult: TPageFetchResult);
+    procedure AfterFetchPage;
+    property ActiveDataTable: PDataTable read GetActiveDataTable;
+  public
+    constructor Create(Owner: TComponent); override;
+    destructor Destroy; override;
+    property DataSource: IDataSource read FDataSource write SetDataSource;
+    property PageSize: Integer read FPageSize write SetPageSize default 100;
+    property PageIndex: Integer read FPageIndex write SetPageIndex default -1;
+    property AutoPageSize: boolean read FAutoPageSize write SetAutoPageSize default false;
+    property ShowAllData: boolean read FShowAllData write SetShowAllData default false;
+    property FetchDataInThread: boolean read FFetchDataInThread write SetFetchDataInThread;
+
+    property CanPage: boolean read FCanPage write SetCanPage default true;
+    property CanSearch: boolean read FCanSearch write SetCanSearch default true;
+    property Options: TVisualGridOptions read FOptions write SetOptions;
+    property Canvas: TCanvas read GetCanvas;
+    property SelectionType: TSelectionType read FSelectionType write SetSelectionType;
+    property Selection: TVisualGridSelection read GetSelection;
+
+    property Caption: TVisualGridCaption read FCaption write FCaption;
+    property ColCount: Integer read GetColCount;
+    property Columns[Index: Integer]: TVisualColumn read GetColumns;
+    property Cells[ACol, ARow: Integer]: Variant read GetCells write SetCells;
+    property RowCount: Integer read GetRowCount;
+    property Rows[ARow: Integer]: Variant read GetRows write SetRows;
+
+    property OnDrawVisualCell: TDrawVisualCellEvent read FOnDrawVisualCell write FOnDrawVisualCell;
+    property OnSelection: TSelectionEvent read FOnSelection write FOnSelection;
+    property OnPreparePopupMenu: TPreparePopupMenuEvent read FOnPreparePopupMenu write FOnPreparePopupMenu;
+  end;
+
+  TVisualGrid = class(TCustomVisualGrid)
+  published
+    property Caption;
+
+    property Align;
+    property PageSize;
+    property AutoPageSize;
+    property ShowAllData;
+    property CanPage;
+    property CanSearch;
+    property Options;
+    property SelectionType;
+    property FetchDataInThread;
+
+    property OnDrawVisualCell;
+    property OnSelection;
+    property OnPreparePopupMenu;
+  end;
+
+  TVisualGridSearchExpressionService = class
+  end;
+
+procedure Register;
+
+implementation
+
+{$IFDEF WINDOWS}
+{$R *.rc}
+{$ENDIF}
+
+resourcestring
+  sTotal = 'Total: %d';
+  sStandardSearch = 'Standard Search';
+  sMultiColumnSearch = 'Multi-Column Search';
+  sPageSize = 'Page size:';
+  sSearchExpression = 'Search expression';
+  sDataLoading = 'DATA LOADING';
+  sExpression = 'Expression';
+  sImproperColumnIndex = 'Improper column index. Max expected is %d but %d found.';
+
+type
+  TDrawGridAccess = class(TDrawGrid);
+  //TScrollBarAccess = class(TScrollBar);
+
+  { TFetchDataThread }
+
+  TFetchDataThread = class(TThread)
+  protected
+    FGrid: TCustomVisualGrid;
+    FLastFetchDataResult: TCustomVisualGrid.TLastFetchDataResult;
+    procedure Execute; override;
+  public
+    constructor Create(AGrid: TCustomVisualGrid; ARefreshColumns: boolean);
+    destructor Destroy; override;
+  end;
+
+procedure Register;
+begin
+  RegisterComponents('Pascal Framework', [TVisualGrid]);
+end;
+
+{ TVisualGridCaption }
+
+function TVisualGridCaption.GetText: TCaption;
+begin
+  Result := FLabel.Caption;
+end;
+
+function TVisualGridCaption.GetAlignment: TAlignment;
+begin
+  Result := FLabel.Alignment;
+end;
+
+function TVisualGridCaption.GetFont: TFont;
+begin
+  Result := FLabel.Font;
+end;
+
+function TVisualGridCaption.GetVisible: boolean;
+begin
+  Result := FLabel.Visible;
+end;
+
+procedure TVisualGridCaption.SetText(AValue: TCaption);
+begin
+  if FLabel.Caption = AValue then Exit;
+  FLabel.Caption:=AValue;
+  FOwner.LayoutChanged;
+end;
+
+procedure TVisualGridCaption.SetAlignment(AValue: TAlignment);
+begin
+  if FLabel.Alignment = AValue then Exit;
+  FLabel.Alignment:=AValue;
+end;
+
+procedure TVisualGridCaption.SetFont(AValue: TFont);
+begin
+  if FLabel.Font.IsEqual(AValue) then Exit;
+  FLabel.Font.Assign(AValue);
+  FOwner.LayoutChanged;
+end;
+
+procedure TVisualGridCaption.SetVisible(AValue: boolean);
+begin
+  if FLabel.Visible = AValue then Exit;
+  FLabel.Visible:=AValue;
+  FOwner.LayoutChanged;
+end;
+
+constructor TVisualGridCaption.Create(AOwner: TCustomVisualGrid);
+begin
+  FOwner := AOwner;
+
+  FLabel := TLabel.Create(AOwner);
+  FLabel.Parent := AOwner;
+  with FLabel do
+  begin
+    Align := alTop;
+    Visible := false;
+  end;
+end;
+
+{ TVisualColumn }
+
+function TVisualColumn.GetStretchedToFill: boolean;
+begin
+  Result := FColumn.SizePriority > 0;
+end;
+
+function TVisualColumn.GetWidth: Integer;
+begin
+  Result := FColumn.Width;
+end;
+
+procedure TVisualColumn.SetStretchedToFill(AValue: boolean);
+begin
+  FColumn.SizePriority := ifthen(AValue, 1);
+end;
+
+procedure TVisualColumn.SetWidth(AValue: Integer);
+begin
+  FColumn.Width := AValue;
+end;
+
+constructor TVisualColumn.Create(AColumn: TGridColumn);
+begin
+  FColumn := AColumn;
+end;
+
+{ TVisualGridSelection }
+
+function TVisualGridSelection.GetCol: longint;
+begin
+  if Length(Selections) = 0 then
+    Exit(-1);
+  Result := Selections[0].Left;
+end;
+
+function TVisualGridSelection.GetColCount: longint;
+begin
+  if Length(Selections) = 0 then
+    Exit(0);
+  Result := Selections[0].Width + 1;
+end;
+
+function TVisualGridSelection.GetRow: longint;
+begin
+  if Length(Selections) = 0 then
+    Exit(-1);
+  Result := Selections[0].Top;
+end;
+
+function TVisualGridSelection.GetRowCount: longint;
+begin
+  if Length(Selections) = 0 then
+    Exit(0);
+  Result := Selections[0].Height + 1;
+end;
+
+{ TFetchDataThread }
+
+procedure TFetchDataThread.Execute;
+begin
+  FGrid.FetchPage(FLastFetchDataResult.FetchResult);
+end;
+
+constructor TFetchDataThread.Create(AGrid: TCustomVisualGrid;
+  ARefreshColumns: boolean);
+begin
+  FGrid := AGrid;
+  FGrid.ControlsEnable(false);
+  FGrid.FFetchDataThreadTimer.Enabled:=true;
+  FGrid.FLoadDataPanel.Visible:=True;
+  FGrid.FLoadDataPanel.BringToFront;
+  FGrid.BeforeFetchPage;
+  FreeOnTerminate:=true;
+  FLastFetchDataResult.RefreshColumns:=ARefreshColumns;
+  // fast copy of data (we need to draw old data for a while)
+  New(FGrid.FCachedDataTable);
+  Move(FGrid.FDataTable, FGrid.FCachedDataTable^, SizeOf(TDataTable));
+  FillChar(FGrid.FDataTable, SizeOf(TDataTable), #0);
+  inherited Create(false);
+end;
+
+destructor TFetchDataThread.Destroy;
+begin
+  FLastFetchDataResult.FromThread:=true;
+  FGrid.FLastFetchDataResult := FLastFetchDataResult;
+  Synchronize(FGrid.AfterFetchPage);
+  inherited Destroy;
+end;
+
+{ TCustomVisualGrid.TSearchEdit }
+
+function TCustomVisualGrid.TSearchEdit.GetEditVisible: boolean;
+begin
+  Result := FEdit.Visible;
+end;
+
+function TCustomVisualGrid.TSearchEdit.GetVisible: boolean;
+begin
+  Result := FPanel.Visible;
+end;
+
+procedure TCustomVisualGrid.TSearchEdit.SetEditVisible(AValue: boolean);
+begin
+  FEdit.Visible:=AValue;
+  //FButton.Visible:=AValue;
+end;
+
+procedure TCustomVisualGrid.TSearchEdit.SetVisible(AValue: boolean);
+begin
+  FPanel.Visible := AValue;
+end;
+
+constructor TCustomVisualGrid.TSearchEdit.Create(AParent: TWinControl;
+  AGrid: TCustomVisualGrid);
+begin
+  FGrid := AGrid;
+  FPanel := TPanel.Create(nil);
+  FPanel.Parent := AParent;
+  FPanel.BevelOuter := bvNone;
+  FEdit := TEdit.Create(FPanel);
+  FPanel.Height:=FEdit.Height;
+  FEdit.Parent := FPanel;
+  FEdit.PopupMenu := FGrid.FSearchKindPopupMenu;
+  FEdit.Align:=alClient;
+  {FButton := TButton.Create(FPanel);
+  FButton.Width:=25;
+  FButton.Parent := FPanel;
+  FButton.Align:=alRight;}
+end;
+
+destructor TCustomVisualGrid.TSearchEdit.Destroy;
+begin
+  FPanel.Free;
+  inherited Destroy;
+end;
+
+{ TPageFetchParams }
+
+constructor TPageFetchParams.Create(AIndex: Integer; ASize: Integer;
+  AFilter: TFilterCriteria);
+begin
+  PageIndex:= AIndex;
+  PageSize:=ASize;
+  Filter:=AFilter;
+end;
+
+{ TSearchCapability }
+
+class function TSearchCapability.From(const AName : utf8string; AFilterType : TVisualGridFilters) : TSearchCapability;
+begin
+  Result.ColumnName := AName;
+  Result.SupportedFilters := AFilterType;
+end;
+
+{ TCustomVisualGrid }
+
+{$IFDEF VISUALGRID_DEBUG}
+procedure TCustomVisualGrid.ClickTest(Sender: TOBject);
+begin
+  TButton(Sender).Caption := Format('%dx%d', [FSearchEdit.Left,FSearchEdit.Top]);
+end;
+{$ENDIF}
+
+constructor TCustomVisualGrid.Create(Owner: TComponent);
+begin
+  inherited;
+
+  FMultiSearchEdits := TObjectList<TSearchEdit>.Create;
+  FColumns := TObjectList<TVisualColumn>.Create;
+
+  { component layout }
+
+  ControlStyle := ControlStyle - [csAcceptsControls] + [csOwnedChildrenNotSelectable];
+
+  FSearchKindPopupMenu := TPopupMenu.Create(Self);
+  FSingleSearchMenuItem := TMenuItem.Create(Self);
+  FSingleSearchMenuItem.RadioItem:=True;
+  FSingleSearchMenuItem.Caption:=sStandardSearch;
+  FSingleSearchMenuItem.OnClick:=SearchKindPopupMenuClick;
+  FMultiSearchMenuItem := TMenuItem.Create(Self);
+  FMultiSearchMenuItem.RadioItem:=True;
+  FMultiSearchMenuItem.Caption:=sMultiColumnSearch;
+  FMultiSearchMenuItem.OnClick:=SearchKindPopupMenuClick;
+
+  FSearchKindPopupMenu.Items.Add([FSingleSearchMenuItem, FMultiSearchMenuItem]);
+
+  FMainPanel := TPanel.Create(Self);
+  FMainPanel.Parent := Self;
+  with FMainPanel do
+  begin
+    Align:=alClient;
+    BevelOuter := bvNone;
+  end;
+
+  FBottomPanel := TPanel.Create(Self);
+  FBottomPanel.Parent := FMainPanel;
+  with FBottomPanel do
+  begin
+    Align := alBottom;
+    BevelOuter := bvNone;
+    Height := 40;
+
+    FBottomRightPanel := TPanel.Create(Self);
+    FBottomRightPanel.Parent := FBottomPanel;
+    with FBottomRightPanel do
+    begin
+      Width := 217;
+      Height := 40;
+      Align := alRight;
+      BevelOuter := bvNone;
+      FPageCountLabel := TLabel.Create(Self);
+      FPageCountLabel.Parent := FBottomRightPanel;
+      with FPageCountLabel do
+      begin
+        Left := 118;
+        Top := 13;
+        Width := 36;
+        Height := 13;
+        Caption := '/';
+      end;
+      FButtonFirst := TButton.Create(Self);
+      FButtonFirst.Parent := FBottomRightPanel;
+      with FButtonFirst do
+      begin
+        Left := 8;
+        Top := 8;
+        Width := 25;
+        Height := 25;
+        Caption := '|<';
+        OnClick := PageNavigationClick;
+        Tag := PAGE_NAVIGATION_FIRST;
+      end;
+      FButtonPrevious := TButton.Create(Self);
+      FButtonPrevious.Parent := FBottomRightPanel;
+      with FButtonPrevious do
+      begin
+        Left := 32;
+        Top := 8;
+        Width := 25;
+        Height := 25;
+        Caption := '<';
+        OnClick := PageNavigationClick;
+        Tag := PAGE_NAVIGATION_PREVIOUS;
+      end;
+      FButtonNext := TButton.Create(Self);
+      FButtonNext.Parent := FBottomRightPanel;
+      with FButtonNext do
+      begin
+        Left := 160;
+        Top := 8;
+        Width := 25;
+        Height := 25;
+        Caption := '>';
+        OnClick := PageNavigationClick;
+        Tag := PAGE_NAVIGATION_NEXT;
+      end;
+      FButtonLast := TButton.Create(Self);
+      FButtonLast.Parent := FBottomRightPanel;
+      with FButtonLast do
+      begin
+        Left := 184;
+        Top := 8;
+        Width := 25;
+        Height := 25;
+        Caption := '>|';
+        OnClick := PageNavigationClick;
+        Tag := PAGE_NAVIGATION_LAST;
+      end;
+
+      FPageIndexEdit := TEdit.Create(Self);
+      FPageIndexEdit.Parent := FBottomRightPanel;
+      with FPageIndexEdit do
+      begin
+        Left := 61;
+        Top := 10;
+        Width := 56;
+        Height := 21;
+
+        AnchorSideLeft.Control := FButtonPrevious;
+        AnchorSideLeft.Side := asrBottom;
+        AnchorSideTop.Control := FBottomRightPanel;
+        AnchorSideRight.Control := FPageCountLabel;
+        AnchorSideBottom.Control := FBottomRightPanel;
+        AnchorSideBottom.Side := asrBottom;
+        Anchors := [akLeft, akTop, akRight, akBottom];
+        BorderSpacing.Top := 10;
+        BorderSpacing.Right := 2;
+        BorderSpacing.Left := 2;
+        BorderSpacing.Bottom := 8;
+
+        OnEditingDone := PageIndexEditingDone;
+      end;
+
+    end;
+
+    FBottomCenterPanel := TPanel.Create(Self);
+    FBottomCenterPanel.Parent := FBottomPanel;
+    with FBottomCenterPanel do
+    begin
+      Align := alClient;
+      BevelOuter := bvNone;
+      FAllRecordsCountLabel := TLabel.Create(Self);
+      FAllRecordsCountLabel.Parent := FBottomCenterPanel;
+      with FAllRecordsCountLabel do
+      begin
+        Left := 7;
+        Top := 13;
+        Width := 31;
+        Height := 13;
+        Caption := Format(sTotal, [0]);
+      end;
+      FPageSizeLabel := TLabel.Create(Self);
+      FPageSizeLabel.Parent := FBottomCenterPanel;
+      with FPageSizeLabel do
+      begin
+        Left := 116;
+        Top := 13;
+        Width := 31;
+        Height := 13;
+        Caption := sPageSize;
+      end;
+      FPageSizeEdit := TEdit.Create(Self);
+      FPageSizeEdit.Parent := FBottomCenterPanel;
+      with FPageSizeEdit do
+      begin
+        Left := 181;
+        Top := 10;
+        Width := 52;
+        Height := 21;
+
+        AnchorSideLeft.Control := FPageSizeLabel;
+        AnchorSideLeft.Side := asrBottom;
+        AnchorSideTop.Control := FBottomCenterPanel;
+        AnchorSideBottom.Control := FBottomCenterPanel;
+        AnchorSideBottom.Side := asrBottom;
+        Anchors := [akLeft, akTop, akBottom];
+        BorderSpacing.Top := 10;
+        BorderSpacing.Left := 2;
+        BorderSpacing.Bottom := 8;
+
+        OnEditingDone:=PageSizeEditingDone;
+      end;
+    end;
+  end;
+
+  FCaption := TVisualGridCaption.Create(Self);
+
+  FTopPanel := TPanel.Create(Self);
+  FTopPanel.Parent := FMainPanel;
+  with FTopPanel do
+  begin
+    Align := alTop;
+    BevelOuter := bvNone;
+    Height := 36;
+
+    FMultiSearchCheckComboBox := TCheckComboBox.Create(Self);
+    FMultiSearchCheckComboBox.Parent := FTopPanel;
+    with FMultiSearchCheckComboBox do
+    begin
+      AnchorSideTop.Control := FTopPanel;
+      AnchorSideLeft.Control := FTopPanel;
+      AnchorSideBottom.Control := FTopPanel;
+      AnchorSideBottom.Side := asrBottom;
+      Anchors := [akLeft, akTop, akBottom];
+
+      BorderSpacing.Top := 6;
+      BorderSpacing.Left := 4;
+      BorderSpacing.Bottom := 6;
+      Width := 120;
+      OnItemChange:=MultiSearchCheckComboBoxChange;
+      PopupMenu:=FSearchKindPopupMenu;
+      Visible:=False;
+    end;
+
+    FTopPanelRight := TPanel.Create(Self);
+    FTopPanelRight.Parent := FTopPanel;
+    with FTopPanelRight do
+    begin
+      BevelOuter := bvNone;
+      Align := alRight;
+      Height := 40;
+      Width := 300;
+
+      FSearchButton := TSpeedButton.Create(Self);
+      FSearchButton.Parent := FTopPanelRight;
+      {$IFDEF WINDOWS}
+      FSearchButton.LoadGlyphFromResourceName(HINSTANCE, 'VISUALGRID_SEARCH');
+      {$ELSE}
+      FSearchButton.LoadGlyphFromLazarusResource('VISUALGRID_SEARCH');
+      {$ENDIF}
+      with FSearchButton do
+      begin
+        AnchorSideTop.Control := FTopPanelRight;
+        AnchorSideRight.Control := FTopPanelRight;
+        AnchorSideRight.Side := asrBottom;
+        AnchorSideBottom.Control := FTopPanelRight;
+        AnchorSideBottom.Side := asrBottom;
+        Anchors := [akTop, akRight, akBottom];
+        BorderSpacing.Top := 6;
+        BorderSpacing.Right := 4;
+        BorderSpacing.Bottom := 6;
+        Width := 23;
+        PopupMenu:=FSearchKindPopupMenu;
+        OnClick:=SearchButtonClick;
+      end;
+
+      FSearchEdit := TEdit.Create(Self);
+      FSearchEdit.Parent := FTopPanelRight;
+      with FSearchEdit do
+      begin
+        AnchorSideTop.Control := FTopPanelRight;
+        AnchorSideRight.Control := FSearchButton;
+        AnchorSideBottom.Control := FTopPanelRight;
+        AnchorSideBottom.Side := asrBottom;
+        Anchors := [akTop, akRight, akBottom];
+        BorderSpacing.Top := 6;
+        BorderSpacing.Right := 2;
+        BorderSpacing.Bottom := 6;
+        Width := 121;
+        TextHint := sSearchExpression;
+        PopupMenu := FSearchKindPopupMenu;
+      end;
+    end;
+  end;
+
+  FClientPanel := TPanel.Create(Self);
+  FClientPanel.Parent := FMainPanel;
+  with FClientPanel do
+  begin
+    Align := alClient;
+    BevelOuter := bvNone;
+
+    FTopPanelMultiSearch := TPanel.Create(Self);
+    FTopPanelMultiSearch.Parent := FClientPanel;
+    with FTopPanelMultiSearch do
+    begin
+      Align:=alTop;
+      BevelOuter := bvNone;
+      Height := 40;
+
+      FTopPanelMultiSearchFixed := TPanel.Create(Self);
+      FTopPanelMultiSearchFixed.Parent := FTopPanelMultiSearch;
+      with FTopPanelMultiSearchFixed do
+      begin
+        Align:=alLeft;
+        BevelOuter := bvNone;
+        Height := 40;
+        Width := 0; // may be usefull for fixed columns
+      end;
+
+      FTopPanelMultiSearchClient := TPanel.Create(Self);
+      FTopPanelMultiSearchClient.Parent := FTopPanelMultiSearch;
+      with FTopPanelMultiSearchClient do
+      begin
+        Align:=alClient;
+        BevelOuter := bvNone;
+        Height := 40;
+      end;
+
+      {FTopPanelMultiSearchRight := TPanel.Create(Self);
+      FTopPanelMultiSearchRight.Parent := FTopPanelMultiSearch;
+      with FTopPanelMultiSearchRight do
+      begin
+        Align:=alRight;
+        BevelOuter := bvNone;
+        Height := 40;
+        Width:=TScrollBarAccess.GetControlClassDefaultSize.cy;
+      end;}
+    end;
+
+    FDrawGrid := TDrawGrid.Create(Self);
+    FDrawGrid.Parent := FClientPanel;
+    with FDrawGrid do
+    begin
+      Align := alClient;
+      BorderStyle := bsNone;
+      OnDrawCell := StandardDrawCell;
+      OnMouseUp := GridMouseUp;
+      OnSelection := GridSelection;
+      Options := (Options - [goRangeSelect]);
+      FixedCols := 0;
+      ColCount:=0;
+      RowCount:=0;
+    end;
+    FDefaultDrawGridOptions := FDrawGrid.Options;
+  end;
+
+  FLoadDataPanel := TPanel.Create(Self);
+  FLoadDataPanel.Parent := Self;
+  with FLoadDataPanel do
+  begin
+    //BevelOuter := bvNone;
+    Width := 300;
+    Height := 150;
+    //Align:=alClient;
+    Visible:=false;
+    AnchorSideLeft.Control := Self;
+    AnchorSideLeft.Side := asrCenter;
+    AnchorSideTop.Control := Self;
+    AnchorSideTop.Side := asrCenter;
+
+    FLoadDataLabel := TLabel.Create(Self);
+    FLoadDataLabel.Parent := FLoadDataPanel;
+    with FLoadDataLabel do
+    begin
+      AnchorSideLeft.Control := FLoadDataPanel;
+      AnchorSideLeft.Side := asrCenter;
+      AnchorSideTop.Control := FLoadDataPanel;
+      AnchorSideTop.Side := asrCenter;
+      Caption := sDataLoading;
+    end;
+    FLoadDataProgressLabel := TLabel.Create(Self);
+    FLoadDataProgressLabel.Parent := FLoadDataPanel;
+    with FLoadDataProgressLabel do
+    begin
+      AnchorSideLeft.Control := FLoadDataLabel;
+      AnchorSideLeft.Side := asrCenter;
+      AnchorSideTop.Control := FLoadDataLabel;
+      AnchorSideTop.Side := asrBottom;
+      Caption := '-';
+    end
+  end;
+
+  FDelayedBoundsChangeTimer := TTimer.Create(Self);
+  with FDelayedBoundsChangeTimer do
+  begin
+    Enabled:=false;
+    Interval:=20;
+    OnTimer:=DelayedBoundsChange;
+  end;
+
+  FFetchDataThreadTimer := TTimer.Create(Self);
+  with FFetchDataThreadTimer do
+  begin
+    Enabled:=false;
+    Interval:=250;
+    OnTimer:=FetchDataThreadProgress;
+  end;
+
+  FEditingDoneTimer := TTimer.Create(Self);
+  with FEditingDoneTimer do
+  begin
+    Enabled:=false;
+    Interval:=2000;
+  end;
+
+  { default values for properties }
+  PageSize := 100;
+  PageIndex := -1;
+  FCanPage := true;
+  FCanSearch := true;
+  FTotalDataCount := -1;
+
+  {$IFDEF VISUALGRID_DEBUG}
+  with TButton.Create(Self) do
+  begin
+    Left := 0;
+    Top := 0;
+    Parent := Self;
+    OnClick := ClickTest;
+    Caption := 'Test';
+  end;
+  {$ENDIF}
+
+  FetchDataInThread := true;
+
+  { set single search mode as default }
+  FTopPanelMultiSearch.Visible := False;
+  FMultiSearchCheckComboBox.AddItem(sExpression, cbChecked);
+  SearchKindPopupMenuClick(FSingleSearchMenuItem);
+end;
+
+destructor TCustomVisualGrid.Destroy;
+begin
+  FColumns.Free;
+  FMultiSearchEdits.Free;
+  FCaption.Free;
+  inherited;
+end;
+
+procedure TCustomVisualGrid.DoDrawCell(Sender: TObject; ACol, ARow: Longint;
+  Rect: TRect; State: TGridDrawState; const RowData: Variant);
+var
+  LText: utf8string;
+begin
+  if ARow = 0 then
+  begin
+    if ACol < Length(ActiveDataTable.Columns) then
+      LText := ActiveDataTable.Columns[ACol]
+    else
+      raise EVisualGridError.CreateFmt(sImproperColumnIndex, [Length(ActiveDataTable.Columns)-1,ACol]);
+    FDrawGrid.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2, LText)
+  end
+  else
+    FDrawGrid.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2, RowData);
+end;
+
+procedure TCustomVisualGrid.Loaded;
+begin
+  inherited;
+  ReloadColumns;
+end;
+
+procedure TCustomVisualGrid.BoundsChanged;
+begin
+  inherited BoundsChanged;
+  // fix maximize form problem for AutoPageSize (new size of grid is not yet fully propagated)
+  FDelayedBoundsChangeTimer.Enabled:=true;
+end;
+
+procedure TCustomVisualGrid.DelayedBoundsChange(Sender: TObject);
+begin
+  // check data loading. try in next cycle
+  if FFetchDataThreadTimer.Enabled then
+    Exit;
+  FDelayedBoundsChangeTimer.Enabled:=false;
+  if AutoPageSize then
+    PageSize := ClientRowCount;
+end;
+
+procedure TCustomVisualGrid.FetchDataThreadProgress(Sender: TObject);
+{$J+}
+const
+  PROGRESS: Integer = 0;
+{$J-}
+  PROGRESS_CHARS: array[0..3] of string = ('-', '\', '|', '/');
+begin
+  FLoadDataProgressLabel.Caption := PROGRESS_CHARS[PROGRESS];
+  Inc(PROGRESS);
+  if PROGRESS > High(PROGRESS_CHARS) then
+    PROGRESS := 0;
+end;
+
+procedure TCustomVisualGrid.SearchButtonClick(Sender: TObject);
+var
+  //LFormat: TFormatSettings;
+  LNewStrFilter: utf8string;
+  LException: boolean = false;
+  e: TSearchEdit;
+
+  procedure AddExpression(const AExpression: utf8string;
+    ASearchCapability: PSearchCapability);
+  var
+    LSearchCapability: TSearchCapability;
+    LAccepted: TVisualGridFilters;
+    LColumnFilter: TColumnFilter;
+    LCandidates: TVisualGridFilters = [];
+    LExpressionRecord: TExpressionRecord;
+
+    procedure AddFilter(ASearchCapability: PSearchCapability);
+    var
+      LFilter: TVisualGridFilter;
+    begin
+      LAccepted := ASearchCapability.SupportedFilters * LCandidates;
+      if LAccepted = [] then
+        Exit;
+      for LFilter in LAccepted do
+      begin
+        LColumnFilter:=Default(TColumnFilter);
+        LColumnFilter.ColumnName := ASearchCapability.ColumnName;
+        LColumnFilter.Filter := LFilter;
+
+        if LFilter in TEXT_FILTER then
+        begin
+          SetLength(LColumnFilter.Values, 1);
+          LColumnFilter.Values[0]:=LExpressionRecord.Values[0];
+        end
+        else if LFilter in (NUMERIC_FILTER - [vgfNumericBetweenInclusive, vgfNumericBetweenExclusive]) then
+        begin
+          SetLength(LColumnFilter.Values, 1);
+          LColumnFilter.Values[0]:=StrToInt(LExpressionRecord.Values[0]);
+        end
+        else if LFilter in [vgfNumericBetweenInclusive, vgfNumericBetweenExclusive] then
+        begin
+          SetLength(LColumnFilter.Values, 2);
+          LColumnFilter.Values[0]:=StrToInt(LExpressionRecord.Values[0]);
+          LColumnFilter.Values[1]:=StrToInt(LExpressionRecord.Values[1]);
+        end;
+
+        SetLength(FFilter, Length(FFilter)+1);
+        FFilter[High(FFilter)] := LColumnFilter;
+      end;
+    end;
+
+  begin
+    try
+      LExpressionRecord := TSearchExpressionService.Parse(AExpression);
+    except
+      LException:=true;
+      raise;
+    end;
+
+    with LExpressionRecord do
+    begin
+      case Kind of
+        ekUnknown:
+          Exit;
+        ekNum:
+          case NumericComparisionKind of
+            // nckUnknown is special case - pure number can be text and num
+            nckUnknown: LCandidates := [vgfNumericEQ, vgfMatchTextExact];
+            nckNumericEQ: LCandidates := [vgfNumericEQ];
+            nckNumericLT: LCandidates := [vgfNumericLT];
+            nckNumericLTE: LCandidates := [vgfNumericLTE];
+            nckNumericGT: LCandidates := [vgfNumericGT];
+            nckNumericGTE: LCandidates := [vgfNumericGTE];
+          else
+            Assert(false);
+          end;
+        ekText:
+          case TextMatchKind of
+            tmkMatchTextExact: LCandidates := [vgfMatchTextExact];
+            tmkMatchTextBeginning: LCandidates := [vgfMatchTextBeginning];
+            tmkMatchTextEnd: LCandidates := [vgfMatchTextEnd];
+            tmkMatchTextAnywhere: LCandidates := [vgfMatchTextAnywhere]
+          else
+            Assert(false);
+          end;
+        ekSet:
+          case SetKind of
+            skNumericBetweenInclusive: LCandidates := [vgfNumericBetweenInclusive];
+            skNumericBetweenExclusive: LCandidates := [vgfNumericBetweenExclusive];
+          else
+            Assert(false);
+          end;
+      else
+        Assert(false);
+      end;
+      Assert(LCandidates<>[]);
+    end;
+
+    if Assigned(ASearchCapability) then
+      AddFilter(ASearchCapability)
+    else
+      for LSearchCapability in FSearchCapabilities do
+        AddFilter(@LSearchCapability);
+
+    LNewStrFilter := LNewStrFilter + QuotedStr(AExpression) + ',';
+  end;
+
+begin
+  if not Assigned(FDataSource) then
+    exit;
+
+  SetLength(FFilter, 0);
+  //LFormat.DecimalSeparator:='.';
+  try
+    AddExpression(FSearchEdit.Text, nil);
+    // multi column search
+    for e in FMultiSearchEdits do
+      if Assigned(e.SearchCapability) then
+        AddExpression(e.FEdit.Text, e.SearchCapability);
+  finally
+    // delete last comma
+    SetLength(LNewStrFilter, Length(LNewStrFilter)-1);
+    if not LException and (FStrFilter <> LNewStrFilter) then
+    begin
+      FStrFilter:=LNewStrFilter;
+      RefreshPageIndexData(false);
+    end;
+  end;
+end;
+
+procedure TCustomVisualGrid.ControlsEnable(AEnable: boolean);
+var
+  e: TSearchEdit;
+  LReadOnly: boolean;
+begin
+  LReadOnly:=not AEnable;
+  FMultiSearchCheckComboBox.Enabled:=AEnable;
+  FSearchEdit.ReadOnly:=LReadOnly;
+  FPageSizeEdit.ReadOnly:=LReadOnly;
+  FPageIndexEdit.ReadOnly:=LReadOnly;
+  FDrawGrid.Enabled:=AEnable;
+  FBottomRightPanel.Enabled:=AEnable;
+  for e in FMultiSearchEdits do
+    e.FEdit.ReadOnly:=LReadOnly;
+end;
+
+function TCustomVisualGrid.GetCells(ACol, ARow: Integer): Variant;
+begin
+  Result := ActiveDataTable.Rows[ARow]._(ACol);
+end;
+
+function TCustomVisualGrid.GetColCount: Integer;
+begin
+  Result := FColumns.Count;
+end;
+
+function TCustomVisualGrid.GetColumns(Index: Integer): TVisualColumn;
+begin
+  Result := FColumns[Index];
+end;
+
+function TCustomVisualGrid.GetActiveDataTable: PDataTable;
+begin
+  if FFetchDataThreadTimer.Enabled then
+    Result := FCachedDataTable
+  else
+    Result := @FDataTable;
+end;
+
+function TCustomVisualGrid.GetRowCount: Integer;
+begin
+  Result := Length(ActiveDataTable.Rows);
+end;
+
+function TCustomVisualGrid.GetRows(ARow: Integer): Variant;
+begin
+  Result := ActiveDataTable.Rows[ARow];
+end;
+
+function TCustomVisualGrid.GetSelection: TVisualGridSelection;
+var
+  i: Integer;
+begin
+  SetLength(Result.Selections, FDrawGrid.SelectedRangeCount);
+  for i := 0 to High(Result.Selections) do
+  begin
+    Result.Selections[i] := FDrawGrid.SelectedRange[i];
+    Result.Selections[i].Top:=Result.Selections[i].Top-1; // - fixed row
+    Result.Selections[i].Bottom:=Result.Selections[i].Bottom-1; // - fixed row
+  end;
+end;
+
+procedure TCustomVisualGrid.PageIndexEditingDone(Sender: TObject);
+var
+  LPageIndex: Integer;
+begin
+  if updPageIndex in FGUIUpdates then
+    Exit;
+  // value in edit has increased value by 1 (more readable for end user)
+  LPageIndex := Pred(StrToIntDef(FPageIndexEdit.Text, Succ(FPageIndex)));
+  if (LPageIndex < 0) then
+  begin
+    LPageIndex := 0;
+    SetPageIndexEditText('1');
+  end;
+  if (LPageIndex > FPageCount-1) then
+  begin
+    LPageIndex := FPageCount-1;
+    SetPageIndexEditText(IntToStr(FPageCount));
+  end;
+
+  PageIndex := LPageIndex;
+end;
+
+procedure TCustomVisualGrid.PageSizeEditingDone(Sender: TObject);
+var
+  LPageSize: Integer;
+begin
+  if updPageSize in FGUIUpdates then
+    Exit;
+  LPageSize:=StrToIntDef(FPageSizeEdit.Text, FPageSize);
+  if not CheckRangeForPageSize(LPageSize) then
+    SetPageSizeEditText(IntToStr(LPageSize));
+  PageSize:=LPageSize;
+end;
+
+procedure TCustomVisualGrid.PageNavigationClick(Sender: TObject);
+begin
+  if FPageCount = 0 then
+    Exit;
+  case TButton(Sender).Tag of
+    PAGE_NAVIGATION_FIRST: PageIndex := 0;
+    PAGE_NAVIGATION_PREVIOUS: PageIndex := PageIndex - 1;
+    PAGE_NAVIGATION_NEXT: PageIndex := PageIndex + 1;
+    PAGE_NAVIGATION_LAST: PageIndex := FPageCount - 1;
+  end;
+end;
+
+procedure TCustomVisualGrid.MultiSearchCheckComboBoxChange(Sender: TObject; AIndex: Integer);
+var
+  LState: PTCheckComboItemState;
+  LOldHasEdit, LNewHasEdit: boolean;
+
+  function HasOneOrMoreEdit: boolean;
+  var
+    LEdit: TSearchEdit;
+  begin
+    for LEdit in FMultiSearchEdits do
+      if LEdit.EditVisible then
+        exit(true);
+    Result := false
+  end;
+
+begin
+  LOldHasEdit := HasOneOrMoreEdit;
+  LState := PTCheckComboItemState(FMultiSearchCheckComboBox.Items.Objects[AIndex]);
+  if Assigned(LState^.Data) then
+    TSearchEdit(LState^.Data).EditVisible:=LState^.State=cbChecked
+  else
+    FSearchEdit.Visible:=LState^.State=cbChecked;
+
+  LNewHasEdit := HasOneOrMoreEdit;
+  FTopPanelMultiSearch.Visible := LNewHasEdit;
+
+  FSearchButton.Visible:=FSearchEdit.Visible or LNewHasEdit;
+
+  if LOldHasEdit <> LNewHasEdit then
+    LayoutChanged;
+end;
+
+function TCustomVisualGrid.GetCanvas: TCanvas;
+begin
+  Result := FDrawGrid.Canvas;
+end;
+
+procedure TCustomVisualGrid.SetCells(ACol, ARow: Integer; AValue: Variant);
+begin
+  TTableRowData(FDataTable.Rows[ARow]).vvalues[ACol] := AValue;
+  FDrawGrid.InvalidateCell(ACol, ARow);
+end;
+
+procedure TCustomVisualGrid.SetFetchDataInThread(AValue: boolean);
+begin
+  if FFetchDataInThread=AValue then Exit;
+  FFetchDataInThread:=AValue;
+end;
+
+procedure TCustomVisualGrid.SetOptions(AValue: TVisualGridOptions);
+begin
+  if FOptions=AValue then Exit;
+
+  FOptions:=AValue;
+  if vgoColSizing in FOptions then
+    FDrawGrid.Options := FDrawGrid.Options + [goColSizing]
+  else
+    FDrawGrid.Options := FDrawGrid.Options - [goColSizing];
+
+  FDrawGrid.AutoFillColumns:=vgoColAutoFill in FOptions;
+  FMultiSearchCheckComboBox.Visible:=vgoMultiSearchCheckComboBox in FOptions;
+end;
+
+procedure TCustomVisualGrid.SetRows(ARow: Integer; AValue: Variant);
+begin
+  FDataTable.Rows[ARow] := AValue;
+  FDrawGrid.InvalidateRow(ARow + 1); // + fixed row
+end;
+
+procedure TCustomVisualGrid.SetShowAllData(AValue: boolean);
+begin
+  if FShowAllData=AValue then
+    Exit;
+
+  FShowAllData:=AValue;
+  if FShowAllData then
+    AutoPageSize:=false;
+
+  HidePageSizeControls(not AValue);
+  HidePageNavigationControls(not AValue);
+  PageSize:=FTotalDataCount;
+end;
+
+procedure TCustomVisualGrid.SetAutoPageSize(AValue: boolean);
+
+begin
+  if FAutoPageSize=AValue then
+    Exit;
+
+  FAutoPageSize:=AValue;
+  if FAutoPageSize then
+    ShowAllData:=false;
+
+  HidePageSizeControls(not FAutoPageSize);
+
+  if FAutoPageSize then
+    FDrawGrid.ScrollBars:=ssNone
+  else
+    FDrawGrid.ScrollBars:=ssAutoBoth;
+
+  PageSize := ClientRowCount;
+end;
+
+procedure TCustomVisualGrid.SetCanPage(AValue: boolean);
+begin
+  if FCanPage=AValue then
+    Exit;
+
+  FCanPage:=AValue;
+  FBottomPanel.Visible:=FCanPage;
+  if csDesigning in ComponentState then
+    if FBottomPanel.Visible then
+      FBottomPanel.ControlStyle := FBottomPanel.ControlStyle - [csNoDesignVisible]
+    else
+      FBottomPanel.ControlStyle := FBottomPanel.ControlStyle + [csNoDesignVisible];
+
+  LayoutChanged;
+end;
+
+procedure TCustomVisualGrid.SetCanSearch(AValue: boolean);
+begin
+  if FCanSearch=AValue then
+    Exit;
+
+  FCanSearch:=AValue;
+  FTopPanel.Visible:=FCanSearch;
+  if csDesigning in ComponentState then
+    if FTopPanel.Visible then
+      FTopPanel.ControlStyle := FTopPanel.ControlStyle - [csNoDesignVisible]
+    else
+      FTopPanel.ControlStyle := FTopPanel.ControlStyle + [csNoDesignVisible];
+
+  LayoutChanged;
+end;
+
+procedure TCustomVisualGrid.RefreshGrid;
+begin
+
+end;
+
+procedure TCustomVisualGrid.RefreshPageIndexData(ARefreshColumns: boolean);
+begin
+  if Assigned(FDataSource) and FetchDataInThread then
+    TFetchDataThread.Create(Self, ARefreshColumns)
+  else
+  begin
+    BeforeFetchPage;
+    FLastFetchDataResult.FromThread:=false;
+    FLastFetchDataResult.RefreshColumns:=ARefreshColumns;
+    FetchPage(FLastFetchDataResult.FetchResult);
+    AfterFetchPage;
+  end;
+end;
+
+procedure TCustomVisualGrid.ResizeSearchEdit(ACol: Integer);
+var
+  LEdit: TSearchEdit;
+  LEditOnLeft, LEditOnRight: TSearchEdit;
+  //LFixedRect: TRect;
+  LRect: TRect;
+begin
+  LEdit := FMultiSearchEdits[ACol];
+  LEdit.Visible := FDrawGrid.IsFixedCellVisible(aCol, 0);
+  if ACol > 0 then
+    LEditOnLeft := FMultiSearchEdits[ACol-1]
+  else
+    LEditOnLeft := nil;
+
+  if ACol < FMultiSearchEdits.Count-1 then
+    LEditOnRight := FMultiSearchEdits[ACol+1]
+  else
+    LEditOnRight := nil;
+
+  if ACol = TDrawGridAccess(FDrawGrid).GCache.VisibleGrid.Right then
+    if Assigned(LEditOnRight) then
+      LEditOnRight.Visible:=false;
+  if ACol = TDrawGridAccess(FDrawGrid).GCache.VisibleGrid.Left then
+    begin
+      if Assigned(LEditOnLeft) then
+        if (ACol > FDrawGrid.FixedCols) or (not FDrawGrid.IsFixedCellVisible(ACol-1,0)) then
+          LEditOnLeft.Visible:=false
+    end;
+  // TODO : next column after fixed column
+  {if (ACol > 0) and (ACol = FDrawGrid.FixedCols) then
+  begin
+    fr := FDrawGrid.CellRect(aCol-1, aRow);
+
+    e.SetBounds(FDrawGrid.Left + fr.Right + 2, FDrawGrid.Top - e.Height, (aRect.Right - (fr.Right)) -1, e.Height);
+  end
+  else}
+  LRect := FDrawGrid.CellRect(ACol,0);
+  LEdit.FPanel.SetBounds(LRect.Left + 1, 0, LRect.Width - 2, LEdit.FEdit.Height);
+end;
+
+
+procedure TCustomVisualGrid.RefreshPageIndexAndGridInterface;
+begin
+  SetPageIndexEditText(IntToStr(Succ(FPageIndex)));
+  FPageCountLabel.Caption := Format('/%d',[FPageCount]);
+  FDrawGrid.Refresh;
+end;
+
+procedure TCustomVisualGrid.ReloadColumns;
+var
+  i: Integer;
+  LEdit: TSearchEdit;
+  p: PSearchCapability;
+  LColumn: TVisualColumn;
+
+  function SearchCapability: PSearchCapability;
+  var
+    j: Integer;
+  begin
+    for j := 0 to High(FSearchCapabilities) do
+      if FSearchCapabilities[j].ColumnName = FDataTable.Columns[i] then
+        Exit(@FSearchCapabilities[j]);
+    Result := nil;
+  end;
+
+begin
+  FDrawGrid.Columns.Clear;
+  FDrawGrid.Columns.BeginUpdate;
+  FColumns.Clear;
+  for i := 0 to High(FDataTable.Columns) do
+  begin
+    LColumn := TVisualColumn.Create(FDrawGrid.Columns.Add);
+    FColumns.Add(LColumn);
+    LColumn.StretchedToFill:=False;
+    LColumn.FColumn.Title.Caption:=''; //FDataTable.Columns[i]; already painted in default drawing event
+  end;
+  FDrawGrid.Columns.EndUpdate;
+  // TODO: may be optimized
+  FMultiSearchEdits.Clear;
+  FSearchButton.Visible := true;
+  FMultiSearchCheckComboBox.Clear;
+  FSearchCapabilities := Copy(FDataSource.SearchCapabilities);
+  for i := 0 to High(FDataTable.Columns) do
+  begin
+    LEdit := TSearchEdit.Create(FTopPanelMultiSearchClient, Self);
+    FMultiSearchEdits.Add(LEdit);
+    p := SearchCapability;
+    LEdit.EditVisible:=Assigned(p) and FMultiSearchMenuItem.Checked;
+    LEdit.SearchCapability := p;
+    ResizeSearchEdit(i);
+    if Assigned(p) then
+    begin
+      FMultiSearchCheckComboBox.AddItem(p^.ColumnName, cbChecked);
+      FMultiSearchCheckComboBox.Objects[FMultiSearchCheckComboBox.Items.Count-1] := LEdit;
+      FMultiSearchCheckComboBox.Checked[FMultiSearchCheckComboBox.Items.Count-1] := FMultiSearchMenuItem.Checked;
+    end;
+  end;
+  if FDrawGrid.Columns.Count > 0 then
+    FTopPanelMultiSearch.Height:=FMultiSearchEdits.Last.FPanel.Height;
+
+  // last item doesn't need to store object
+  FMultiSearchCheckComboBox.AddItem(sExpression, cbChecked);
+end;
+
+procedure TCustomVisualGrid.LayoutChanged;
+begin
+  // layout has changed, maybe more space is available
+  if AutoPageSize then
+    PageSize := ClientRowCount;
+end;
+
+function TCustomVisualGrid.ClientRowCount: Integer;
+begin
+  Result := ((FDrawGrid.ClientHeight - FDrawGrid.GridLineWidth) div FDrawGrid.DefaultRowHeight) - FDrawGrid.FixedRows;
+  if Result = 0 then
+    Result := 1;
+  FDrawGrid.VisibleRowCount;
+end;
+
+procedure TCustomVisualGrid.HidePageSizeControls(AVisible: boolean);
+begin
+  FPageSizeEdit.Visible:=AVisible;
+  FPageSizeLabel.Visible:=AVisible;
+end;
+
+procedure TCustomVisualGrid.HidePageNavigationControls(AVisible: boolean);
+begin
+  FBottomRightPanel.Visible:=AVisible;
+end;
+
+function TCustomVisualGrid.CheckRangeForPageSize(var APageSize: Integer
+  ): boolean;
+begin
+  if APageSize <= 0 then
+  begin
+    APageSize:=FPageSize;
+    Exit(False);
+  end
+  else if APageSize > 1000000 then
+  begin
+    APageSize:=1000000;
+    Exit(False);
+  end;
+  Result := True;
+end;
+
+procedure TCustomVisualGrid.SetDataSource(ADataSource: IDataSource);
+begin
+  if FDataSource = ADataSource then
+    Exit;
+
+  FDataSource := ADataSource;
+
+  RefreshPageIndexData(true);
+end;
+
+procedure TCustomVisualGrid.SetPageIndex(Value: Integer);
+begin
+  if Value >= FPageCount then
+    Value := FPageCount - 1;
+  if Value < 0 then
+    Value := 0;
+
+  if FPageIndex = Value then
+    Exit;
+
+  FPageIndex := Value;
+  RefreshPageIndexData(false)
+end;
+
+procedure TCustomVisualGrid.SetPageIndexEditText(const AStr: utf8string);
+begin
+  Include(FGUIUpdates, updPageIndex);
+  FPageIndexEdit.Text := AStr;
+  Exclude(FGUIUpdates, updPageIndex);
+end;
+
+procedure TCustomVisualGrid.SetPageSizeEditText(const AStr: utf8string);
+begin
+  Include(FGUIUpdates, updPageSize);
+  FPageSizeEdit.Text := AStr;
+  Exclude(FGUIUpdates, updPageSize);
+end;
+
+procedure TCustomVisualGrid.BeforeFetchPage;
+begin
+  if Assigned(FDataSource) then
+    if FPageIndex >= FPageCount then
+      FPageIndex := FPageCount - 1;
+end;
+
+procedure TCustomVisualGrid.FetchPage(out AResult: TPageFetchResult);
+begin
+  if Assigned(FDataSource) then
+    AResult := FDataSource.FetchPage(
+      TPageFetchParams.Create(FPageIndex, FPageSize, FFilter), FDataTable)
+  else
+    FillChar(AResult, SizeOf(AResult), #0);
+end;
+
+procedure TCustomVisualGrid.AfterFetchPage;
+begin
+  with FLastFetchDataResult do
+  if Assigned(FDataSource) then
+  begin
+    if FromThread then
+    begin
+      Dispose(FCachedDataTable);
+      FCachedDataTable := nil;
+      FFetchDataThreadTimer.Enabled:=false;
+      FLoadDataPanel.Visible:=False;
+      ControlsEnable(true);
+    end;
+
+    FPageCount:=FetchResult.PageCount;
+
+    if FetchResult.TotalDataCount >= 0 then
+      FTotalDataCount := FetchResult.TotalDataCount
+    else
+      FTotalDataCount := -1;
+
+    FAllRecordsCountLabel.Visible := FTotalDataCount<>-1;
+    FAllRecordsCountLabel.Caption:=Format(sTotal, [FTotalDataCount]);
+
+    FPageIndex := FetchResult.PageIndex;
+
+    if RefreshColumns then
+      ReloadColumns;
+    FDrawGrid.RowCount := Length(FDataTable.Rows) + 1;
+  end;
+  RefreshPageIndexAndGridInterface;
+end;
+
+procedure TCustomVisualGrid.SetPageSize(Value: Integer);
+begin
+  if FPageSize = Value then
+    Exit;
+
+  CheckRangeForPageSize(Value);
+  FPageSize := Value;
+  SetPageSizeEditText(IntToStr(FPageSize));
+  RefreshPageIndexData(false);
+end;
+
+procedure TCustomVisualGrid.SetSelectionType(AValue: TSelectionType);
+var
+  LSelectionEvent: boolean;
+begin
+  if FSelectionType=AValue then
+    Exit;
+
+  LSelectionEvent := FSelectionType=stNone;
+  FSelectionType:=AValue;
+  case FSelectionType of
+    stNone: FDrawGrid.Options:=FDefaultDrawGridOptions;
+    stCell: FDrawGrid.Options:=FDefaultDrawGridOptions+[goDrawFocusSelected];
+    stRow: FDrawGrid.Options:=FDefaultDrawGridOptions+[goRowSelect];
+    stMultiRow: FDrawGrid.Options:=FDefaultDrawGridOptions+[goRowSelect,goRangeSelect];
+  end;
+  if LSelectionEvent and Assigned(FOnSelection) then
+    FOnSelection(Self, Selection);
+end;
+
+procedure TCustomVisualGrid.StandardDrawCell(Sender: TObject; ACol,
+  ARow: Longint; Rect: TRect; State: TGridDrawState);
+var
+  LHandled: boolean;
+  LCellData: Variant;
+begin
+  LHandled := False;
+
+  if ARow = 0 then
+    ResizeSearchEdit(ACol);
+  if (ARow > 0) and Assigned(FDataSource) then
+    LCellData := ActiveDataTable^.Rows[ARow-1]._(ACol);
+
+  if Assigned(FOnDrawVisualCell) then
+    FOnDrawVisualCell(Self, ACol, ARow, Canvas, Rect, State, LCellData, LHandled);
+  if not LHandled then
+    DoDrawCell(Self, ACol, ARow, Rect, State, LCellData);
+end;
+
+procedure TCustomVisualGrid.GridMouseUp(Sender: TObject; Button: TMouseButton;
+  Shift: TShiftState; X, Y: Integer);
+var
+  LPopup: TPopupMenu;
+  LSelection: TVisualGridSelection;
+  i: integer;
+  LCol, LRow: longint;
+  LContains: boolean = false;
+begin
+  if Button = mbRight then
+    if (SelectionType <> stNone) and Assigned(FOnPreparePopupMenu) and
+       (FDrawGrid.MouseToGridZone(X, Y) = gzNormal) then
+    begin
+      FDrawGrid.MouseToCell(X, Y, LCol, LRow);
+      // fixed rows
+      Dec(LRow);
+      LSelection := Selection;
+      for i := 0 to High(LSelection.Selections) do
+        if not LContains then
+        begin
+          with LSelection.Selections[i] do
+            LContains := (LCol >= Left) and (LRow >= Top) and (LCol <= Right) and (LRow <= Bottom);
+          Break;
+        end;
+      if not LContains then
+        Exit;
+      FOnPreparePopupMenu(Self, LSelection, LPopup);
+      if Assigned(LPopup) then
+        with FDrawGrid.ClientToScreen(TPoint.Create(X, Y)) do
+          LPopup.PopUp(X, Y);
+    end;
+end;
+
+procedure TCustomVisualGrid.SearchKindPopupMenuClick(Sender: TObject);
+var
+  i: Integer;
+  LIsMultiSearch: boolean;
+begin
+  TMenuItem(Sender).Checked:=true;
+  LIsMultiSearch := Sender = FMultiSearchMenuItem;
+
+  // LIsMultiSearch
+  //   true: check almost all (except expression)
+  //   false: check only expression
+  for i := 0 to FMultiSearchCheckComboBox.Items.Count - 2 do
+    FMultiSearchCheckComboBox.Checked[i] := LIsMultiSearch;
+  FMultiSearchCheckComboBox.Checked[FMultiSearchCheckComboBox.Items.Count-1] := not LIsMultiSearch;
+end;
+
+procedure TCustomVisualGrid.GridSelection(Sender: TObject; aCol, aRow: Integer);
+begin
+  if (SelectionType <> stNone) and Assigned(FOnSelection) then
+    FOnSelection(Self, Selection);
+end;
+
+{$IFNDEF WINDOWS}
+initialization
+  {$I *.inc}
+{$ENDIF}
+end.
+

+ 1 - 0
Units/Utils/UVisualGrid.rc

@@ -0,0 +1 @@
+VISUALGRID_SEARCH RCDATA "..\\resources\\search-16.png"

+ 2 - 2
Units/Utils/UWizard.lfm

@@ -1,7 +1,7 @@
 object WizardHostForm: TWizardHostForm
 object WizardHostForm: TWizardHostForm
-  Left = 141
+  Left = 187
   Height = 120
   Height = 120
-  Top = 30
+  Top = 35
   Width = 360
   Width = 360
   BorderIcons = [biSystemMenu]
   BorderIcons = [biSystemMenu]
   Caption = 'Wizard'
   Caption = 'Wizard'

+ 6 - 3
Units/Utils/UWizard.pas

@@ -12,7 +12,9 @@
 
 
 unit UWizard;
 unit UWizard;
 
 
-{$mode delphi}
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
 
 
 interface
 interface
 
 
@@ -155,10 +157,11 @@ type
 
 
 implementation
 implementation
 
 
-uses UCommonUI;
-
 {$R *.lfm}
 {$R *.lfm}
 
 
+uses
+  UCommonUI;
+
 {%region TWizardForm }
 {%region TWizardForm }
 
 
 procedure TWizardForm<T>.Initialize;
 procedure TWizardForm<T>.Initialize;