我有二进制方式写数据到xls的代码,谁能共享一个读取xls的函数?(40分)

  • 主题发起人 主题发起人 delhpi
  • 开始时间 开始时间
D

delhpi

Unregistered / Unconfirmed
GUEST, unregistred user!
我有二进制方式 写数据到xls的代码,谁能共享一个读取xls的函数?
比如,读取xls文件数据到TStringGrid,或者DataSet等。
各位大富翁帮忙。。

富翁名称: delhpi
专 家 分: 6
可用积分: 45
给40分
谢谢。

//不要ole的pas,加入bcb中就行了.

// 祘Αㄓ方 http://delphi.ktop.com.tw

// ???:Yudi Wibisono XLSFILEじン
// CCCHEN:э?Function?
// 烩?ぱㄏ:埃岿
// dllee: ?? StringGridToXLS(), ?タ?ㄇ? BUG, ?﹚?Α程? Rows 计,??脄?玻ネ??郎?ぃ?ノ

unit XLSfile;
interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Grids, Forms, Dialogs, db, dbctrls, comctrls;

const
{BOF}
CBOF = $0009;
BIT_BIFF5 = $0800;
BOF_BIFF5 = CBOF or BIT_BIFF5;
{EOF}
BIFF_EOF = $000A;
{Document types}
DOCTYPE_XLS = $0010;
{Dimensions}
DIMENSIONS = $0000;

type
TAtributCell = (acHidden, acLocked, acShaded, acBottomBorder, acTopBorder,
acRightBorder, acLeftBorder, acLeft, acCenter, acRight, acFill);

TSetOfAtribut = set of TatributCell;

TXLSWriter = class(Tobject)
private
fstream: TFileStream;
procedure WriteWord(w: word);
protected
procedure WriteBOF;
procedure WriteEOF;
procedure WriteDimension;
public
maxCols, maxRows: Word;
procedure CellWord(vCol, vRow: word; aValue: word; vAtribut: TSetOfAtribut = []);
procedure CellDouble(vCol, vRow: word; aValue: double; vAtribut: TSetOfAtribut = []);
procedure CellStr(vCol, vRow: word; aValue: string; vAtribut: TSetOfAtribut = []);
procedure WriteField(vCol, vRow: word; Field: TField);
constructor create(vFileName: string);
destructor destroy; override;
end;

procedure SetCellAtribut(value: TSetOfAtribut; var FAtribut: array of byte);
procedure StringGridToXLS(grid: TStringGrid; fname: string);

implementation


procedure StringGridToXLS(grid: TStringGrid; fname: string);
var
c, r, rMax: Integer;
xls: TXLSWriter;
begin
xls := TXLSWriter.create(fname);
rMax := grid.RowCount;
if grid.ColCount > xls.maxcols then
xls.maxcols := grid.ColCount + 1;
if rMax > xls.maxrows then // ?Α程???? 65535 Rows
rMax := xls.maxrows;
try
xls.writeBOF;
xls.WriteDimension;
for c := 0 to grid.ColCount - 1 do
for r := 0 to rMax - 1 do
xls.Cellstr(r, c, grid.Cells[c, r]);
xls.writeEOF;
finally
xls.free;
end;
end;

{ TXLSWriter }

constructor TXLSWriter.create(vFileName: string);
begin
inherited create;
if FileExists(vFilename) then
fStream := TFileStream.Create(vFilename, fmOpenWrite)
else
fStream := TFileStream.Create(vFilename, fmCreate);

maxCols := 100; // <2002-11-17> dllee Column 莱赣琌ぃ??? 65535, ┮?ぃ?矪瞶
maxRows := 65535; // <2002-11-17> dllee 硂??Α程???硂或??叫猔種??戈?畐?甧碞?硂??
end;

destructor TXLSWriter.destroy;
begin
if fStream <> nil then
fStream.free;
inherited;
end;

procedure TXLSWriter.WriteBOF;
begin
Writeword(BOF_BIFF5);
Writeword(6); // count of bytes
Writeword(0);
Writeword(DOCTYPE_XLS);
Writeword(0);
end;

procedure TXLSWriter.WriteDimension;
begin
Writeword(DIMENSIONS); // dimension OP Code
Writeword(8); // count of bytes
Writeword(0); // min cols
Writeword(maxRows); // max rows
Writeword(0); // min rowss
Writeword(maxcols); // max cols
end;

procedure TXLSWriter.CellDouble(vCol, vRow: word; aValue: double;
vAtribut: TSetOfAtribut);
var FAtribut: array[0..2] of byte;
begin
Writeword(3); // opcode for double
Writeword(15); // count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut, fAtribut);
fStream.Write(fAtribut, 3);
fStream.Write(aValue, 8);
end;

