dbgridehimpexp.pas

Delphi控件源码

      if Assigned(DBGridEh.OnGetFooterParams) then
        DBGridEh.OnGetFooterParams(DBGridEh, ColumnsList[i].Index, FooterNo,
            ColumnsList[i], Font, Background, Alignment, State, Value);
      WriteFooterCell(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; AFont: TFont; Background: TColor);
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;
              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;
          ftFloat,ftCurrency:
            with Field as TFloatField do
            begin
             if EditFormat = '' then FmtStr := DisplayFormat else FmtStr := EditFormat;
             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;
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;
  AFont: TFont; Background: TColor);
var s:String;
begin
  CheckFirstCell;
  s := Column.DisplayText;
  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;
  AFont: TFont; Background: TColor);
var s:String;
begin
  CheckFirstCell;
  s := AnsiQuotedStr(Column.DisplayText,'"');
  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 }

procedure TDBGridEhExportAsHTML.Put(Text: String);
begin
  Stream.Write(PChar(Text)^, Length(Text));
end;

procedure TDBGridEhExportAsHTML.PutL(Text: String);
begin
  Put(Text + #13#10);
end;

procedure TDBGridEhExportAsHTML.WritePrefix;
var s:String;
    CellPaddingInc:String;
begin
  PutL('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">');
  PutL('<HTML>');
  PutL('<HEAD>');
  PutL('<TITLE>');
  PutL(DBGridEh.Name);
  PutL('</TITLE>');
  PutL('</HEAD>');

  s := '<TABLE ';
  if DBGridEh.Flat then CellPaddingInc := '1' else CellPaddingInc := '2';
  if DBGridEh.Options * [dgColLines,dgRowLines] <> [] then
    if DBGridEh.Ctl3D then s := s + 'BORDER=1 CELLSPACING=0 CELLPADDING=' + CellPaddingInc
    else s := s + 'BORDER=0 CELLSPACING=1 CELLPADDING=' + CellPaddingInc
  else
    s := s + 'BORDER=0 CELLSPACING=0 CELLPADDING=' + CellPaddingInc;
  s := s + ' BGCOLOR=#' + GetColor(DBGridEh.FixedColor) + #13#10;
  PutL(s);
end;

procedure TDBGridEhExportAsHTML.WriteSuffix;
begin
  PutL('</TABLE>');
  PutL('</BODY>');
  PutL('</HTML>');
end;

procedure TDBGridEhExportAsHTML.WriteTitle(ColumnsList: TColumnsEhList);
var i,k:Integer;
    FPTitleExpArr: PTitleExpArr;
    ListOfHeadTreeNodeList:TList;
    ColSpan,RowSpan:Integer;
begin
  if ColumnsList.Count = 0 then Exit;

  if DBGridEh.UseMultiTitle then
  begin
    try
      CreateMultiTitleMatrix(DBGridEh,ColumnsList,FPTitleExpArr,ListOfHeadTreeNodeList);

      for k := ListOfHeadTreeNodeList.Count-1 downto 1 do
      begin
        PutL('<TR>');
        for i := 0 to ColumnsList.Count-1 do
        begin
          if THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[k]).Items[i]) <> nil then
          begin
            Put('  <TD ALIGN="CENTER"');
            CalcSpan(ColumnsList,ListOfHeadTreeNodeList,k,i,ColSpan,RowSpan);
            if ColSpan > 1 then
              Put(' COLSPAN = "' + IntToStr(ColSpan) + '"');
            if RowSpan > 1 then
              Put(' ROWSPAN = "' + IntToStr(RowSpan) + '"');
            Put('>');