dbgridehimpexp.pas

自己做的用delphi开发的学生成绩管理系统。

                for i := 0 to FooterRowCount - 1 do WriteFooter(Selection.Columns, i);
              end;
            gstAll:
              begin
                ExpCols := VisibleColumns;
                FooterValues := AllocMem(SizeOf(Currency) * ExpCols.Count * DBGridEh.FooterRowCount);
                WritePrefix;
                if dgTitles in Options then WriteTitle(VisibleColumns);
                First;
                while Eof = False do
                begin
                  WriteRecord(VisibleColumns);
                  CalcFooterValues;
                  Next;
                end;
                for i := 0 to FooterRowCount - 1 do WriteFooter(VisibleColumns, i);
              end;
          end;
        finally
          RestoreBookmark;
          EnableControls;
        end;
      end;
    end;
    WriteSuffix;
  finally
    FreeMem(FooterValues);
  end;
end;

procedure TDBGridEhExport.WriteTitle(ColumnsList: TColumnsEhList);
begin
end;

type TColCellParamsEhCracker = class(TColCellParamsEh) end;

procedure TDBGridEhExport.WriteRecord(ColumnsList: TColumnsEhList);
var i: Integer;
  AFont: TFont;
//    State:TGridDrawState;
begin
  AFont := TFont.Create;
  try
    for i := 0 to ColumnsList.Count - 1 do
    begin
      AFont.Assign(ColumnsList[i].Font);

      with TColCellParamsEhCracker(FColCellParamsEh) do
      begin
        FRow := -1;
        FCol := -1;
        FState := [];
        FFont := AFont;
        Background := ColumnsList[i].Color;
        Alignment := ColumnsList[i].Alignment;
        ImageIndex := ColumnsList[i].GetImageIndex;
        Text := ColumnsList[i].DisplayText;
        CheckboxState := ColumnsList[i].CheckboxState;

        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