?? flatexcel.pas
字號:
FCells.BeginLayout;
try
Clear;
AddFields(FCells.DataSource.DataSet.Fields, 0);
finally
FCells.EndLayout;
end
end
else
Clear;
end;
procedure TEduceDatas.SaveToFile(const Filename: string);
var
S: TStream;
begin
S := TFileStream.Create(Filename, fmCreate);
try
SaveToStream(S);
finally
S.Free;
end;
end;
procedure TEduceDatas.SaveToStream(S: TStream);
var
Wrapper: TEduceWrapper;
begin
Wrapper := TEduceWrapper.Create(nil);
try
Wrapper.Columns := Self;
S.WriteComponent(Wrapper);
finally
Wrapper.Free;
end;
end;
procedure TEduceDatas.SetColumn(Index: Integer; Value: TEduceData);
begin
Items[Index].Assign(Value);
end;
procedure TEduceDatas.SetState(NewState: TEduceDatasState);
begin
if NewState = State then Exit;
if NewState = csDefault then
Clear
else
RebuildColumns;
end;
function TEduceDatas.InternalAdd: TEduceData;
begin
Result := Add;
Result.FStored := False;
end;
function TEduceDatas.GetState: TEduceDatasState;
begin
Result := TEduceDatasState((Count > 0) and Items[0].IsStored);
end;
procedure TEduceDatas.Update(Item: TCollectionItem);
begin
if (FCells = nil) or (csLoading in FCells.ComponentState) then Exit;
if Item = nil then
begin
FCells.LayoutChanged;
end;
end;
{ TDefineExcel }
var
ExcelBof : array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
ExcelEof : array[0..1] of Word = ($0A, 00);
ExcelLabel : array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
ExcelNum : array[0..4] of Word = ($203, 14, 0, 0, 0);
ExcelRec : array[0..4] of Word = ($27E, 10, 0, 0, 0);
ExcelBlank : array[0..4] of Word = ($201, 6, 0, 0, $17);
Constructor TDefineExcel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FColumns := CreateColumns;
FDatalink := CreateDatalink;
FEduceType := dmDefault;
FEduceTitle := true;
FInterval := 500;
FShowProgress := true;
FFileName := '未命名表格文件';
FEduceMode := emSingle;
FDefaultExt := '.xls';
end;
destructor TDefineExcel.Destroy;
begin
FColumns.Free;
FColumns := nil;
FDataLink.Free;
FDataLink := nil;
inherited Destroy;
end;
function TDefineExcel.CreateColumns: TEduceDatas;
begin
Result := TEduceDatas.Create(Self, TEduceData);
end;
procedure TDefineExcel.IncColRow;
begin
if fCol = EduceCount - 1 then
begin
Inc(fRow);
fCol :=0;
end else
Inc(fCol);
end;
//寫空單元
procedure TDefineExcel.WriteBlankCell;
begin
ExcelBlank[2] := fRow;
ExcelBlank[3] := fCol;
ExcelStream.WriteBuffer(ExcelBlank, SizeOf(ExcelBlank));
IncColRow;
end;
//寫浮點單元
procedure TDefineExcel.WriteFloatCell(const AValue: Double);
begin
ExcelNum[2] := fRow;
ExcelNum[3] := fCol;
ExcelStream.WriteBuffer(ExcelNum, SizeOf(ExcelNum));
ExcelStream.WriteBuffer(AValue, 8);
IncColRow;
end;
//寫整數單元
procedure TDefineExcel.WriteIntegerCell(const AValue: Integer);
var V: Integer;
begin
ExcelRec[2] := fRow;
ExcelRec[3] := fCol;
ExcelStream.WriteBuffer(ExcelRec, SizeOf(ExcelRec));
V := (AValue shl 2) or 2;
ExcelStream.WriteBuffer(V, 4);
IncColRow;
end;
//寫字符單元
procedure TDefineExcel.WriteStringCell(const AValue: string);
var
L: Word;
begin
L := Length(AValue);
ExcelLabel[1] := 8 + L;
ExcelLabel[2] := fRow;
ExcelLabel[3] := fCol;
ExcelLabel[5] := L;
ExcelStream.WriteBuffer(ExcelLabel, SizeOf(ExcelLabel));
ExcelStream.WriteBuffer(Pointer(AValue)^, L);
IncColRow;
end;
//寫前綴
procedure TDefineExcel.WritePrefix;
begin
ExcelStream.WriteBuffer(ExcelBof, SizeOf(ExcelBof));
end;
//寫后綴
procedure TDefineExcel.WriteSuffix;
begin
ExcelStream.WriteBuffer(ExcelEof, SizeOf(ExcelEof));
end;
//寫標題
procedure TDefineExcel.WriteTitle;
var n: word;
begin
if FEduceTitle then
begin
for n:= 0 to FColumns.Count - 1 do
begin
if FColumns[n].Visible then WriteStringCell(FColumns[n].Caption);
end;
end;
end;
procedure TDefineExcel.StartProgress(Max:Integer);
begin
if (not Assigned(FExcelForm))and(FShowProgress) then
Application.CreateForm(TExcelForm, FExcelForm);
if Assigned(FExcelForm) then
begin
with FExcelForm do
begin
ProGauge.Max :=Max;
ProGauge.Min :=0;
ProGauge.Progress:=0;
Show;
BringToFront;
end;
end;
end;
procedure TDefineExcel.EndProgress;
begin
if Assigned(FExcelForm) then
begin
with FExcelForm do
begin
ProGauge.Progress := ProGauge.Progress+1;
if ProGauge.Progress >= ProGauge.Max then
begin
Sleep(FInterval);
Close;
end;
end;
Application.ProcessMessages;
end;
end;
procedure TDefineExcel.WriteData(Field:TField);
begin
if Field.IsNull then
WriteBlankCell
else
case FEduceType of
dmDefault:
case Field.DataType of
ftSmallint,
ftInteger,
ftWord,
ftAutoInc,
ftBytes: WriteIntegerCell(Field.AsInteger);
ftFloat,
ftCurrency,
ftBCD: WriteFloatCell(Field.AsFloat);
else
WriteStringCell(Field.AsString);
end;
dmString:WriteStringCell(Field.AsString);
end;
end;
//正式寫入Excel表的數據
procedure TDefineExcel.WriteDataCells;
var n: word;
fBookMark : TBookmark;
begin
//寫入 Excel 文件開始格式
WritePrefix;
//寫入標題名稱
WriteTitle;
//開始寫入各字段數據
with FDataLink.DataSet do
begin
//禁止在數據感知控件中顯示
DisableControls;
//初始化處理進度
StartProgress(RecordCount);
//記錄當記錄的位置
fBookMark := GetBookmark;
//指向第一條記錄
First;
while not Eof do begin
for n := 0 to ColumnCount - 1 do
begin
case FEduceMode of
emSingle:
begin
if FColumns[n].Visible then
WriteData(FColumns[n].Field);
end;
emDefault:
begin
WriteData(FColumns[n].Field);
end;
end;
end;
EndProgress;
Next;
end;
//還原處理前的記錄位置
GotoBookmark(fBookMark);
//充許在數據感知控件中顯示
EnableControls;
end;
//寫入 Excel 文件結束標識
WriteSuffix;
end;
procedure TDefineExcel.SaveExcel(Save: TStream);
begin
fCol := 0;
fRow := 0;
ExcelStream := Save;
WriteDataCells;
end;
procedure TDefineExcel.DefineFieldMap;
var
I: Integer;
begin
if FColumns.State = csCustomized then
begin
FDataLink.SparseMap := True;
for I := 0 to FColumns.Count-1 do
FDataLink.AddMapping(FColumns[I].FieldName);
end
else
begin
FDataLink.SparseMap := False;
with FDataLink.Dataset do
for I := 0 to FieldList.Count - 1 do
with FieldList[I] do if Visible then FDataLink.AddMapping(FullName);
end;
end;
procedure TDefineExcel.InitColumns;
function FieldIsMapped(F: TField): Boolean;
var
X: Integer;
begin
Result := False;
if F = nil then Exit;
for X := 0 to FDataLink.FieldCount-1 do
if FDataLink.Fields[X] = F then
begin
Result := True;
Exit;
end;
end;
procedure CheckForPassthroughs; // check for Columns.State flip-flop
var
SeenPassthrough: Boolean;
I, J: Integer;
Column: TEduceData;
begin
SeenPassthrough := False;
for I := 0 to FColumns.Count-1 do
if not FColumns[I].IsStored then
SeenPassthrough := True
else if SeenPassthrough then
begin
for J := FColumns.Count-1 downto 0 do
begin
Column := FColumns[J];
if not Column.IsStored then
Column.Free;
end;
Exit;
end;
end;
procedure ResetColumnFieldBindings;
var
I, J, K: Integer;
Fld: TField;
Column: TEduceData;
begin
if FColumns.State = csDefault then
begin
if (not FDataLink.Active) and (FDataLink.DefaultFields) then
FColumns.Clear
else
begin
for J := FColumns.Count-1 downto 0 do
begin
with FColumns[J] do
begin
if not Assigned(Field) or not FieldIsMapped(Field) then
Free;
end;
end;
end;
I := FDataLink.FieldCount;
//if (I = 0) and (FColumns.Count = 0) then
// Inc(I);
for J := 0 to I-1 do
begin
Fld := FDataLink.Fields[J];
if Assigned(Fld) then
begin
K := J;
while (K < FColumns.Count) and (FColumns[K].Field <> Fld) do
Inc(K);
if K < FColumns.Count then
Column := FColumns[K]
else
begin
Column := FColumns.InternalAdd;
Column.Field := Fld;
end;
end
else
Column := FColumns.InternalAdd;
Column.Index := J;
end;
end
else
begin
for I := 0 to FColumns.Count-1 do
FColumns[I].Field := nil;
end;
end;
begin
if ([csLoading, csDestroying] * ComponentState) <> [] then
Exit;
CheckForPassthroughs;
FDatalink.ClearMapping;
if FDatalink.Active then
DefineFieldMap;
ResetColumnFieldBindings;
end;
procedure TDefineExcel.SeTEduceType(const Value: TEduceType);
begin
if FEduceType <> Value then
FEduceType := Value;
end;
procedure TDefineExcel.SetColumns(const Value: TEduceDatas);
begin
FColumns.Assign(Value);
end;
procedure TDefineExcel.DefineProperties(Filer: TFiler);
var
StoreIt: Boolean;
vState: TEduceDatasState;
begin
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -