dbgridehimpexp.pas

ehlib 4.2.16 表格控件 for delphi 5-2009

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: AnsiString;
begin
  CheckFirstCell;
  s := AnsiString(FColCellParamsEh.Text);
  StreamWriteAnsiString(Stream, s);
//  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: AnsiString;
begin
  CheckFirstCell;
  s := AnsiString(Text);
  StreamWriteAnsiString(Stream, s);
//  Stream.Write(PChar(s)^, Length(s));
end;

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

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

{ TDBGridEhExportAsUnicodeText }

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

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

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

procedure TDBGridEhExportAsUnicodeText.WritePrefix;
begin
end;

procedure TDBGridEhExportAsUnicodeText.WriteSuffix;
begin
end;

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

procedure TDBGridEhExportAsUnicodeText.WriteDataCell(Column: TColumnEh; FColCellParamsEh: TColCellParamsEh);
var
  s: WideString;
begin
  CheckFirstCell;
  s := WideString(FColCellParamsEh.Text);
  StreamWriteWideString(Stream, s);
end;

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

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

procedure TDBGridEhExportAsUnicodeText.CheckFirstRec;
var
  s: WideString;
begin
  if FirstRec = False then
  begin
    s := #13#10;
    StreamWriteWideString(Stream, s);
  end else
    FirstRec := False;
end;

{ TDBGridEhExportAsCVS }

procedure TDBGridEhExportAsCSV.CheckFirstCell;
var
  s: AnsiString;
begin
  if FirstCell = False then
  begin
    s := Separator;
    StreamWriteAnsiString(Stream, s);
  end else
    FirstCell := False;
end;

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

procedure TDBGridEhExportAsCSV.WriteDataCell(Column: TColumnEh; FColCellParamsEh: TColCellParamsEh);
var s: AnsiString;
begin
  CheckFirstCell;
  s := AnsiString(AnsiQuotedStr(FColCellParamsEh.Text, '"'));
  StreamWriteAnsiString(Stream, s);
//  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: AnsiString;
begin
  CheckFirstCell;
  s := AnsiString(AnsiQuotedStr(Text, '"'));
  StreamWriteAnsiString(Stream, s);
//  Stream.Write(PChar(s)^, Length(s));
end;

procedure TDBGridEhExportAsCSV.WriteTitle(ColumnsList: TColumnsEhList);
var i: Integer;
  s: AnsiString;
begin
  CheckFirstRec;
  for i := 0 to ColumnsList.Count - 1 do
  begin
    s := AnsiString(AnsiQuotedStr(ColumnsList[i].Title.Caption, '"'));
    if i <> ColumnsList.Count - 1 then
      s := s + Separator;
    StreamWriteAnsiString(Stream, s);
//    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;
  TTitleExpArr = array of TTitleExpRec;

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: TTitleExpArr;
  var ListOfHeadTreeNodeList: TList);
var i: Integer;
  NeedNextStep: Boolean;
  MinHeight: Integer;
  FHeadTreeNodeList: TList;
begin
  ListOfHeadTreeNodeList := nil;
//  FPTitleExpArr := AllocMem(SizeOf(TTitleExpRec) * ColumnsList.Count);
  SetLength(FPTitleExpArr, 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
  StreamWriteAnsiString(Stream, AnsiString(Text));
//  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>');

  PutL('<BODY>');

  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;
  FPTitleExpArr: TTitleExpArr;
  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('>');
            PutText(DBGridEh.TitleFont,
              THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[k]).Items[i]).Text);
            PutL('</TD>');
          end;
        end;
        PutL('</TR>');
      end;

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

    finally
      for i := 0 to ListOfHeadTreeNodeList.Count - 1 do
        TList(ListOfHeadTreeNodeList.Items[i]).Free;