procedure TXLSWriter.CellWord(vCol, vRow: word; aValue: word; vAtribut: TSetOfAtribut = []);
var FAtribut: array[0..2] of byte;
begin
Writeword(2); // opcode for word
Writeword(9); // count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut, fAtribut);
fStream.Write(fAtribut, 3);
Writeword(aValue);
end;

procedure TXLSWriter.CellStr(vCol, vRow: word; aValue: string;
vAtribut: TSetOfAtribut);
var FAtribut: array[0..2] of byte;
slen: byte;
begin
Writeword(4); // opcode for string
slen := length(avalue);
Writeword(slen + 8); // count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut, fAtribut);
fStream.Write(fAtribut, 3);
fStream.Write(slen, 1);
fStream.Write(aValue[1], slen);
end;

procedure SetCellAtribut(value: TSetOfAtribut; var FAtribut: array of byte);
var
i: integer;
begin
//reset
for i := 0 to High(FAtribut) do
FAtribut := 0;

{Byte Offset Bit Description Contents
0 7 Cell is not hidden 0b
Cell is hidden 1b
6 Cell is not locked 0b
Cell is locked 1b
5-0 Reserved, must be 0 000000b
1 7-6 Font number (4 possible)
5-0 Cell format code
2 7 Cell is not shaded 0b
Cell is shaded 1b
6 Cell has no bottom border 0b
Cell has a bottom border 1b
5 Cell has no top border 0b
Cell has a top border 1b
4 Cell has no right border 0b
Cell has a right border 1b
3 Cell has no left border 0b
Cell has a left border 1b
2-0 Cell alignment code
general 000b
left 001b
center 010b
right 011b
fill 100b
Multiplan default align. 111b
}

// bit sequence 76543210

if acHidden in value then //byte 0 bit 7:
FAtribut[0] := FAtribut[0] + 128;

if acLocked in value then //byte 0 bit 6:
FAtribut[0] := FAtribut[0] + 64;

if acShaded in value then //byte 2 bit 7:
FAtribut[2] := FAtribut[2] + 128;

if acBottomBorder in value then //byte 2 bit 6

FAtribut[2] := FAtribut[2] + 64;

if acTopBorder in value then //byte 2 bit 5
FAtribut[2] := FAtribut[2] + 32;

if acRightBorder in value then //byte 2 bit 4
FAtribut[2] := FAtribut[2] + 16;

if acLeftBorder in value then //byte 2 bit 3
FAtribut[2] := FAtribut[2] + 8;

// <2002-11-17> dllee 程? 3 bit 莱?Τ 1 贺匡拒
if acLeft in value then //byte 2 bit 1
FAtribut[2] := FAtribut[2] + 1
else if acCenter in value then //byte 2 bit 1
FAtribut[2] := FAtribut[2] + 2
else if acRight in value then //byte 2, bit 0 dan bit 1
FAtribut[2] := FAtribut[2] + 3
else if acFill in value then //byte 2, bit 0
FAtribut[2] := FAtribut[2] + 4;
end;

procedure TXLSWriter.WriteWord(w: word);
begin
fstream.Write(w, 2);
end;

procedure TXLSWriter.WriteEOF;
begin
Writeword(BIFF_EOF);
Writeword(0);
end;

procedure TXLSWriter.WriteField(vCol, vRow: word; Field: TField);
begin
case field.DataType of
ftString, ftWideString, ftBoolean, ftDate, ftDateTime, ftTime:
Cellstr(vcol, vrow, field.asstring);
ftAutoInc, ftSmallint, ftInteger, ftWord:
CellWord(vcol, vRow, field.AsInteger);
ftFloat, ftBCD:
CellDouble(vcol, vrow, field.AsFloat);
else
Cellstr(vcol, vrow, EmptyStr); // <2002-11-17> dllee ㄤ??篈糶??フ?﹃
end;
end;

end.
 
http://www5.skycn.com/soft/29751.html
这项技术可较好地解决你的问题
QQ:292044357
 
是商业控件,那我还不如用OLE读,要买,那个控件也不值这个价。680?
写的部分我有了。
期待。。。
 
292044357
聊聊你的问题
 
不用聊,有热心人愿意,就公布源码大家共享。因为水平有限,否则,既然有了写的代码,应该成写个读的函数,关键是流和XLS文件格式。
 
我只知道 TXLSReadWriteII 可以做到
 
后退
顶部