dbgridehimpexp.pas

Delphi控件源码

    for i := 0 to ColumnsList.Count-1 do
    begin
      WriteCellBorder(True,True,True,True);
      Inc(w,Trunc(ColumnsList[i].Width / fLogPelsX * 1440)); // in twips
      Put('\clshdng10000\clcfpat'+IntToStr(GetColorIndex((ColumnsList[i].Title.Color))));
      PutL('\cellx'+IntToStr(w));
    end;

    PutL('{\trrh0');

    for i := 0 to ColumnsList.Count-1 do
    begin
      if DBGridEh.Flat then Space := '12' else Space := '24';
      Put('\pard\intbl{'+GetAlignment(ColumnsList[i].Title.Alignment)+'\sb'+Space+'\sa'+Space);
      PutText(ColumnsList[i].Title.Font,ColumnsList[i].Title.Caption,ColumnsList[i].Title.Color);
      PutL('\cell}');
    end;

    PutL('\pard\intbl\row}');
  end;
end;

procedure TDBGridEhExportAsRTF.WriteRecord(ColumnsList: TColumnsEhList);
var fLogPelsX: Integer;
    i,w: Integer;
begin
  Put('\trowd');
  PutL('\trgaph40');

  fLogPelsX :=  GetDeviceCaps(DBGridEh.Canvas.Handle, LOGPIXELSX);

  w := 0;
  for i := 0 to ColumnsList.Count-1 do
  begin
    WriteCellBorder(True,True,True,True);
    Inc(w,Trunc(ColumnsList[i].Width / fLogPelsX * 1440)); // in twips
    Put('\clshdng10000\clcfpat' + IntToStr(GetColorIndex(GetDataCellColor(ColumnsList,i))));
    PutL('\cellx'+IntToStr(w));
  end;

  PutL('{\trrh0');

  inherited WriteRecord(ColumnsList);

  PutL('\pard\intbl\row}');
end;

procedure TDBGridEhExportAsRTF.WriteDataCell(Column: TColumnEh;
  AFont: TFont; Background: TColor);
var Space:String;
begin
  if DBGridEh.Flat then Space := '12' else Space := '24';
  Put('\pard\intbl{'+GetAlignment(Column.Alignment)+'\sb'+Space+'\sa'+Space);
  PutText(AFont,Column.DisplayText,Background);
  PutL('\cell}');
end;

procedure TDBGridEhExportAsRTF.WriteCellBorder(LeftBorder,TopBorder,BottomBorder,RightBorder:Boolean);
begin
  if LeftBorder then
  begin
    Put('\clbrdrl');
    Put('\brdrs');
    PutL('\brdrcf0');
  end;

  if TopBorder then
  begin
    Put('\clbrdrt');
    Put('\brdrs');
    PutL('\brdrcf0');
  end;

  if BottomBorder then
  begin
    Put('\clbrdrb');
    Put('\brdrs');
    PutL('\brdrcf0');
  end;

  if RightBorder then
  begin
    Put('\clbrdrr');
    Put('\brdrs');
    PutL('\brdrcf0');
  end;
end;

procedure TDBGridEhExportAsRTF.WriteFooter(ColumnsList: TColumnsEhList;
  FooterNo: Integer);
var fLogPelsX: Integer;
    i,w: Integer;
begin
  Put('\trowd');
  PutL('\trgaph40');

  fLogPelsX :=  GetDeviceCaps(DBGridEh.Canvas.Handle, LOGPIXELSX);

  w := 0;
  for i := 0 to ColumnsList.Count-1 do
  begin
    WriteCellBorder(True,True,True,True);
    Inc(w,Trunc(ColumnsList[i].Width / fLogPelsX * 1440)); // in twips
    Put('\clshdng10000\clcfpat'+
      IntToStr(GetColorIndex(GetFooterCellColor(ColumnsList,i,FooterNo))));
    PutL('\cellx'+IntToStr(w));
  end;

  PutL('{\trrh0'); // row auto-height

  inherited WriteFooter(ColumnsList,FooterNo);

  PutL('\pard\intbl\row}');
end;

procedure TDBGridEhExportAsRTF.WriteFooterCell(DataCol, Row: Integer;
  Column: TColumnEh; AFont: TFont; Background: TColor;
  Alignment: TAlignment; Text: String);
var Space: String;
begin
  if DBGridEh.Flat then Space := '12' else Space := '24';
  Put('\pard\intbl{'+GetAlignment(Alignment)+'\sb'+Space+'\sa'+Space);
  PutText(AFont,Text,Background);
  PutL('\cell}');
end;

function TDBGridEhExportAsRTF.GetDataCellColor(ColumnsList:TColumnsEhList;
  ColIndex:Integer): TColor;
var Font:TFont;
    State:TGridDrawState;
begin
  Font := TFont.Create;
  try
    Font.Assign(ColumnsList[ColIndex].Font);
    Result := ColumnsList[ColIndex].Color;
    State := [];
    if Assigned(DBGridEh.OnGetCellParams) then
      DBGridEh.OnGetCellParams(DBGridEh,ColumnsList[ColIndex],Font,Result,State);
  finally
    Font.Free;
  end;
