dbgridehimpexp.pas

1、开发环境 d6 up2,sqlserver2000, win2000 server 1024*768（笔记本电脑） c/s 2、数据库配置方法

        if Assigned(DBGridEh.OnGetCellParams) then
          DBGridEh.OnGetCellParams(DBGridEh,ColumnsList[i],FFont,FBackground,FState);

        ColumnsList[i].GetColCellParams(False,FColCellParamsEh);

        WriteDataCell(ColumnsList[i],FColCellParamsEh);

      end;
    end;
  finally
    AFont.Free;
  end;
end;

procedure TDBGridEhExport.WriteFooter(ColumnsList:TColumnsEhList; FooterNo:Integer);
var i:Integer;
    Font:TFont;
    Background: TColor;
    State:TGridDrawState;
    Alignment:TAlignment;
    Value:String;
begin
  Font := TFont.Create;
  try
    for i := 0 to ColumnsList.Count-1 do
    begin
      Font.Assign(ColumnsList[i].UsedFooter(FooterNo).Font);
      Background := ColumnsList[i].UsedFooter(FooterNo).Color;
      Alignment := ColumnsList[i].UsedFooter(FooterNo).Alignment;
      if ColumnsList[i].UsedFooter(FooterNo).ValueType in [fvtSum,fvtCount] then
        Value := GetFooterValue(FooterNo,i)
      else
        Value := DBGridEh.GetFooterValue(FooterNo,ColumnsList[i]);
      State := [];
      if Assigned(DBGridEh.OnGetFooterParams) then
        DBGridEh.OnGetFooterParams(DBGridEh, ColumnsList[i].Index, FooterNo,
            ColumnsList[i], Font, Background, Alignment, State, Value);
      WriteFooterCell(i{ColumnsList[i].Index}, FooterNo, ColumnsList[i], Font, Background,
        Alignment, Value);
    end;
  finally
    Font.Free;
  end;
end;

procedure TDBGridEhExport.WritePrefix;
begin
end;

procedure TDBGridEhExport.WriteSuffix;
begin
end;

procedure TDBGridEhExport.WriteDataCell(Column: TColumnEh; FColCellParamsEh: TColCellParamsEh);
begin
end;

procedure TDBGridEhExport.WriteFooterCell(DataCol, Row: Integer; Column: TColumnEh;
            AFont: TFont; Background: TColor; Alignment: TAlignment; Text: String);
begin
end;

procedure TDBGridEhExport.CalcFooterValues;
var i,j:Integer;
    Field:TField;
    Footer:TColumnFooterEh;
begin
  for i := 0 to DBGridEh.FooterRowCount - 1 do
    for j := 0 to ExpCols.Count - 1 do
    begin
      Footer := ExpCols[j].UsedFooter(i);
      if Footer.FieldName <> '' then
        Field := DBGridEh.DataSource.DataSet.FindField(Footer.FieldName)
      else
        Field := DBGridEh.DataSource.DataSet.FindField(ExpCols[j].FieldName);
      if Field = nil then Continue;
      case Footer.ValueType of
        fvtSum:
          if (Field.IsNull = False) then
            FooterValues[i*ExpCols.Count+j] := FooterValues[i*ExpCols.Count+j] + Field.AsFloat;
        fvtCount:
          FooterValues[i*ExpCols.Count+j] := FooterValues[i*ExpCols.Count+j] + 1;
      end;
    end;
end;

function TDBGridEhExport.GetFooterValue(Row, Col: Integer): String;
var
  FmtStr: string;
  Format: TFloatFormat;
  Digits: Integer;
  v:Variant;
  Field:TField;
