ehlibmte.pas

最新的 DBGRIDEH4.0

{*******************************************************}
{                                                       }
{                     EhLib v4.2                        }
{          Registers object that sort data in           }
{                  TCustomMemTableEh                    }
{                    (Build 4.2.03)                     }
{                                                       }
{    Copyright (c) 2003-2006 by Dmitry V. Bolshakov     }
{                                                       }
{*******************************************************}

{*******************************************************}
{ Add this unit to 'uses' clause of any unit of your    }
{ project to allow TDBGridEh to sort data in            }
{ TMemTableEh automatically after sorting markers       }
{ will be changed.                                      }
{ TMTEDatasetFeaturesEh determine if                    }
{ TDBGridEh.SortLocal = True then it will sort data     }
{ in memory using procedure SortByFields                }
{ else if SortLocal = False and MemTable connected to   }
{ other  DataSet via ProviderDataSet, it will try to    }
{ sord data in this DataSet using                       }
{ GetDatasetFeaturesForDataSet function                 }
{*******************************************************}

unit EhLibMTE;

{$I EhLib.Inc}

interface

uses
{$IFDEF EH_LIB_6} Variants, {$ENDIF}
  DbUtilsEh, DBGridEh, Db, MemTableEh, MemTableDataEh, DataDriverEh,
  SysUtils, ToolCtrlsEh;

type

  TMTEDatasetFeaturesEh = class(TSQLDatasetFeaturesEh)
  protected
    FBaseNode: TMemRecViewEh;
  public
    constructor Create; override;
    function LocateText(AGrid: TCustomDBGridEh; const FieldName: string;
      const Text: String; AOptions: TLocateTextOptionsEh; Direction: TLocateTextDirectionEh;
      Matching: TLocateTextMatchingEh; TreeFindRange: TLocateTextTreeFindRangeEh): Boolean; override;
    procedure ApplyFilter(Sender: TObject; DataSet: TDataSet; IsReopen: Boolean); override;
    procedure ApplySorting(Sender: TObject; DataSet: TDataSet; IsReopen: Boolean); override;
    procedure ExecuteFindDialog(Sender: TObject; Text, FieldName: String; Modal: Boolean); override;
  end;

var
  SortInView: Boolean;

implementation

uses Classes;

type
  TCustomDBGridEhCrack = class(TCustomDBGridEh) end;
  TDataDriverEhCrack = class(TDataDriverEh) end;

procedure ApplySortingForSQLDataDriver(Grid: TCustomDBGridEh; SQLDriver: TSQLDataDriverEh;
   UseFieldName: Boolean);

  function DeleteStr(str: String; sunstr: String): String;
  var
    i: Integer;
  begin
    i := Pos(sunstr, str);
    if i <> 0 then
      Delete(str, i, Length(sunstr));
    Result := str;
  end;

var
  i, OrderLine: Integer;
  s: String;
  SQL: TStrings;
begin

  SQL := TStringList.Create;
  try
    SQL.Text := SQLDriver.SelectSQL.Text;

    s := '';
    for i := 0 to Grid.SortMarkedColumns.Count - 1 do
    begin
      if UseFieldName
        then s := s + Grid.SortMarkedColumns[i].FieldName
        else s := s + IntToStr(Grid.SortMarkedColumns[i].Field.FieldNo);
      if Grid.SortMarkedColumns[i].Title.SortMarker = smUpEh
        then s := s + ' DESC, '
        else s := s + ', ';
    end;

    if s <> '' then
      s := 'ORDER BY ' + Copy(s, 1, Length(s) - 2);

    OrderLine := -1;
    for i := 0 to SQL.Count - 1 do
      if UpperCase(Copy(SQL[i], 1, Length('ORDER BY'))) = 'ORDER BY' then
      begin
        OrderLine := i;
        Break;
      end;
    if OrderLine = -1 then
    begin
      SQL.Add('');
      OrderLine := SQL.Count-1;
    end;

    SQL.Strings[OrderLine] := s;

    SQLDriver.SelectSQL := SQL;

  finally
    SQL.Free;
  end;
end;

procedure ApplyFilterForSQLDataDriver(Grid: TCustomDBGridEh; SQLDriver: TSQLDataDriverEh;
  DateValueToSQLString: TDateValueToSQLStringProcEh);
var
  i, OrderLine: Integer;
  s: String;
  SQL: TStrings;
begin

  SQL := TStringList.Create;
  try
    SQL.Text := SQLDriver.SelectSQL.Text;

    OrderLine := -1;
    for i := 0 to SQL.Count - 1 do
      if UpperCase(Copy(SQL[i], 1, Length(SQLFilterMarker))) = UpperCase(SQLFilterMarker) then
      begin
        OrderLine := i;
        Break;
      end;
    s := GetExpressionAsFilterString(Grid, GetOneExpressionAsSQLWhereString, DateValueToSQLString, True);
    if s = '' then
      s := '1=1';
    if OrderLine = -1 then
      Exit;

    SQL.Strings[OrderLine] := SQLFilterMarker + ' (' + s + ')';
    SQLDriver.SelectSQL := SQL;

  finally
    SQL.Free;
  end;
end;