end;

function TDBGridEhExportAsRTF.GetFooterCellColor(
  ColumnsList: TColumnsEhList; ColIndex: Integer; FooterNo:Integer): TColor;
var Font:TFont;
    State:TGridDrawState;
    Alignment:TAlignment;
    Value:String;
begin
  Font := TFont.Create;
  try
    Font.Assign(ColumnsList[ColIndex].UsedFooter(FooterNo).Font);
    Result := ColumnsList[ColIndex].UsedFooter(FooterNo).Color;
    Alignment := ColumnsList[ColIndex].UsedFooter(FooterNo).Alignment;
    if ColumnsList[ColIndex].UsedFooter(FooterNo).ValueType in [fvtSum,fvtCount] then
      Value := GetFooterValue(FooterNo,ColIndex)
    else
      Value := DBGridEh.GetFooterValue(FooterNo,ColumnsList[ColIndex]);
    State := [];
    if Assigned(DBGridEh.OnGetFooterParams) then
      DBGridEh.OnGetFooterParams(DBGridEh, ColumnsList[ColIndex].Index, FooterNo,
          ColumnsList[ColIndex], Font, Result, Alignment, State, Value);
  finally
    Font.Free;
  end;
end;

{ TDBGridEhExportAsXLS }

const
  CXlsBof: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
  CXlsEof: array[0..1] of Word = ($0A, 00);
  CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
  CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
  CXlsRk: array[0..4] of Word = ($27E, 10, 0, 0, 0);

procedure TDBGridEhExportAsXLS.WriteFloatCell(const AValue: Double);
begin
  CXlsNumber[2] := FRow;
  CXlsNumber[3] := FCol;
  Stream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));
  Stream.WriteBuffer(AValue, 8);
  IncColRow;
end;

procedure TDBGridEhExportAsXLS.WriteIntegerCell(const AValue: Integer);
var
  V: Integer;
begin
  CXlsRk[2] := FRow;
  CXlsRk[3] := FCol;
  Stream.WriteBuffer(CXlsRk, SizeOf(CXlsRk));
  V := (AValue shl 2) or 2;
  Stream.WriteBuffer(V, 4);
  IncColRow;
end;

procedure TDBGridEhExportAsXLS.WriteStringCell(const AValue: string);
var
  L: Word;
begin
  L := Length(AValue);
  CXlsLabel[1] := 8 + L;
  CXlsLabel[2] := FRow;
  CXlsLabel[3] := FCol;
  CXlsLabel[5] := L;
  Stream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
  Stream.WriteBuffer(Pointer(AValue)^, L);
  IncColRow;
end;

procedure TDBGridEhExportAsXLS.WritePrefix;
begin
  Stream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
end;

procedure TDBGridEhExportAsXLS.WriteSuffix;
begin
  Stream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
end;

procedure TDBGridEhExportAsXLS.WriteTitle(ColumnsList: TColumnsEhList);
var i:Integer;
begin
  for i := 0 to ColumnsList.Count-1 do
  begin
    WriteStringCell(ColumnsList[i].Title.Caption);
  end;
end;

procedure TDBGridEhExportAsXLS.WriteDataCell(Column: TColumnEh;
  AFont: TFont; Background: TColor);
begin
  if Column.Field = nil then
    WriteStringCell('')
  else if Column.GetColumnType = ctKeyPickList then
    WriteStringCell(Column.DisplayText)
  else
    with Column.Field do
      case DataType of
        ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
          WriteIntegerCell(AsInteger);
        ftFloat, ftCurrency, ftBCD:
          WriteFloatCell(AsFloat);
        else
          WriteStringCell(Column.DisplayText);
      end;
end;

procedure TDBGridEhExportAsXLS.WriteFooterCell(DataCol, Row: Integer;
  Column: TColumnEh; AFont: TFont; Background: TColor;
  Alignment: TAlignment; Text: String);
begin
  if Column.UsedFooter(Row).ValueType in [fvtSum,fvtCount] then
    WriteFloatCell(FooterValues[Row*ExpCols.Count+DataCol])
  else
    WriteStringCell(Text);
end;

procedure TDBGridEhExportAsXLS.ExportToStream(AStream: TStream;
  IsExportAll: Boolean);
begin
  FCol := 0;
  FRow := 0;
  inherited ExportToStream(AStream,IsExportAll);
end;

procedure TDBGridEhExportAsXLS.IncColRow;
begin
  if FCol = ExpCols.Count-1 then
  begin
    Inc(FRow);
    FCol := 0;
  end else
    Inc(FCol);
end;

{ TDBGridEhExportAsVCLDBIF }

procedure TDBGridEhExportAsVCLDBIF.WritePrefix;
const
  VCLDBIF_BOF: TVCLDBIF_BOF = (Signatura:('V','C','L','D','B','I','F');Version:1;ColCount:0);
var
  i:Integer;
  b:Byte;