begin
  Result := '';
  case ExpCols[Col].UsedFooter(Row).ValueType of
    fvtSum:
    begin
      if ExpCols[Col].UsedFooter(Row).FieldName <> '' then
        Field := DBGridEh.DataSource.DataSet.FindField(ExpCols[Col].UsedFooter(Row).FieldName)
      else
        Field := DBGridEh.DataSource.DataSet.FindField(ExpCols[Col].FieldName);
      if Field = nil then Exit;
      with Field do begin
        v := FooterValues[Row*ExpCols.Count+Col];
        case DataType of
          ftSmallint, ftInteger, ftAutoInc, ftWord:
             with Field as TIntegerField do
             begin
               FmtStr := DisplayFormat;
               if FmtStr = '' then Str(Integer(v), Result) else Result := FormatFloat(FmtStr, v);
             end;
          ftBCD:
            with Field as TBCDField do
            begin
              //if EditFormat = '' then FmtStr := DisplayFormat else FmtStr := EditFormat;
              FmtStr := DisplayFormat;
              if FmtStr = '' then
              begin
                if Currency then
                begin
                  Format := ffCurrency;
                  Digits := CurrencyDecimals;
                end else
                begin
                  Format := ffGeneral;
                  Digits := 0;
                end;
                Result := CurrToStrF(v, Format, Digits);
              end else
                Result := FormatCurr(FmtStr, v);
            end;
          {$IFDEF EH_LIB_6}
          ftFMTBcd:
            with Field as TFMTBCDField do
            begin
              //if EditFormat = '' then FmtStr := DisplayFormat else FmtStr := EditFormat;
              FmtStr := DisplayFormat;
              if FmtStr = '' then
              begin
                if Currency then
                begin
                  Format := ffCurrency;
                  Digits := CurrencyDecimals;
                end else
                begin
                  Format := ffGeneral;
                  Digits := 0;
                end;
                Result := CurrToStrF(v, Format, Digits);
              end else
                Result := FormatCurr(FmtStr, v);
            end;
           {$ENDIF}
          ftFloat,ftCurrency:
            with Field as TFloatField do
            begin
             //if EditFormat = '' then FmtStr := DisplayFormat else FmtStr := EditFormat;
             FmtStr := DisplayFormat;
             if FmtStr = '' then
             begin
                if Currency then
                begin
                  Format := ffCurrency;
                  Digits := CurrencyDecimals;
                end else
                begin
                  Format := ffGeneral;
                  Digits := 0;
                end;
                 Result := FloatToStrF(v, Format, Precision, Digits);
              end else
                Result := FormatFloat(FmtStr, v);
            end;
          end;
        end;
    end;
    fvtCount: Result := FloatToStr(FooterValues[Row*ExpCols.Count+Col]);
  end;
end;


constructor TDBGridEhExport.Create;
begin
  inherited Create;
  FColCellParamsEh := TColCellParamsEh.Create;
end;

destructor TDBGridEhExport.Destroy;
begin
  FColCellParamsEh.Free;
  inherited Destroy;
end;

{ TDBGridEhExportAsText }

procedure TDBGridEhExportAsText.WriteTitle(ColumnsList:TColumnsEhList);
var i:Integer;
    s:String;
begin
  CheckFirstRec;
  for i := 0 to ColumnsList.Count-1 do
  begin
    s := ColumnsList[i].Title.Caption;
    if i <> ColumnsList.Count-1 then
      s := s + #09;
    Stream.Write(PChar(s)^, Length(s));
  end;
end;

procedure TDBGridEhExportAsText.WriteRecord(ColumnsList:TColumnsEhList);
begin
  CheckFirstRec;
  FirstCell := True;
  inherited WriteRecord(ColumnsList);
end;

procedure TDBGridEhExportAsText.WriteFooter(ColumnsList:TColumnsEhList; FooterNo:Integer);
begin
  CheckFirstRec;
  FirstCell := True;
  inherited WriteFooter(ColumnsList,FooterNo);
end;

procedure TDBGridEhExportAsText.WritePrefix;
begin
end;

procedure TDBGridEhExportAsText.WriteSuffix;
begin
end;

procedure TDBGridEhExportAsText.ExportToStream(Stream: TStream;
  IsExportAll: Boolean);
begin
  FirstRec := True;
  inherited ExportToStream(Stream,IsExportAll);
end;

procedure TDBGridEhExportAsText.WriteDataCell(Column: TColumnEh; FColCellParamsEh: TColCellParamsEh);
var s:String;
begin
  CheckFirstCell;
  s := FColCellParamsEh.Text;
  Stream.Write(PChar(s)^, Length(s));
end;

procedure TDBGridEhExportAsText.WriteFooterCell(DataCol, Row: Integer;
  Column: TColumnEh; AFont: TFont; Background: TColor;
  Alignment: TAlignment; Text: String);
var s:String;
begin
  CheckFirstCell;
  s := Text;
  Stream.Write(PChar(s)^, Length(s));
end;

procedure TDBGridEhExportAsText.CheckFirstCell;
var s:String;
begin
  if FirstCell = False then
  begin
    s := #09;
    Stream.Write(PChar(s)^, Length(s))
  end else
    FirstCell := False;
end;

procedure TDBGridEhExportAsText.CheckFirstRec;
var s:String;
begin
  if FirstRec = False then
  begin
    s := #13#10;
    Stream.Write(PChar(s)^, Length(s))
  end else
    FirstRec := False;
end;

{ TDBGridEhExportAsCVS }

procedure TDBGridEhExportAsCSV.CheckFirstCell;
var s:String;
begin
  if FirstCell = False then
  begin
    s := Separator;
    Stream.Write(PChar(s)^, Length(s))
  end else
    FirstCell := False;
end;

constructor TDBGridEhExportAsCSV.Create;
begin
  Separator := DBGridEhImpExpCsvSeparator;
  inherited Create;
end;

