不使用OLE直接生成Excel文件的问题。高分(100分)

  • 主题发起人 主题发起人 cnsandboy
  • 开始时间 开始时间
C

cnsandboy

Unregistered / Unconfirmed
GUEST, unregistred user!
就是分析Excel文件格式，然后使用程序生成Excel文件。没有源代码有Excel文件格式也可以，分不够咱们加。
PS.别给我Dev Express中的代码。
我倒是有一个Excel2.0的，可惜不全，生成的文件Excel他老人家不认。
 
由一个方法可以生成Execl文件
给你一段我写的控件源代码，你自己参考一下
unit UnitDBExportors;
interface
uses
DB, Classes, DBGrids, SysUtils;
var
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);
CXlsBlank : array[0..4] of Word = ($201, 6, 0, 0, $17);
type
TDBGridExportor = class(TComponent)
private
FDBGrid: TCustomDBGrid;
FCol: word;
FRow: word;
Stream: TStream;
FHead: boolean;
FBookMark: TBookmark;
FTextCompart: string;
procedure IncColRow;
procedure WriteBlankCell;
procedure WriteFloatCell(const AValue:do
uble);
procedure WriteIntegerCell(const AValue: Integer);
procedure WriteStringCell(const AValue: string);
procedure WritePrefix;
procedure WriteSuffix;
procedure WriteTitle;
procedure WriteDataCell;
function GetDataSet: TDataSet;
procedure SetGrid(const Value: TCustomDBGrid);
function GetAbout: string;
procedure SetAbout(const Value: string);
protected
property DataSet: TDataSet read GetDataSet;
procedure SaveToStream(aStream: TStream);
procedure Notification(AComponent: TComponent;
Operation: TOperation);
override;
public
procedure ToExecl(FileName: string;
Head: Boolean = True);
procedure ToStrings(iStrings: TStrings;
Head: Boolean = True);
procedure ToExeclStream(iStream: TStream;
Head: Boolean = True);
procedure ToText(FileName: string;
Head: Boolean = True);
constructor Create(AOwner: TComponent);
override;
published
property About: string read GetAbout write SetAbout;
property DBGrid: TCustomDBGrid read FDBGrid write SetGrid;
property TextCompart: string read FTextCompart write FTextCompart;
end;
implementation
constructor TDBGridExportor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FTextCompart := ',';
end;

procedure TDBGridExportor.IncColRow;
begin
if FCol = TDBGrid(FDBGrid).Columns.Count - 1 then
begin
Inc(FRow);
FCol := 0;
end
else
Inc(FCol);
end;

procedure TDBGridExportor.WriteBlankCell;
begin
CXlsBlank[2] := FRow;
CXlsBlank[3] := FCol;
Stream.WriteBuffer(CXlsBlank, SizeOf(CXlsBlank));
IncColRow;
end;

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

procedure TDBGridExportor.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 TDBGridExportor.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 TDBGridExportor.WritePrefix;
begin
Stream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
end;

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

procedure TDBGridExportor.WriteTitle;
var
n : word;
begin
for n := 0 to TDBGrid(FDBGrid).Columns.Count - 1do
WriteStringCell(TDBGrid(FDBGrid).Columns[n].Title.Caption);
end;

procedure TDBGridExportor.WriteDataCell;
var
n : word;
lDataSet : TDataSet;
begin
lDataSet := GetDataSet;
WritePrefix;
if FHead then
WriteTitle;
lDataSet.DisableControls;
FBookMark := lDataSet.GetBookmark;
lDataSet.First;
while not lDataSet.Eofdo
begin
for n := 0 to TDBGrid(FDBGrid).Columns.Count - 1do
begin
if (TDBGrid(FDBGrid).Columns[n].Visible) then
begin
if (TDBGrid(FDBGrid).Columns[n].Field.IsNull)
or ((TDBGrid(FDBGrid).Columns[n].Field <> nil)) then
WriteBlankCell
else
begin
case TDBGrid(FDBGrid).Columns[n].Field.DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
WriteIntegerCell(DataSet.Fields[n].AsInteger);
ftFloat, ftCurrency, ftBCD:
WriteFloatCell(TDBGrid(FDBGrid).Columns[n].Field.AsFloat);
else
WriteStringCell(TDBGrid(FDBGrid).Columns[n].Field.AsString);
end;
end;
end;
end;
lDataSet.Next;
end;
WriteSuffix;
if lDataSet.BookmarkValid(FBookMark) then
lDataSet.GotoBookmark(FBookMark);
lDataSet.EnableControls;
end;

