dbutilseh.pas

最新的 DBGRIDEH4.0

      if IsReopen then
        DataSet.Open;
    finally
      DataSet.EnableControls;
    end;

  finally
    SQL.Free;
  end;
end;

function LocateDatasetTextEh(AGrid: TCustomDBGridEh;
  const FieldName, Text: String; AOptions: TLocateTextOptionsEh;
  Direction: TLocateTextDirectionEh; Matching: TLocateTextMatchingEh;
  TreeFindRange: TLocateTextTreeFindRangeEh): Boolean;
var
  FCurInListColIndex: Integer;

  function CheckEofBof: Boolean;
  begin
    if (Direction = ltdUpEh)
      then Result := AGrid.DataSource.DataSet.Bof
      else Result := AGrid.DataSource.DataSet.Eof;
  end;

  procedure ToNextRec;
  begin
    if ltoAllFieldsEh in AOptions then
      if (Direction = ltdUpEh) then
      begin
        if FCurInListColIndex > 0 then
          Dec(FCurInListColIndex)
        else
        begin
          AGrid.DataSource.DataSet.Prior;
          FCurInListColIndex := AGrid.VisibleColCount-1;
        end;
      end else
      begin
        if FCurInListColIndex < AGrid.VisibleColCount-1 then
          Inc(FCurInListColIndex)
        else
        begin
          AGrid.DataSource.DataSet.Next;
          FCurInListColIndex := 0;
        end;
      end
    else if (Direction = ltdUpEh) then
      AGrid.DataSource.DataSet.Prior
    else
      AGrid.DataSource.DataSet.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
    else
      Result := '';
  end;

  function AnsiContainsText(const AText, ASubText: string): Boolean;
  begin
    Result := AnsiPos(AnsiUppercase(ASubText), AnsiUppercase(AText)) > 0;
  end;

  function AnsiContainsStr(const AText, ASubText: string): Boolean;
  begin
    Result := AnsiPos(ASubText, AText) > 0;
  end;

  function IsEscapeInPressed: Boolean;
  var Msg: TMsg;
  begin
    Result := False;
    if PeekMessage(Msg, AGrid.Handle, WM_KEYDOWN, WM_KEYDOWN, PM_NOREMOVE) then
      if Msg.wParam = VK_ESCAPE then
        Result := True;
  end;

var
  DataText: String;
begin
  Result := False;
  if Assigned(AGrid) and Assigned(AGrid.DataSource) and Assigned(AGrid.DataSource.DataSet)
    and AGrid.DataSource.DataSet.Active
  then
  begin
//    FCurInListColIndex := AGrid.SelectedIndex;
    if FieldName <> '' then
      FCurInListColIndex := AGrid.VisibleColumns.IndexOf(AGrid.FieldColumns[FieldName])
    else
      FCurInListColIndex := AGrid.VisibleColumns.IndexOf(AGrid.Columns[AGrid.SelectedIndex]);
    if (AGrid.VisibleColCount = 0) then Exit;
    with AGrid do
    begin
      AGrid.DataSource.DataSet.DisableControls;
      SaveBookmark;
      try
//        if (Direction = ltdAllEh) and IsFirstTry then
        if (Direction = ltdAllEh) then
          AGrid.DataSource.DataSet.First
//        if not IsFirstTry then
//        if ltoIgnoteCurrentPosEh in AOptions then
        else
          ToNextRec;
        while not CheckEofBof do
        begin
          DataText := ColText(AGrid.VisibleColumns[FCurInListColIndex]);
          //CharCase
          if not (ltoCaseInsensitiveEh in AOptions) then
          begin
            //From any part of field
            if ( (Matching = ltmAnyPartEh) and (
                AnsiContainsStr(DataText, Text) )
               ) or (
            //Whole field
              (Matching = ltmWholeEh) and (DataText = Text)
              ) or ((Matching = ltmFromBegingEh) and
            //From beging of field
              (Copy(DataText, 1, Length(Text)) = Text) )
            then
            begin
              Result := True;
//              IsFirstTry := False;
              Break;
            end
          end else
          //From any part of field
          if ( (Matching = ltmAnyPartEh) and (
              AnsiContainsText(DataText, Text) )
             ) or (
          //Whole field
            (Matching = ltmWholeEh) and (
            AnsiUpperCase(DataText) =
            AnsiUpperCase(Text))
            ) or ((Matching = ltmFromBegingEh) and
          //From beging of field
            (AnsiUpperCase(Copy(DataText, 1, Length(Text))) =
            AnsiUpperCase(Text)) ) then
          begin
            Result := True;
            AGrid.SelectedIndex := AGrid.VisibleColumns[FCurInListColIndex].Index;