procedure TDBGridEhExportAsCSV.WriteDataCell(Column: TColumnEh; FColCellParamsEh: TColCellParamsEh);
var s:String;
begin
  CheckFirstCell;
  s := AnsiQuotedStr(FColCellParamsEh.Text,'"');
  Stream.Write(PChar(s)^, Length(s));
end;

procedure TDBGridEhExportAsCSV.WriteFooterCell(DataCol, Row: Integer;
  Column: TColumnEh; AFont: TFont; Background: TColor;
  Alignment: TAlignment; Text: String);
var s:String;
begin
  CheckFirstCell;
  s := AnsiQuotedStr(Text,'"');
  Stream.Write(PChar(s)^, Length(s));
end;

procedure TDBGridEhExportAsCSV.WriteTitle(ColumnsList: TColumnsEhList);
var i:Integer;
    s:String;
begin
  CheckFirstRec;
  for i := 0 to ColumnsList.Count-1 do
  begin
    s := AnsiQuotedStr(ColumnsList[i].Title.Caption,'"');
    if i <> ColumnsList.Count-1 then
      s := s + Separator;
    Stream.Write(PChar(s)^, Length(s));
  end;
end;

{ Routines to convert MultiTitle in matrix (List of Lists) }

type
  TTitleExpRec = record
    Height:Integer;
    PTLeafCol:THeadTreeNode;
  end;

  PTitleExpRec = ^TTitleExpRec;
  TTitleExpArr = array[0..MaxListSize - 1] of TTitleExpRec;
  PTitleExpArr = ^TTitleExpArr;

procedure CalcSpan(
    ColumnsList:TColumnsEhList; ListOfHeadTreeNodeList:TList;
    Row,Col: Integer;
    var AColSpan:Integer; var ARowSpan:Integer
                  );
var Node:THeadTreeNode;
    i,k:Integer;
begin
  AColSpan := 1; ARowSpan := 1;
  Node := THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[Row]).Items[Col]);
  if Node <> nil then
  begin
    for k := Row-1 downto 0 do
      if THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[k]).Items[Col]) = Node
      then
      begin
        Inc(ARowSpan);
        TList(ListOfHeadTreeNodeList.Items[k]).Items[Col] := nil;
      end else
        Break;

    for i := Col+1 to ColumnsList.Count-1 do
      if THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[Row]).Items[i]) = Node
      then
      begin
        Inc(AColSpan);
        TList(ListOfHeadTreeNodeList.Items[Row]).Items[i] := nil;
      end else
        Break;

    for k := Row-1 downto Row-ARowSpan+1 do
      for i := Col+1 to Col+AColSpan-1 do
        TList(ListOfHeadTreeNodeList.Items[k]).Items[i] := nil;
  end;
end;

procedure CreateMultiTitleMatrix(DBGridEh:TCustomDBGridEh;
                                 ColumnsList:TColumnsEhList;
                                 var FPTitleExpArr:PTitleExpArr;
                                 var ListOfHeadTreeNodeList:TList);
var i:Integer;
    NeedNextStep:Boolean;
    MinHeight:Integer;
    FHeadTreeNodeList:TList;
begin
  ListOfHeadTreeNodeList := nil;
  FPTitleExpArr := AllocMem(SizeOf(TTitleExpRec)*ColumnsList.Count);
  for i := 0 to ColumnsList.Count-1 do
  begin
    FPTitleExpArr[i].Height := DBGridEh.LeafFieldArr[ColumnsList[i].Index].FLeaf.Height;
    FPTitleExpArr[i].PTLeafCol := DBGridEh.LeafFieldArr[ColumnsList[i].Index].FLeaf;
  end;
  ListOfHeadTreeNodeList := TList.Create;
  NeedNextStep := True;
  while True do
  begin
    //search min height
    MinHeight := FPTitleExpArr[0].Height;
    for i := 1 to ColumnsList.Count-1 do
      if FPTitleExpArr[i].Height < MinHeight then
        MinHeight := FPTitleExpArr[i].Height;
    //add NodeList
    FHeadTreeNodeList := TList.Create;
    for i := 0 to ColumnsList.Count-1 do
    begin
      FHeadTreeNodeList.Add(FPTitleExpArr[i].PTLeafCol);
      if FPTitleExpArr[i].Height = MinHeight then
      begin
        if FPTitleExpArr[i].PTLeafCol.Host <> nil then
        begin
          FPTitleExpArr[i].PTLeafCol := FPTitleExpArr[i].PTLeafCol.Host;
          Inc(FPTitleExpArr[i].Height,FPTitleExpArr[i].PTLeafCol.Height);
          NeedNextStep := True;
        end;
      end;
    end;
    if not NeedNextStep then Break;
    ListOfHeadTreeNodeList.Add(FHeadTreeNodeList);
    NeedNextStep := False;
  end;
end;

{ TDBGridEhExportAsHTML }