procedure TDBGridExportor.SaveToStream(aStream: TStream);
begin
FCol := 0;
FRow := 0;
Stream := aStream;
WriteDataCell;
end;

procedure TDBGridExportor.ToStrings(iStrings: TStrings;
Head: Boolean);
var
lDataSet : TDataSet;
TmpStr : string;
Strs : TStrings;
n : Integer;
begin
lDataSet := GetDataSet;
if lDataSet = nil then
Exit;
Strs := TStringList.Create;
try
TmpStr := '';
if Head then
begin
for n := 0 to TDBGrid(FDBGrid).Columns.Count - 1do
begin
if n = 0 then
if TDBGrid(FDBGrid).Columns[n].Field = nil then
TmpStr := ''
else
TmpStr := TDBGrid(FDBGrid).Columns[n].Title.Caption
else
if TDBGrid(FDBGrid).Columns[n].Field = nil then
TmpStr := ''
else
TmpStr := TmpStr + FTextCompart + TDBGrid(FDBGrid).Columns[n].Title.Caption;
end;
Strs.Add(TmpStr);
end;
lDataSet.DisableControls;
FBookMark := lDataSet.GetBookmark;
lDataSet.First;
while not lDataSet.Eofdo
begin
for n := 0 to TDBGrid(FDBGrid).Columns.Count - 1do
begin
if n = 0 then
if TDBGrid(FDBGrid).Columns[n].Field = nil then
TmpStr := ''
else
TmpStr := TDBGrid(FDBGrid).Columns[n].Field.Text
else
if TDBGrid(FDBGrid).Columns[n].Field = nil then
TmpStr := ''
else
TmpStr := TmpStr + FTextCompart + TDBGrid(FDBGrid).Columns[n].Field.Text;
end;
Strs.Add(TmpStr);
lDataSet.Next;
end;
if lDataSet.BookmarkValid(FBookMark) then
lDataSet.GotoBookmark(FBookMark);
lDataSet.EnableControls;
finally
iStrings.Assign(Strs);
Strs.Free;
end;
end;

procedure TDBGridExportor.ToExecl(FileName: string;
Head: Boolean = True);
var
aFileStream : TFileStream;
begin
if (DataSet = nil) then
begin
Exit;
end;
if (not DataSet.Active) then
begin
Exit;
end;
FHead := Head;
if FileExists(FileName) then
DeleteFile(FileName);
aFileStream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(aFileStream);
finally
aFileStream.Free;
end;
end;

function TDBGridExportor.GetDataSet: TDataSet;
begin
if (FDBGrid = nil)
or (FDBGrid.DataSource = nil)
or (FDBGrid.DataSource.DataSet = nil) then
begin
Result := nil;
Exit;
end;
Result := FDBGrid.DataSource.DataSet;
end;

procedure TDBGridExportor.SetGrid(const Value: TCustomDBGrid);
begin
if Value = FDBGrid then
Exit;
FDBGrid := Value;
if Assigned(Value) then
begin
Value.FreeNotification(Self);
end;
end;

procedure TDBGridExportor.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FDBGrid) then
begin
FDBGrid := nil;
end;
end;

procedure TDBGridExportor.ToText(FileName: string;
Head: Boolean = True);
var
Strs : TStrings;
begin
Strs:=TStringList.Create;
try
ToStrings(Strs,Head);
Strs.SaveToFile(FileName);

finally
Strs.Free;
end;

end;

function TDBGridExportor.GetAbout: string;
begin
Result := '王锐';
end;

procedure TDBGridExportor.SetAbout(const Value: string);
begin
//
end;