begin
  VCLDBIF_BOF.ColCount := CalcColCount;
  Stream.WriteBuffer(VCLDBIF_BOF, SizeOf(VCLDBIF_BOF));
  for i := 0 to ExpCols.Count-1 do
  begin
    if ExpCols[i].Visible then b := 1 else b := 0;
    Stream.WriteBuffer(b, SizeOf(Byte));
    //Stream.WriteBuffer(PChar(ExpCols[i].FieldName)^,Length(ExpCols[i].FieldName)+1);
    Stream.WriteBuffer(PChar('')^,1);
  end;
end;

procedure TDBGridEhExportAsVCLDBIF.WriteSuffix;
var b:Byte;
begin
  b := TVCLDBIF_TYPE_EOF;
  Stream.WriteBuffer(b, SizeOf(Byte));
end;

procedure TDBGridEhExportAsVCLDBIF.WriteDataCell(Column: TColumnEh;
  AFont: TFont; Background: TColor);
var Field:TField;
begin
  if (Column.Field <> nil) and Column.Field.Lookup then
    Field := Column.Field.Dataset.FieldByName(Column.Field.KeyFields)
  else
    Field := Column.Field;
  if Field = nil then
    WriteUnassigned
  else if Field.IsNull then
    WriteNull
  else
    with Field do
      case DataType of
        ftSmallint, ftInteger, ftWord, ftAutoInc:
          WriteInteger(AsInteger);
        ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime:
          WriteFloat(AsFloat);
        ftString, ftBoolean
        {$IFDEF EH_LIB_4} ,ftFixedChar, ftMemo, ftLargeint{$ENDIF}
        {$IFDEF EH_LIB_5} ,ftGuid, ftOraClob {$ENDIF} :
           WriteString(AsString);
        ftBlob, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle,
        {$IFDEF EH_LIB_4}  ftWideString, {$ENDIF}
        {$IFDEF EH_LIB_5} ftOraBlob, {$ENDIF}
         ftBytes, ftTypedBinary, ftVarBytes:
          WriteBinaryData(AsString);
        else
          WriteUnassigned;
      end;
end;

procedure TDBGridEhExportAsVCLDBIF.WriteBinaryData(AValue: String);
var
  BinaryValue: TVCLDBIF_BINARY_DATA;
begin
  BinaryValue.AType := TVCLDBIF_TYPE_BINARY_DATA;
  BinaryValue.Size := Length(AValue);
  Stream.WriteBuffer(BinaryValue, SizeOf(BinaryValue));
  Stream.WriteBuffer(Pointer(AValue)^, BinaryValue.Size);
end;

procedure TDBGridEhExportAsVCLDBIF.WriteFloat(AValue: Double);
var
  FloatValue: TVCLDBIF_FLOAT64;
begin
  FloatValue.AType := TVCLDBIF_TYPE_FLOAT64;
  FloatValue.Value := AValue;
  Stream.WriteBuffer(FloatValue, SizeOf(FloatValue));
end;

procedure TDBGridEhExportAsVCLDBIF.WriteInteger(AValue: Integer);
var
  IntValue: TVCLDBIF_INTEGER32;
begin
  IntValue.AType := TVCLDBIF_TYPE_INTEGER32;
  IntValue.Value := AValue;
  Stream.WriteBuffer(IntValue, SizeOf(IntValue));
end;

procedure TDBGridEhExportAsVCLDBIF.WriteNull;
var b:Byte;
begin
  b := TVCLDBIF_TYPE_NULL;
  Stream.WriteBuffer(b, SizeOf(Byte));
end;

procedure TDBGridEhExportAsVCLDBIF.WriteString(AValue: String);
var
  StringValue: TVCLDBIF_STRING;
begin
  StringValue.AType := TVCLDBIF_TYPE_STRING;
  StringValue.Size := Length(AValue);
  Stream.WriteBuffer(StringValue, SizeOf(StringValue));
  Stream.WriteBuffer(Pointer(AValue)^, StringValue.Size);
end;

procedure TDBGridEhExportAsVCLDBIF.WriteUnassigned;
var b:Byte;
begin
  b := TVCLDBIF_TYPE_UNASSIGNED;
  Stream.WriteBuffer(b, SizeOf(Byte));
end;

function TDBGridEhExportAsVCLDBIF.CalcColCount: Word;
var i:Integer;
begin
  Result := 0;
  with DBGridEh do
  begin
    if Selection.SelectionType = gstNon then Exit;
    case Selection.SelectionType of
      gstRecordBookmarks:
        Result := VisibleColumns.Count;
      gstRectangle:
        for i := Selection.Rect.LeftCol to Selection.Rect.RightCol do
          if Columns[i].Visible then
            Inc(Result);
      gstColumns:
        Result := Selection.Columns.Count;
      gstAll:
        Result := VisibleColumns.Count;
    end;
  end;
end;

{ TDBGridEhImport }


constructor TDBGridEhImport.Create;
begin
  inherited Create; 
end;

procedure TDBGridEhImport.ImportFromFile(FileName: String; IsImportAll: Boolean);
var FileStream: TFileStream;
begin
  FileStream := TFileStream.Create(FileName, fmOpenRead);
  try
    ImportFromStream(FileStream, IsImportAll);
  finally
    FileStream.Free;