function LocateTextInTree(AGrid: TCustomDBGridEh;
  const FieldName, Text: String; AOptions: TLocateTextOptionsEh;
  Direction: TLocateTextDirectionEh; Matching: TLocateTextMatchingEh;
  TreeFindRange: TLocateTextTreeFindRangeEh; BaseNode: TMemRecViewEh): Boolean;
var
  FCurInListColIndex: Integer;
  TreeListPos: Integer;
  MemTable: TCustomMemTableEh;
  TreeList: TMemoryTreeListEh;
  RootNode, NextNode: TMemRecViewEh;

  function CheckEofBof: Boolean;
  begin
    if (Direction = ltdUpEh)
//      then Result := (TreeListPos < 0)
//      else Result := (TreeListPos > TreeList.AccountableCount-1);
      then Result := (NextNode = nil)
      else Result := (NextNode = nil);
  end;

  procedure First;
  begin
    TreeListPos := 0;
    MemTable.InstantReadLeave;
    if TreeFindRange = lttInCurrentLevelEh then
    begin
      RootNode := BaseNode.NodeParent.VisibleNodeItems[0];
      NextNode := RootNode;
    end else if TreeFindRange = lttInCurrentNodeEh then
    begin
      RootNode := BaseNode;
      NextNode := RootNode;
    end else
      NextNode := TreeList.AccountableItem[TreeListPos];
    MemTable.InstantReadEnter(NextNode, -1);
  end;

  procedure Next;
  begin
    Inc(TreeListPos);
    if TreeFindRange = lttInCurrentLevelEh then
    begin
      if (NextNode.NodeParent.VisibleNodesCount-1 = NextNode.VisibleNodeIndex)
      then
        NextNode := nil
      else
        NextNode := NextNode.NodeParent.VisibleNodeItems[NextNode.VisibleNodeIndex + 1];
    end else if TreeFindRange = lttInCurrentNodeEh then
    begin
      if NextNode.VisibleNodesCount > 0 then
        NextNode := NextNode.VisibleNodeItems[0]
      else if (NextNode <> BaseNode) and
              (NextNode.NodeParent.VisibleNodesCount-1 > NextNode.VisibleNodeIndex) then
        NextNode := NextNode.NodeParent.VisibleNodeItems[NextNode.VisibleNodeIndex + 1]
      else
      begin
        while (NextNode <> BaseNode) and (NextNode.NodeParent.VisibleNodesCount-1 = NextNode.VisibleNodeIndex)  do
          NextNode := NextNode.NodeParent;
        if NextNode = BaseNode
          then NextNode := nil
          else NextNode := NextNode.NodeParent.VisibleNodeItems[NextNode.VisibleNodeIndex + 1];
      end;
    end else
    begin
      if TreeListPos <= TreeList.AccountableCount-1 then
        NextNode := TreeList.AccountableItem[TreeListPos]
      else
        NextNode := nil;
    end;
    if NextNode <> nil then
    begin
      MemTable.InstantReadLeave;
      MemTable.InstantReadEnter(NextNode, -1);
    end;
  end;

  procedure Prior;
  begin
    Dec(TreeListPos);
    if TreeFindRange = lttInCurrentLevelEh then
    begin
      if NextNode.VisibleNodeIndex = 0
      then
        NextNode := nil
      else
        NextNode := NextNode.NodeParent.VisibleNodeItems[NextNode.VisibleNodeIndex - 1];
    end else if TreeFindRange = lttInCurrentNodeEh then
    begin
{      if NextNode.VisibleNodeIndex > 0 then
      begin
        NextNode := NextNode.NodeParent.VisibleNodeItems[NextNode.VisibleNodeIndex - 1];
        if NextNode.VisibleNodesCount > 0 then
          NextNode := NextNode.VisibleNodeItems[NextNode.VisibleNodesCount-1];
      end else if (NextNode.NodeParent.NodeParent <> nil)
      then
        NextNode := NextNode.NodeParent
      else
        NextNode := nil;}
      if (TreeListPos >= 0) and
       ((TreeList.AccountableItem[TreeListPos].NodeLevel > BaseNode.NodeLevel) or
        (TreeList.AccountableItem[TreeListPos] = BaseNode)) then
        NextNode := TreeList.AccountableItem[TreeListPos]
      else
        NextNode := nil;
    end else
    begin
      if TreeListPos >= 0 then
        NextNode := TreeList.AccountableItem[TreeListPos]
      else
        NextNode := nil;
    end;
    if NextNode <> nil then
    begin
      MemTable.InstantReadLeave;
      MemTable.InstantReadEnter(NextNode, -1);
    end;
  end;

  procedure ToNextRec;
  begin
    if ltoAllFieldsEh in AOptions then
      if (Direction = ltdUpEh) then
      begin
        if FCurInListColIndex > 0 then
          Dec(FCurInListColIndex)
        else
        begin
          Prior;
          FCurInListColIndex := AGrid.VisibleColCount-1;
        end;
      end else
      begin
        if FCurInListColIndex < AGrid.VisibleColCount-1 then
          Inc(FCurInListColIndex)
        else
        begin
          Next;
          FCurInListColIndex := 0;
        end;
      end
    else if (Direction = ltdUpEh) then
      Prior
    else
      Next;
  end;

  function ColText(Col: TColumnEh): String;
  begin
    if ltoMatchFormatEh in AOptions then
      Result := Col.DisplayText
    else if Col.Field <> nil then
      Result := Col.Field.AsString