procedure TDBGridExportor.ToExeclStream(iStream: TStream;
Head: Boolean);
var
aFileStream : TMemoryStream;
begin
if (DataSet = nil) then
begin
Exit;
end;
if (not DataSet.Active) then
begin
Exit;
end;
FHead := Head;
aFileStream := TMemoryStream.Create;
try
SaveToStream(iStream);
finally
aFileStream.Free;
end;
end;

end.
 
当我把154行的(TDBGrid(FDBGrid).Columns[n].Field <> nil)改为(TDBGrid(FDBGrid).Columns[n].Field = nil)就可以用了，多谢王锐，那么，如果把两个单元格合并成一个（Excel）该怎么写？分给你了，这个答了额外加分。
 
上面这个导出结果太差了，不能设置单元格式，还有数据类型为ftBytes时，不能转化为整型，
 
是不是客户要标导出成EXCEL格式？最简单就是替换，不过需安装EXCEL
全中国都吊在OFFICE上了。领导升级到XP，员工也要装XP，妈的，全交钱给MS了
 
我改了，可以设置标题底色字体，单元格字体，修正一些类型无法转换得bug，但是——合并单元格、设置个别单元格、列的底色问题仍然没有解决。大家继续努力，解决有奖。
unit UnitDBExportors;
interface
uses
DB, Classes, DBGrids, SysUtils, Graphics;
var
CXlsBof : array[0..4] of Word = ($409, 6, 0, $10, 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, $400);
CXlsRk : array[0..4] of Word = ($27E, 10, 0, 0, 0);
CXlsBlank : array[0..4] of Word = ($201, 6, 0, 0, $17);
XLSGUTS: array[0..5] of Word = ($80, 8, 0, 0, 0, 0);
XLSPalette: array[0..2] of Word = ($92, 0, 0);
XLSFONT: array[0..9] of Byte = ($31, 2, 0, 0, 0, 0, 0, 0, 0, 0);
XLSSFONT: array[0..15] of Byte = ($31, 2, $0C, 0, $C8, 0, 0, 0, $FF, $7F, 5, $41, $72, $69, $61, $6C);
XLSFONTH: array[0..9] of Byte = ($31, 2, 0, 0, 0, 0, 0, 0, 8, 0);
XLSFONTG: array[0..9] of Byte = ($31, 2, 0, 0, 0, 0, 0, 0, 10, 0);
XLSXF1: array[0..15] of Byte = ($43, 4, $0C, 0, 0, 0, $F5, $FF, $20, 0, 0, $CE, 0, 0, 0, 0);
XLSXF2: array[0..15] of Byte = ($43, 4, $0C, 0, 1, 0, $F5, $FF, $20, $F4, 0, $CE, 0, 0, 0, 0);
XLSXF3: array[0..15] of Byte = ($43, 4, $0C, 0, 2, 0, $F5, $FF, $20, $F4, 0, $CE, 0, 0, 0, 0);
XLSXF4: array[0..15] of Byte = ($43, 4, $0C, 0, 0, 0, $F5, $FF, $20, $F4, 0, $CE, 0, 0, 0, 0);
XLSXF5: array[0..15] of Byte = ($43, 4, $0C, 0, 0, 0, 1, 0, $20, 0, 0, $CE, 0, 0, 0, 0);
XLSXF6: array[0..15] of Byte = ($43, 4, $0C, 0, 1, $21, $F5, $FF, $20, $F8, 0, $CE, 0, 0, 0, 0);
XLSXF7: array[0..15] of Byte = ($43, 4, $0C, 0, 1, $1F, $F5, $FF, $20, $F8, 0, $CE, 0, 0, 0, 0);
XLSXF8: array[0..15] of Byte = ($43, 4, $0C, 0, 1, $20, $F5, $FF, $20, $F8, 0, $CE, 0, 0, 0, 0);
XLSXF9: array[0..15] of Byte = ($43, 4, $0C, 0, 1, $1E, $F5, $FF, $20, $F8, 0, $CE, 0, 0, 0, 0);
XLSXF10: array[0..15] of Byte = ($43, 4, $0C, 0, 1, $0D, $F5, $FF, $20, $F8, 0, $CE, 0, 0, 0, 0);
XLSXF: array[0..15] of Byte = ($43, 4, $0C, 0, 5, 0, 1, 0, $21, $78, $41, 3, 0, 0, 0, 0);
XLSXFB: array[0..15] of Byte = ($43, 4, $0C, 0, 8, 0, 1, 0, $22, $78, $41, 2, $71, $71, $71, 0);
XLSXFH: array[0..15] of Byte = ($43, 4, $0C, 0, 6, 0, 1, 0, $22, $78, $41, 2, $71, $71, $71, $71);
XLSXFG: array[0..15] of Byte = ($43, 4, $0C, 0, 7, 0, 1, 0, $21, $78, $C1, 2, 0, 0, 0, 0);
XLSXFF: array[0..15] of Byte = ($43, 4, $0C, 0, 5, 0, 1, 0, $22, $78, $C1, 2, $B9, $B9, $B9, $B9);
XLSXFF1: array[0..15] of Byte = ($43, 4, $0C, 0, 5, 0, 1, 0, $22, $78, $C1, 2, $B9, 0, $B9, 0);
XLSXFRF: array[0..15] of Byte = ($43, 4, $0C, 0, 9, 0, 1, 0, $21, $78, $C1, 2, $B9, $B9, $B9, $B9);
XLSXFRF1: array[0..15] of Byte = ($43, 4, $0C, 0, 9, 0, 1, 0, $21, $78, $C1, 2, $B9, 0, $B9, 0);
XLSCOL: array[0..7] of Word = ($7D, $0C, 0, 0, 0, $F, 0, 0);
XLSDimension: array [0..6] of Word = ($200, $0A, 0, $FFFF, 0, $FF, 0);