//            IsFirstTry := False;
            Break;
          end;
          if (ltoStopOnEscape in AOptions) and
             IsEscapeInPressed
          then
            Break;
          ToNextRec;
        end;
        if not Result then RestoreBookmark;
      finally
        AGrid.DataSource.DataSet.EnableControls;
      end;
//      if not RecordFounded then
//        ShowMessage(Format(SFindDialogStringNotFoundMessageEh, [cbText.Text]));
    end;
  end;
end;

{ Dataset Features }

var
  DatasetFeaturesList: TStringList;

procedure RegisterDatasetFeaturesEh(DatasetFeaturesClass: TDatasetFeaturesEhClass;
  DataSetClass: TDataSetClass);
var
  DatasetFeatures: TDatasetFeaturesEh;
  ClassIndex: Integer;
begin
  DatasetFeatures := DatasetFeaturesClass.Create;
  DatasetFeatures.FDataSetClass := DataSetClass;
  if DatasetFeatures.FDataSetClass = nil then
    Exit;
  ClassIndex := DatasetFeaturesList.IndexOf(DatasetFeatures.FDataSetClass.ClassName);
  if ClassIndex >= 0
    then DatasetFeaturesList.Objects[ClassIndex] := DatasetFeatures
    else DatasetFeaturesList.AddObject(DatasetFeatures.FDataSetClass.ClassName,
            DatasetFeatures);
end;

procedure UnregisterDatasetFeaturesEh(DataSetClass: TDataSetClass);
var
  idx: Integer;
begin
  idx := DatasetFeaturesList.IndexOf(DataSetClass.ClassName);
  if idx >= 0 then
  begin
//    Dispose(Pointer(DatasetFeaturesList.Objects[idx]));
    TObject(DatasetFeaturesList.Objects[idx]).Free;
    DatasetFeaturesList.Delete(idx);
  end;
end;

function GetDatasetFeaturesForDataSetClass(DataSetClass: TClass): TDatasetFeaturesEh;

  function GetDatasetFeaturesDeep(DataSetClass: TClass; DataSetClassName: String): Integer;
  begin
    Result := 0;
    while True do
    begin
      if UpperCase(DataSetClass.ClassName) = UpperCase(DataSetClassName) then
        Exit;
      Inc(Result);
      DataSetClass := DataSetClass.ClassParent;
      if DataSetClass = nil then
      begin
        Result := MAXINT;
        Exit;
      end;
    end;
  end;

var
  Deep, MeenDeep, i: Integer;
  ClassName: String;
begin
  Result := nil;
  MeenDeep := MAXINT;
  for i := 0 to DatasetFeaturesList.Count - 1 do
  begin
    if DataSetClass.InheritsFrom(TDatasetFeaturesEh(DatasetFeaturesList.Objects[i]).FDataSetClass) then
    begin
      ClassName := TDatasetFeaturesEh(DatasetFeaturesList.Objects[i]).FDataSetClass.ClassName;
      Deep := GetDatasetFeaturesDeep(DataSetClass, ClassName);
      if Deep < MeenDeep then
      begin
        MeenDeep := Deep;
        Result := TDatasetFeaturesEh(DatasetFeaturesList.Objects[i]);
      end;
    end;
  end;
end;

function GetDatasetFeaturesForDataSet(DataSet: TDataSet): TDatasetFeaturesEh;
begin
  Result := GetDatasetFeaturesForDataSetClass(DataSet.ClassType);
end;

procedure DisposeDatasetFeaturesList;
begin
  while DatasetFeaturesList.Count > 0 do
  begin
//    Dispose(Pointer(DatasetFeaturesList.Objects[0]));
    TObject(DatasetFeaturesList.Objects[0]).Free;
    DatasetFeaturesList.Delete(0);
  end;
  FreeAndNil(DatasetFeaturesList);
//  DatasetFeaturesList := nil;
end;

{ TDatasetFeaturesEh }

procedure TDatasetFeaturesEh.ApplyFilter(Sender: TObject; DataSet: TDataSet; IsReopen: Boolean);
begin
end;

procedure TDatasetFeaturesEh.ApplySorting(Sender: TObject; DataSet: TDataSet; IsReopen: Boolean);
begin
end;

constructor TDatasetFeaturesEh.Create;
begin
  inherited Create;
end;

function TDatasetFeaturesEh.LocateText(AGrid: TCustomDBGridEh;
  const FieldName, Text: String; AOptions: TLocateTextOptionsEh;
  Direction: TLocateTextDirectionEh; Matching: TLocateTextMatchingEh;
  TreeFindRange: TLocateTextTreeFindRangeEh): Boolean;
begin
  Result := LocateDatasetTextEh(AGrid, FieldName, Text, AOptions, Direction, Matching, TreeFindRange);
end;

