dbgridehimpexp.pas

最新的 DBGRIDEH4.0

                WritePrefix;
                if dgTitles in Options then WriteTitle(VisibleColumns);
                for i := 0 to Selection.Rows.Count - 1 do
                begin
                  Bookmark := Selection.Rows[I];
                  CalcFooterValues;
                  WriteRecord(VisibleColumns);
                end;
                for i := 0 to FooterRowCount - 1 do WriteFooter(VisibleColumns, i);
              end;
            gstRectangle:
              begin
                ColList := TColumnsEhList.Create;
                try
                  for i := Selection.Rect.LeftCol to Selection.Rect.RightCol do
                    if Columns[i].Visible then
                      ColList.Add(Columns[i]);
                  ExpCols := ColList;
//                  FooterValues := AllocMem(SizeOf(Currency) * ExpCols.Count * DBGridEh.FooterRowCount);
                  SetLength(FooterValues, ExpCols.Count * DBGridEh.FooterRowCount);
                  WritePrefix;
                  if dgTitles in Options then WriteTitle(ColList);
                  Bookmark := Selection.Rect.TopRow;
                  while True do
                  begin
                    WriteRecord(ColList);
                    CalcFooterValues;
//                    if CompareBookmarks(Pointer(Selection.Rect.BottomRow), Pointer(Bookmark)) = 0 then Break;
                    if DataSetCompareBookmarks(DBGridEh.DataSource.Dataset, Selection.Rect.BottomRow, Bookmark) = 0 then Break;
                    Next;
                    if Eof then Break;
                  end;
                  for i := 0 to FooterRowCount - 1 do WriteFooter(ColList, i);
                finally
                  ColList.Free;
                end;
              end;
            gstColumns:
              begin
                ExpCols := Selection.Columns;
//                FooterValues := AllocMem(SizeOf(Currency) * ExpCols.Count * DBGridEh.FooterRowCount);
                SetLength(FooterValues, ExpCols.Count * DBGridEh.FooterRowCount);
                WritePrefix;
                if dgTitles in Options then WriteTitle(Selection.Columns);
                First;
                while Eof = False do
                begin
                  WriteRecord(Selection.Columns);
                  CalcFooterValues;
                  Next;
                end;
                for i := 0 to FooterRowCount - 1 do WriteFooter(Selection.Columns, i);
              end;
            gstAll:
              begin
                ExpCols := VisibleColumns;
//                FooterValues := AllocMem(SizeOf(Currency) * ExpCols.Count * DBGridEh.FooterRowCount);
                SetLength(FooterValues, 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 TColCellParamsEhCr acker = class(TColCellParamsEh) end;

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

      with FColCellParamsEh do
      begin
        Row := -1;
        Col := -1;
        State := [];
        Font := AFont;
        Background := ColumnsList[i].Color;
        NewBackground := 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], Font, NewBackground, State);

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

        Background := NewBackground;

        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
  FreeAndNil(FColCellParamsEh);
  inherited Destroy;
end;

{ TDBGridEhExportAsText }

procedure StreamWriteString(Stream: TStream; S: String);
{$IFDEF CIL}
var
  b: TBytes;
{$ENDIF}
begin
{$IFDEF CIL}
    b := BytesOf(S);
    Stream.Write(b, Length(b));
{$ELSE}
    Stream.Write(PChar(S)^, Length(S));
{$ENDIF}
end;

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

procedure TDBGridEhExportAsText.CheckFirstCell;
var s: String;
begin
  if FirstCell = False then
  begin
    s := #09;
    StreamWriteString(Stream, s);
//    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;
    StreamWriteString(Stream, s);
//    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;
    StreamWriteString(Stream, s);
//    Stream.Write(PChar(s)^, Length(s))
  end else
    FirstCell := False;
end;