type
TDBGridExportor = class(TComponent)
private
FDBGrid: TDBGrid;
FCol: word;
FRow: word;
Stream: TStream;
FHead: boolean;
FBookMark: TBookmark;
procedure IncColRow;
procedure WriteBlankCell;
procedure WriteFloatCell(const AValue:do
uble);
procedure WriteIntegerCell(const AValue: Integer);
procedure WriteStringCell(const AValue: string);
procedure WriteHeaderCell(const AValue: string);
procedure WritePrefix;
procedure WritePaletteAndFont;
procedure WriteSuffix;
procedure WriteTitle;
procedure WriteDataCell;
function GetDataSet: TDataSet;
procedure SetGrid(const Value: TDBGrid);
protected
property DataSet: TDataSet read GetDataSet;
procedure SaveToStream(aStream: TStream);
procedure Notification(AComponent: TComponent;
Operation: TOperation);override;
public
procedure ToExecl(FileName: string;
Head: Boolean = True);
procedure ToExeclStream(iStream: TStream;
Head: Boolean = True);
constructor Create(AOwner: TComponent);
override;
published
property DBGrid: TDBGrid read FDBGrid write SetGrid;
end;
implementation
constructor TDBGridExportor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;

procedure TDBGridExportor.IncColRow;
begin
if FCol = TDBGrid(FDBGrid).Columns.Count - 1 then
begin
Inc(FRow);
FCol := 0;
end
else
Inc(FCol);
end;

procedure TDBGridExportor.WriteBlankCell;
begin
CXlsBlank[2] := FRow;
CXlsBlank[3] := FCol;
Stream.WriteBuffer(CXlsBlank, SizeOf(CXlsBlank));
IncColRow;
end;

procedure TDBGridExportor.WriteFloatCell(const AValue:do
uble);
begin
CXlsNumber[2] := FRow;
CXlsNumber[3] := FCol;
CXlsNumber[4] := $1D + FCol;
Stream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));
Stream.WriteBuffer(AValue, 8);
IncColRow;
end;

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

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

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

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

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

procedure TDBGridExportor.WriteTitle;
var
n : word;
begin
for n := 0 to TDBGrid(FDBGrid).Columns.Count - 1do
WriteHeaderCell(TDBGrid(FDBGrid).Columns[n].Title.Caption);
end;