function TDatasetFeaturesEh.MoveRecords(Sender: TObject; BookmarkList: TStrings;
  ToRecNo: Integer; CheckOnly: Boolean): Boolean;
var
  va: array of Variant;
  vs: array of Boolean;
//  bm: TBookmarkStr;
  i, j: Integer;
  IsAppend: Boolean;
  DataSet: TDataSet;
  LocBookmarkList: TStringList;
begin
  Result := False;
  LocBookmarkList := nil;
  if (Sender is TDBGridEh)
    then DataSet := TDBGridEh(Sender).DataSource.DataSet
    else Exit;
  Result := DataSet.CanModify;
  if CheckOnly or not Result then Exit;
  DataSet.DisableControls;
  try
    LocBookmarkList := TStringList.Create;
    LocBookmarkList.Assign(BookmarkList);
    if ToRecNo >= DataSet.RecordCount
      then IsAppend := True
      else IsAppend := False;
//    bm := DataSet.Bookmark;
    SetLength(va, BookmarkList.Count);
    SetLength(vs, BookmarkList.Count);
    for i := 0 to LocBookmarkList.Count-1 do
    begin
      DataSet.Bookmark := LocBookmarkList[i];
      va[i] := VarArrayCreate([0, DataSet.Fields.Count], varVariant);
      for j := 0 to DataSet.Fields.Count-1 do
        va[i][j] := DataSet.Fields[j].Value;
      if (i > 0) and (ToRecNo > DataSet.RecNo) then
        Dec(ToRecNo);
      vs[i] := TDBGridEh(Sender).SelectedRows.CurrentRowSelected;
      TDBGridEh(Sender).SelectedRows.CurrentRowSelected := False;
    end;
    for i := 0 to LocBookmarkList.Count-1 do
    begin
      DataSet.Bookmark := LocBookmarkList[i];
      DataSet.Delete;
    end;
    for i := Length(va)-1 downto 0 do
    begin
      if IsAppend then
        DataSet.Append
      else
      begin
        if i < Length(va)-1
          then DataSet.Next
          else DataSet.RecNo := ToRecNo;
        DataSet.Insert;
      end;
      for j := 0 to DataSet.Fields.Count-1 do
        if DataSet.Fields[j].CanModify then
          DataSet.Fields[j].Value := va[i][j];
      DataSet.Post;
      TDBGridEh(Sender).SelectedRows.CurrentRowSelected := vs[i];
    end;
//    DataSet.Bookmark := bm;
  finally
    LocBookmarkList.Free;
    DataSet.EnableControls;
  end;
end;

procedure TDatasetFeaturesEh.ExecuteFindDialog(Sender: TObject;
  Text, FieldName: String; Modal: Boolean);
begin
  if (Sender is TDBGridEh) then
    ExecuteDBGridEhFindDialogProc(TDBGridEh(Sender), Text, '', nil, Modal);
end;

{ TSQLDatasetFeaturesEh }

procedure TSQLDatasetFeaturesEh.ApplyFilter(Sender: TObject;
  DataSet: TDataSet; IsReopen: Boolean);
begin
  if TDBGridEh(Sender).STFilter.Local then
  begin
    TDBGridEh(Sender).DataSource.DataSet.Filter :=
      GetExpressionAsFilterString(TDBGridEh(Sender),
        GetOneExpressionAsLocalFilterString, nil, False, SupportsLocalLike);
    TDBGridEh(Sender).DataSource.DataSet.Filtered := True;        
  end else
    ApplyFilterSQLBasedDataSet(TDBGridEh(Sender), DateValueToSQLString, IsReopen, SQLPropName);
end;

procedure TSQLDatasetFeaturesEh.ApplySorting(Sender: TObject; DataSet: TDataSet; IsReopen: Boolean);
begin
  if Sender is TCustomDBGridEh then
    if TCustomDBGridEh(Sender).SortLocal then
      raise Exception.Create(Format ('TSQLDatasetFeaturesEh can not sort data ' +
        'in dataset "%s" in local mode', [DataSet.Name]))
    else
      ApplySortingForSQLBasedDataSet(TCustomDBGridEh(Sender), DataSet,
        SortUsingFieldName, IsReopen, SQLPropName);
end;

constructor TSQLDatasetFeaturesEh.Create;
begin
  inherited Create;
  SQLPropName := 'SQL';
end;

{ TCommandTextDatasetFeaturesEh }

constructor TCommandTextDatasetFeaturesEh.Create;
begin
  inherited Create;
  SQLPropName := 'CommandText';
end;

initialization
  DatasetFeaturesList := TStringList.Create;
  //  DatasetFeaturesList.CaseSensitive := False;
  DatasetFeaturesList.Duplicates := dupError;
finalization
  DisposeDatasetFeaturesList;
end.