dbutilseh.pas

EHLIB控件源码,很好用的表格控件,可进行统计求和功能.

    OldDecimalSeparator: String;
{$ELSE}
    OldDecimalSeparator: Char;
{$ENDIF}
  begin
    if VarType(v) = varDouble then
    begin
      OldDecimalSeparator := DecimalSeparator;
      DecimalSeparator := '.';
      try
        Result := FloatToStr(v);
      finally
        DecimalSeparator := OldDecimalSeparator;
      end;
    end
    else if VarType(v) = varDate then
      if @DateValueToSQLStringProc <> nil then
        Result := DateValueToSQLStringProc(DataSet, v)
      else
        Result := '''' + VarToStr(v) + ''''
    else
      Result := '''' + VarToStr(v) + '''';
  end;

var
  i: Integer;
  theNOT: String;
begin
  if O in [foIn, foNotIn] then
  begin
    if O = foNotIn then
      theNOT := ' NOT'
    else
      theNOT := '';
    Result := Result + FieldName + theNOT + ' IN (';
    if VarIsArray(v) then
      for i := VarArrayLowBound(v, 1) to VarArrayHighBound(v, 1) do
        Result := Result + VarValueAsFilterStr(v[i]) + ','
    else
      Result := Result + VarValueAsFilterStr(v) + ',';
    Delete(Result, Length(Result), 1);
    Result := Result + ')';
  end else
  begin
    Result := Result + ' ' + FieldName + ' ' + STFilterOperatorsSQLStrMapEh[O];
    if not (O in [foNull, foNotNull]) then
      Result := Result + ' ' + VarValueAsFilterStr(v);
  end;
end;

function DateValueToDataBaseSQLString(DataBaseName: String; v: Variant): String;
var
{$IFDEF CIL}
  OldDateSeparator: String;
{$ELSE}
  OldDateSeparator: Char;
{$ENDIF}
begin
  DataBaseName := UpperCase(DataBaseName);
  if DataBaseName = 'STANDARD' then
    Result := '''' + VarToStr(v) + ''''
  else if DataBaseName = 'ORACLE' then
    Result := 'TO_DATE(''' + FormatDateTime(ShortDateFormat, v) + ''',''' + ShortDateFormat + ''')'
  else if DataBaseName = 'INTRBASE' then
    Result := '''' + VarToStr(v) + ''''
  else if DataBaseName = 'INFORMIX' then
    Result := '''' + VarToStr(v) + ''''
  else if DataBaseName = 'MSACCESS' then
  begin
    OldDateSeparator := DateSeparator;
    try
      DateSeparator := '/';
      Result := '#' + FormatDateTime('MM/DD/YYYY', v) + '#';
    finally
      DateSeparator := OldDateSeparator;
    end;
  end
  else if DataBaseName = 'MSSQL' then
    Result := '''' + VarToStr(v) + ''''
  else if DataBaseName = 'SYBASE' then
    Result := '''' + VarToStr(v) + ''''
  else if DataBaseName = 'DB2' then
    Result := '''' + VarToStr(v) + ''''
  else
    Result := '''' + VarToStr(v) + '''';
end;

procedure ApplyFilterSQLBasedDataSet(Grid: TCustomDBGridEh;
  DateValueToSQLString: TDateValueToSQLStringProcEh; IsReopen: Boolean;
  SQLPropName: String);
var
  i, OrderLine: Integer;
  s: String;
  SQL: TStrings;
  SQLPropValue: WideString;
begin
  if not IsDataSetHaveSQLLikeProp(Grid.DataSource.DataSet, SQLPropName, SQLPropValue) then
    raise Exception.Create(Grid.DataSource.DataSet.ClassName + ' is not SQL based dataset');

  SQL := TStringList.Create;
  try
    SQL.Text := SQLPropValue;

    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;
    Grid.DataSource.DataSet.DisableControls;
    try
      if Grid.DataSource.DataSet.Active then
        Grid.DataSource.DataSet.Close;
      SQL.Strings[OrderLine] := SQLFilterMarker + ' (' + s + ')';
      SetDataSetSQLLikeProp(Grid.DataSource.DataSet, SQLPropName, SQL.Text);
      if IsReopen then
        Grid.DataSource.DataSet.Open;
    finally
      Grid.DataSource.DataSet.EnableControls;
    end;

  finally
    SQL.Free;
  end;
end;

{ Sorting }

function IsSQLBasedDataSet(DataSet: TDataSet; var SQL: TStrings): Boolean;
var
  FPropInfo: PPropInfo;
begin
  Result := False;
  SQL := nil;
  FPropInfo := GetPropInfo(DataSet.ClassInfo, 'SQL');
  if FPropInfo = nil then Exit;
  if PropType_getKind(PropInfo_getPropType(FPropInfo)) = tkClass then
  try
    SQL := (TObject(GetOrdProp(DataSet, FPropInfo)) as TStrings);
  except // if PropInfo is not TStrings or not inherited of
  end;

  if SQL <> nil then
    Result := True;
end;

function IsDataSetHaveSQLLikeProp(DataSet: TDataSet; SQLPropName: String; var SQLPropValue: WideString): Boolean;
var
  FPropInfo: PPropInfo;
begin
  Result := False;
  SQLPropValue := '';
  FPropInfo := GetPropInfo(DataSet.ClassInfo, SQLPropName);
  if FPropInfo = nil then Exit;
  if PropType_getKind(PropInfo_getPropType(FPropInfo)) = tkString then
    SQLPropValue := GetStrProp(DataSet, FPropInfo)
{$IFDEF EH_LIB_6}
  else if PropType_getKind(PropInfo_getPropType(FPropInfo)) = tkWString then
    SQLPropValue := GetWideStrProp(DataSet, FPropInfo)
{$ELSE}
  else if PropType_getKind(PropInfo_getPropType(FPropInfo)) = tkWString then
    SQLPropValue := GetStrProp(DataSet, FPropInfo)
{$ENDIF}
  else if PropType_getKind(PropInfo_getPropType(FPropInfo)) = tkClass then
    try
      if (TObject(GetOrdProp(DataSet, FPropInfo)) as TStrings) <> nil then
        SQLPropValue := (TObject(GetOrdProp(DataSet, FPropInfo)) as TStrings).Text
      else
        Exit;
    except // if PropInfo is not TStrings or not inherited of
    end
  else Exit;
  Result := True;
end;

procedure ApplySortingForSQLBasedDataSet(Grid: TCustomDBGridEh; DataSet: TDataSet;
   UseFieldName: Boolean; IsReopen: Boolean; SQLPropName: String);

  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;
  SQLPropValue: WideString;
begin
  if not IsDataSetHaveSQLLikeProp(DataSet, SQLPropName, SQLPropValue) then
    raise Exception.Create(DataSet.ClassName + ' is not SQL based dataset');

  SQL := TStringList.Create;
  try
    SQL.Text := SQLPropValue;

    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;

    DataSet.DisableControls;
    try
      if DataSet.Active then
        DataSet.Close;
      SetDataSetSQLLikeProp(DataSet, SQLPropName, SQL.Text);
      if IsReopen then
        DataSet.Open;
    finally
      DataSet.EnableControls;
    end;

  finally
    SQL.Free;
  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;
  DatasetFeaturesList.Free;
  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.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;

{ 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.