procedure TDBGridExportor.WriteDataCell;
var
n : word;
lDataSet : TDataSet;
begin
lDataSet := GetDataSet;
WritePrefix;
WritePaletteAndFont;
if FHead then
WriteTitle;
lDataSet.DisableControls;
FBookMark := lDataSet.GetBookmark;
lDataSet.First;
while not lDataSet.Eofdo
begin
for n := 0 to TDBGrid(FDBGrid).Columns.Count - 1do
begin
if (TDBGrid(FDBGrid).Columns[n].Visible) then
begin
if (TDBGrid(FDBGrid).Columns[n].Field.IsNull)
or ((TDBGrid(FDBGrid).Columns[n].Field = nil)) then
begin
WriteBlankCell;
end else
begin
case TDBGrid(FDBGrid).Columns[n].Field.DataType of
ftSmallint, ftInteger, ftWord, ftBytes, ftVarBytes, ftAutoInc,
ftLargeint:
WriteIntegerCell(DataSet.Fields[n].AsInteger);
ftFloat, ftCurrency, ftBCD, ftFMTBcd:
WriteFloatCell(TDBGrid(FDBGrid).Columns[n].Field.AsFloat);
ftUnknown, ftString,ftMemo, ftFmtMemo, ftFixedChar, ftWideString,
ftDate, ftTime, ftDateTime, ftTimeStamp:
WriteStringCell(TDBGrid(FDBGrid).Columns[n].Field.AsString);
else
WriteBlankCell;
end;
end;
end;
end;
lDataSet.Next;
end;
WriteSuffix;
if lDataSet.BookmarkValid(FBookMark) then
lDataSet.GotoBookmark(FBookMark);
lDataSet.EnableControls;
end;

procedure TDBGridExportor.SaveToStream(aStream: TStream);
begin
FCol := 0;
FRow := 0;
Stream := aStream;
WriteDataCell;
end;

procedure TDBGridExportor.ToExecl(FileName: string;
Head: Boolean = True);
var
aFileStream : TFileStream;
begin
if (DataSet = nil) then
Exit;
if (not DataSet.Active) then
Exit;
FHead := Head;
if FileExists(FileName) then
DeleteFile(FileName);
aFileStream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(aFileStream);
finally
aFileStream.Free;
end;
end;

function TDBGridExportor.GetDataSet: TDataSet;
begin
if (FDBGrid = nil)
or (FDBGrid.DataSource = nil)
or (FDBGrid.DataSource.DataSet = nil) then
begin
Result := nil;
Exit;
end;
Result := FDBGrid.DataSource.DataSet;
end;

procedure TDBGridExportor.SetGrid(const Value: TDBGrid);
begin
if Value = FDBGrid then
Exit;
FDBGrid := Value;
if Assigned(Value) then
begin
Value.FreeNotification(Self);
end;
end;

procedure TDBGridExportor.ToExeclStream(iStream: TStream;
Head: Boolean);
var
aFileStream : TMemoryStream;
begin
if (DataSet = nil) then
Exit;
if (not DataSet.Active) then
Exit;
FHead := Head;
aFileStream := TMemoryStream.Create;
try
SaveToStream(iStream);
finally
aFileStream.Free;
end;
end;

procedure TDBGridExportor.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FDBGrid) then
begin
FDBGrid := nil;
end;

end;

