dbgridehimpexp.pas

ehlib 4.2.16 表格控件 for delphi 5-2009

var
  ms: TMemoryStream;
begin
  ms := nil;
  Clipboard.Open;
  try
    ms := TMemoryStream.Create;

    if Clipboard.HasFormat(CF_VCLDBIF) then
    begin
      Clipboard_GetToStream(CF_VCLDBIF, ms);
      ms.Position := 0;
      ReadDBGridEhFromImportStream(TDBGridEhImportAsVCLDBIF, DBGridEh, ms, ForWholeGrid);
    end
    else if Clipboard.HasFormat(CF_UNICODETEXT) then
    begin
      Clipboard_GetToStream(CF_UNICODETEXT, ms);
      ms.Position := 0;
      ReadDBGridEhFromImportStream(TDBGridEhImportAsUnicodeText, DBGridEh, ms, ForWholeGrid);
    end
    else if Clipboard.HasFormat(CF_TEXT) then
    begin
      Clipboard_GetToStream(CF_TEXT, ms);
      ms.Position := 0;
      ReadDBGridEhFromImportStream(TDBGridEhImportAsText, DBGridEh, ms, ForWholeGrid);
    end;

  finally
    ms.Free;
    Clipboard.Close;
  end;
end;

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

procedure StreamWriteWideString(Stream: TStream; S: WideString);
{$IFDEF CIL}
var
  b: TBytes;
{$ENDIF}
begin
{$IFDEF CIL}
    b := BytesOf(S);
    Stream.Write(b, Length(b));
{$ELSE}
    Stream.Write(PWideChar(S)^, Length(S)*2);
{$ENDIF}
end;

{ TDBGridEhExport }

procedure TDBGridEhExport.ExportToFile(FileName: String; IsExportAll: Boolean);
var FileStream: TFileStream;
begin
  FileStream := TFileStream.Create(FileName, fmCreate);
  try
    ExportToStream(FileStream, IsExportAll);
  finally
    FileStream.Free;
  end;
end;

procedure TDBGridEhExport.ExportToStream(AStream: TStream; IsExportAll: Boolean);
var i: Integer;
  ColList: TColumnsEhList;
  ASelectionType: TDBGridEhSelectionType;
begin
  Stream := AStream;
  try
    with DBGridEh do
    begin
      if IsExportAll then ASelectionType := gstAll else ASelectionType := Selection.SelectionType;
      if ASelectionType = gstNon then Exit;
      with DataSource.Dataset do
      begin
        DisableControls;
        SaveBookmark;
        try
          case ASelectionType of
            gstRecordBookmarks:
              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);
                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 Result := IntToStr(Integer(v))
                  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 TDBGridEhExportAsText.WriteTitle(ColumnsList: TColumnsEhList);
var i: Integer;
  s: AnsiString;
begin
  CheckFirstRec;
  for i := 0 to ColumnsList.Count - 1 do
  begin
    s := AnsiString(ColumnsList[i].Title.Caption);
    if i <> ColumnsList.Count - 1 then
      s := s + #09;
    StreamWriteAnsiString(Stream, s);
  end;