procedure TDBGridExportor.WritePaletteAndFont;
var
tmpColor:TColor;
tmpFont:TFont;
C:Longint;
S: string;
B: Byte;
i,II: Integer;
begin
Stream.WriteBuffer(XLSGUTS, SizeOf(XLSGUTS));
// XLS Palette
XLSPalette[1] := 54+4*DBGrid.Columns.Count;
XLSPalette[2] := 13 + DBGrid.Columns.Count;
Stream.WriteBuffer(XLSPalette, SizeOf(XLSPalette));
//HeaderFontColor
tmpColor := DBGrid.Columns[0].Title.Font.Color;
if tmpColor = clNone then
C := 0
else
C := ColorToRGB(tmpColor);
Stream.WriteBuffer(C, SizeOf(C));
//HeaderColor
tmpColor := DBGrid.Columns[0].Title.Color;
if tmpColor = clNone then
C := 0
else
C := ColorToRGB(tmpColor);
Stream.WriteBuffer(C, SizeOf(C));
//GroupNodeTextColor
tmpColor := DBGrid.Columns[0].Font.Color;
if tmpColor = clNone then
C := 0
else
C := ColorToRGB(tmpColor);
Stream.WriteBuffer(C, SizeOf(C));
//GroupNodeColor
tmpColor := DBGrid.Columns[0].Color;
if tmpColor = clNone then
C := 0
else
C := ColorToRGB(tmpColor);
Stream.WriteBuffer(C, SizeOf(C));
//FontColor
tmpColor := DBGrid.Font.Color;
if tmpColor = clNone then
C := 0
else
C := ColorToRGB(tmpColor);
Stream.WriteBuffer(C, SizeOf(C));
//Color
tmpColor := DBGrid.Color;
if tmpColor = clNone then
C := 0
else
C := ColorToRGB(tmpColor);
Stream.WriteBuffer(C, SizeOf(C));
//clWindowFrame
C := ColorToRGB(clWindowFrame);
Stream.WriteBuffer(C, SizeOf(C));
//clWindow
C := ColorToRGB(clWindow);
Stream.WriteBuffer(C, SizeOf(C));
//BandFontColort
C := ColorToRGB(clWindowFrame);
Stream.WriteBuffer(C, SizeOf(C));
//BandColor
C := ColorToRGB(clWindowFrame);
Stream.WriteBuffer(C, SizeOf(C));
//RowFooterTextColor
C := ColorToRGB(clWindowFrame);
Stream.WriteBuffer(C, SizeOf(C));
//RowFooterColor
C := ColorToRGB(clWindowFrame);
Stream.WriteBuffer(C, SizeOf(C));
//GridLineColor
C := ColorToRGB(clWindowFrame);
Stream.WriteBuffer(C, SizeOf(C));
for i := 0 to DBGrid.Columns.Count - 1do
begin
tmpColor := DBGrid.Columns.Color;
if tmpColor = clNone then
C := 0
else
C := ColorToRGB(tmpColor);
Stream.WriteBuffer(C, SizeOf(C));
end;
// XLS Font
Stream.WriteBuffer(XLSSFont, SizeOf(XLSSFont));
Stream.WriteBuffer(XLSSFont, SizeOf(XLSSFont));
Stream.WriteBuffer(XLSSFont, SizeOf(XLSSFont));
Stream.WriteBuffer(XLSSFont, SizeOf(XLSSFont));
// Grid Font
tmpFont := DBGrid.Font;
S := tmpFont.Name;
B := Length(S);
XLSFont[2] := B + 7;
XLSFont[4] := tmpFont.Size*20 mod 256;
XLSFont[5] := tmpFont.Size*20 div 256;
XLSFont[6] := 0;
if (fsBold in tmpFont.Style) then
XLSFont[6] := XLSFont[6] + 1;
if (fsItalic in tmpFont.Style) then
XLSFont[6] := XLSFont[6] + 2;
if (fsUnderline in tmpFont.Style) then
XLSFont[6] := XLSFont[6] + 4;
if (fsStrikeOut in tmpFont.Style) then
XLSFont[6] := XLSFont[6] + 8;
XLSFont[8] := 12;
Stream.WriteBuffer(XLSFont, SizeOf(XLSFont));
Stream.WriteBuffer(B, SizeOf(B));
Stream.WriteBuffer(Pointer(S)^, Length(S));
// Header Font
tmpFont := DBGrid.Columns[0].Title.Font;
S := tmpFont.Name;
B := Length(S);
XLSFontH[2] := B + 7;
XLSFontH[4] := tmpFont.Size*20 mod 256;
XLSFontH[5] := tmpFont.Size*20 div 256;
XLSFontH[6] := 0;
if (fsBold in tmpFont.Style) then
XLSFontH[6] := XLSFontH[6] + 1;
if (fsItalic in tmpFont.Style) then
XLSFontH[6] := XLSFontH[6] + 2;
if (fsUnderline in tmpFont.Style) then
XLSFontH[6] := XLSFontH[6] + 4;
if (fsStrikeOut in tmpFont.Style) then
XLSFontH[6] := XLSFontH[6] + 8;
Stream.WriteBuffer(XLSFontH, SizeOf(XLSFontH));
Stream.WriteBuffer(B, SizeOf(B));
Stream.WriteBuffer(Pointer(S)^, Length(S));
// Group Font
tmpFont := DBGrid.Font;
S := tmpFont.Name;
B := Length(S);
XLSFontG[2] := B + 7;
XLSFontG[4] := tmpFont.Size*20 mod 256;
XLSFontG[5] := tmpFont.Size*20 div 256;
XLSFontG[6] := 0;
if (fsBold in tmpFont.Style) then
XLSFontG[6] := XLSFontG[6] + 1;
if (fsItalic in tmpFont.Style) then
XLSFontG[6] := XLSFontG[6] + 2;
if (fsUnderline in tmpFont.Style) then
XLSFontG[6] := XLSFontG[6] + 4;
if (fsStrikeOut in tmpFont.Style) then
XLSFontG[6] := XLSFontG[6] + 8;
Stream.WriteBuffer(XLSFontG, SizeOf(XLSFontG));
Stream.WriteBuffer(B, SizeOf(B));
Stream.WriteBuffer(Pointer(S)^, Length(S));
// Band Font
tmpFont := DBGrid.Font;
S := tmpFont.Name;
B := Length(S);
XLSFont[2] := B + 7;
XLSFont[4] := tmpFont.Size*20 mod 256;
XLSFont[5] := tmpFont.Size*20 div 256;
XLSFont[6] := 0;
if (fsBold in tmpFont.Style) then
XLSFont[6] := XLSFont[6] + 1;
if (fsItalic in tmpFont.Style) then
XLSFont[6] := XLSFont[6] + 2;
if (fsUnderline in tmpFont.Style) then
XLSFont[6] := XLSFont[6] + 4;
if (fsStrikeOut in tmpFont.Style) then
XLSFont[6] := XLSFont[6] + 8;
XLSFont[8] := 16;
Stream.WriteBuffer(XLSFont, SizeOf(XLSFont));
Stream.WriteBuffer(B, SizeOf(B));
Stream.WriteBuffer(Pointer(S)^, Length(S));
// Footer Font
tmpFont := DBGrid.Font;
S := tmpFont.Name;
B := Length(S);
XLSFont[2] := B + 7;
XLSFont[4] := tmpFont.Size*20 mod 256;
XLSFont[5] := tmpFont.Size*20 div 256;
XLSFont[6] := 0;
if (fsBold in tmpFont.Style) then
XLSFont[6] := XLSFont[6] + 1;
if (fsItalic in tmpFont.Style) then
XLSFont[6] := XLSFont[6] + 2;
if (fsUnderline in tmpFont.Style) then
XLSFont[6] := XLSFont[6] + 4;
if (fsStrikeOut in tmpFont.Style) then
XLSFont[6] := XLSFont[6] + 8;
XLSFont[8] := 18;
Stream.WriteBuffer(XLSFont, SizeOf(XLSFont));
Stream.WriteBuffer(B, SizeOf(B));
Stream.WriteBuffer(Pointer(S)^, Length(S));
// Columns Fonts
for i := 0 to DBGrid.Columns.Count - 1do
begin
if DBGrid.Columns.Visible then
begin
tmpFont := DBGrid.Columns.Font;
S := tmpFont.Name;
B := Length(S);
XLSFont[2] := B + 7;
XLSFont[4] := tmpFont.Size*20 mod 256;
XLSFont[5] := tmpFont.Size*20 div 256;
XLSFont[6] := 0;
if (fsBold in tmpFont.Style) then
XLSFont[6] := XLSFont[6] + 1;
if (fsItalic in tmpFont.Style) then
XLSFont[6] := XLSFont[6] + 2;
if (fsUnderline in tmpFont.Style) then
XLSFont[6] := XLSFont[6] + 4;
if (fsStrikeOut in tmpFont.Style) then
XLSFont[6] := XLSFont[6] + 8;
XLSFont[8] := 12;
Stream.WriteBuffer(XLSFont, SizeOf(XLSFont));
Stream.WriteBuffer(B, SizeOf(B));
Stream.WriteBuffer(Pointer(S)^, Length(S));
end;
end;
// Grid
Stream.WriteBuffer(XLSXF1, SizeOf(XLSXF1));
Stream.WriteBuffer(XLSXF2, SizeOf(XLSXF2));
Stream.WriteBuffer(XLSXF2, SizeOf(XLSXF2));
Stream.WriteBuffer(XLSXF3, SizeOf(XLSXF3));
Stream.WriteBuffer(XLSXF3, SizeOf(XLSXF3));
for i := 0 to 9do
Stream.WriteBuffer(XLSXF4, SizeOf(XLSXF4));
Stream.WriteBuffer(XLSXF5, SizeOf(XLSXF5));
Stream.WriteBuffer(XLSXF6, SizeOf(XLSXF6));
Stream.WriteBuffer(XLSXF7, SizeOf(XLSXF7));
Stream.WriteBuffer(XLSXF8, SizeOf(XLSXF8));
Stream.WriteBuffer(XLSXF9, SizeOf(XLSXF9));
Stream.WriteBuffer(XLSXF10, SizeOf(XLSXF10));
XLSXF[12] := $A1;
XLSXF[13] := $A1;
XLSXF[14] := $A1;
XLSXF[15] := $A1;
Stream.WriteBuffer(XLSXF, SizeOf(XLSXF));
Stream.WriteBuffer(XLSXFH, SizeOf(XLSXFH));
Stream.WriteBuffer(XLSXFG, SizeOf(XLSXFG));
Stream.WriteBuffer(XLSXFF, SizeOf(XLSXFF));
Stream.WriteBuffer(XLSXFF1, SizeOf(XLSXFF1));
Stream.WriteBuffer(XLSXFB, SizeOf(XLSXFB));
Stream.WriteBuffer(XLSXFRF, SizeOf(XLSXFRF));
Stream.WriteBuffer(XLSXFRF1, SizeOf(XLSXFRF1));
II := 0;
for i := 0 to DBGrid.Columns.Count - 1do
begin
if DBGrid.Columns.Visible then
begin
XLSXF[4] := II + 10;
case DBGrid.Columns.Alignment of
taLeftJustify : XLSXF[8] := $21;
taRightJustify : XLSXF[8] := $23;
taCenter : XLSXF[8] := $22;
end;
Stream.WriteBuffer(XLSXF, SizeOf(XLSXF));
Inc(II);
end;
end;
// VsibleColumns
II:=0;
for i := 0 to DBGrid.Columns.Count - 1do
begin
if DBGrid.Columns.Visible then
begin
XLSCOL[2] := II ;
XLSCOL[3] := II ;
XLSCOL[4] := 36 * DBGrid.Columns.Width;
Stream.WriteBuffer(XLSCOL, SizeOf(XLSCOL));
Inc(II);
end;
end;
Stream.WriteBuffer(XLSDimension, SizeOf(XLSDimension));
end;

end.
 
看看还有没有人有更完美的解决，然后咱们就结帐。
 
建议你还是直接用DEV的SHEET吧，虽然不能完成得一模一样，但基本的功能还是没有问题的
 
建议你参考一下fastreport2.5的导出格式
他也是直接导出没用 ole
 
嘿嘿，menxin,我不用dev的，因为我的目的是导自己的报表，所以要自己写程序，使用dbgrid不过是连带着做测试了。
常常,fastreport2.5包括源代码版本那里有down啊？我找了很久没找到。
 
还是没解决:(是不是不同excel版本有的不支持单元格合并?
 
如果有更好的解决办法，可以开帖给分，继续关注。
 
多人接受答案了。
 
您必须登录或注册才可回复。

Similar threads

S
[FMX]修正 FMX 组件嵌套时 Tab 顺序不正常的问题
回复
0
查看
463
swish
S
X
使用kbmmw 生成客户端delphi函数原型 - xalion
回复
0
查看
718
xalion
X
不
关于在Delphi中链接VC的obj文件（XE2以上版本） - 不得闲
回复
0
查看
963
不得闲
不
X
使用kbmmw 生成REST 服务OpenAPI函数原型 - xalion
回复
0
查看
891
xalion
X
不
B编码以及BT种子文件分析 - 不得闲
回复
0
查看
1K
不得闲
不
后退
顶部