?? flatexcel.pas
字號:
vState := EduceDatas.State;
if Filer.Ancestor = nil then
StoreIt := vState = csCustomized
else
if vState <> TDefineExcel(Filer.Ancestor).EduceDatas.State then
StoreIt := True
else
StoreIt := (vState = csCustomized) and
(not CollectionsEqual(EduceDatas, TDefineExcel(Filer.Ancestor).EduceDatas, Self, TDefineExcel(Filer.Ancestor)));
Filer.DefineProperty('Columns', ReadColumns, WriteColumns, StoreIt);
inherited DefineProperties(Filer);
end;
procedure TDefineExcel.ReadColumns(Reader: TReader);
begin
EduceDatas.Clear;
Reader.ReadValue;
Reader.ReadCollection(EduceDatas);
end;
procedure TDefineExcel.WriteColumns(Writer: TWriter);
begin
if EduceDatas.State = csCustomized then
Writer.WriteCollection(EduceDatas)
else // ancestor state is customized, ours is not
Writer.WriteCollection(nil);
end;
function TDefineExcel.GetFieldCount: Integer;
begin
if Assigned(FDataLink.DataSet) then
result := FDataLink.FieldCount
else
result := 0;
end;
procedure TDefineExcel.BeginLayout;
begin
BeginUpdate;
if FLayoutLock = 0 then
EduceDatas.BeginUpdate;
Inc(FLayoutLock);
end;
procedure TDefineExcel.BeginUpdate;
begin
Inc(FUpdateLock);
end;
procedure TDefineExcel.EndLayout;
begin
if FLayoutLock > 0 then
begin
try
try
if FLayoutLock = 1 then
InitColumns;
finally
if FLayoutLock = 1 then
FColumns.EndUpdate;
end;
finally
Dec(FLayoutLock);
EndUpdate;
end;
end;
end;
procedure TDefineExcel.EndUpdate;
begin
if FUpdateLock > 0 then
Dec(FUpdateLock);
end;
procedure TDefineExcel.LayoutChanged;
begin
if AcquireLayoutLock then
EndLayout;
end;
function TDefineExcel.AcquireLayoutLock: Boolean;
begin
Result := (FUpdateLock = 0) and (FLayoutLock = 0);
if Result then BeginLayout;
end;
procedure TDefineExcel.Loaded;
begin
inherited Loaded;
LayoutChanged;
end;
function TDefineExcel.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TDefineExcel.SetDataSource(const Value: TDataSource);
begin
if Value = FDatalink.Datasource then Exit;
if Assigned(Value) then
if Assigned(Value.DataSet) then
if Value.DataSet.IsUnidirectional then
DatabaseError(SDataSetUnidirectional);
FDataLink.DataSource := Value;
if Value <> nil then Value.FreeNotification(Self);
end;
procedure TDefineExcel.LinkActive(Value: Boolean);
begin
try
LayoutChanged;
finally
//
end;
end;
function TDefineExcel.CreateDataLink: TEduceLink;
begin
Result := TEduceLink.Create(Self);
end;
function TDefineExcel.GetColumnCount: integer;
begin
Result := FColumns.Count;
end;
function TDefineExcel.GetEduceCount: integer;
var
i:integer;
begin
result := 0;
for i:= 0 to FColumns.Count - 1 do
if FColumns[i].Visible then result := result + 1;
end;
procedure TDefineExcel.ExportAll;
var i:integer;
begin
for i:=0 to ColumnCount - 1 do FColumns[i].Visible := True;
end;
function TDefineExcel.GetFields(FieldIndex: Integer): TField;
begin
Result := FDatalink.Fields[FieldIndex];
end;
procedure TDefineExcel.CancelLayout;
begin
if FLayoutLock > 0 then
begin
if FLayoutLock = 1 then
EduceDatas.EndUpdate;
Dec(FLayoutLock);
EndUpdate;
end;
end;
procedure TDefineExcel.ExecuteSave;
var
SaveDlg: TSaveDialog;
FileStream: TFileStream;
inx: integer;
UseState: boolean;
tFile:String;
begin
case FEduceMode of
emSingle:
begin
FieldForm := TFieldForm.Create(self);
try
FieldForm.FieldBox.Items.Clear;
for inx := 0 to FColumns.Count - 1 do
begin
FieldForm.FieldBox.Items.Add(FColumns[inx].Caption);
FieldForm.FieldBox.Checked[inx] := FColumns[inx].Visible;
end;
FieldForm.ShowModal;
if FieldForm.ModalResult = mrOk then
begin
for inx := 0 to FieldForm.FieldBox.Items.Count - 1 do
FColumns[inx].Visible := FieldForm.FieldBox.Checked[inx];
SaveDlg := TSaveDialog.Create(self);
try
SaveDlg.DefaultExt := FDefaultExt;
SaveDlg.Filter := '微軟電子表格(MS-EXCEL文件)|*.XLS';
SaveDlg.Title := '保存為';
SaveDlg.FileName := FFileName;
if SaveDlg.Execute then
begin
if Assigned(FDataLink.DataSet) then
begin
useState := true;
if FileExists(SaveDlg.FileName) then
useState := DeleteFile(SaveDlg.FileName);
if useState then
begin
FileStream := TFileStream.Create(SaveDlg.FileName, fmCreate);
try
SaveExcel(FileStream);
Finally
FileStream.Free;
end;
end
else ShowMessage('文件正在使用中,不能覆蓋文件!');
end;
end;
finally
SaveDlg.Free;
end;
end;
finally
FieldForm.Free;
FieldForm := Nil;
end;
end;
emDefault:
begin
if Assigned(FDataLink.DataSet) then
begin
useState := true;
tFile := FFileName;
if UpperCase(ExtractFileExt(FFileName))<>UpperCase(FDefaultExt) then
tFile := FFileName + FDefaultExt;
if FileExists(tFile) then
useState := DeleteFile(tFile);
if useState then
begin
FileStream := TFileStream.Create(tFile, fmCreate);
try
SaveExcel(FileStream);
Finally
FileStream.Free;
end;
end
else ShowMessage('文件正在使用中,不能覆蓋文件!');
end;
end;
end;
end;
procedure TDefineExcel.InitFields;
var
inx: integer;
Col: TEduceData;
begin
if Assigned(FDataLink.DataSet) then
begin
with FDataLink.DataSet.FieldDefs do
begin
if (not FDataLink.Active) and (Count > 0) then
begin
FColumns.BeginUpdate;
FColumns.Clear;
for inx:=0 to Count - 1 do
begin
Col := FColumns.Add;
Col.FieldName := Items[inx].Name;
Col.Caption := Items[inx].Name;
end;
FColumns.EndUpdate;
end;
end;
end;
end;
procedure TDefineExcel.ClearFields;
begin
FColumns.BeginUpdate;
FColumns.Clear;
FColumns.EndUpdate;
end;
procedure TDefineExcel.RestoreFields;
var
inx : integer;
col : TEduceData;
begin
FColumns.BeginUpdate;
for inx:=0 to FColumns.Count - 1 do
begin
Col := FColumns[inx];
Col.Caption := Col.FieldName;
Col.Visible := True;
end;
FColumns.EndUpdate;
end;
procedure TDefineExcel.SetDefaultExt(Value: String);
begin
if FDefaultExt <> Value then
begin
if Value[1] <> '.' then
Value := '.'+value;
FDefaultExt := Value;
end;
end;
{ TEduceLink }
const
MaxMapSize = (MaxInt div 2) div SizeOf(Integer);
type
TIntArray = array[0..MaxMapSize] of Integer;
PIntArray = ^TIntArray;
constructor TEduceLink.Create(ADSExcel: TDefineExcel);
begin
inherited Create;
FCells := ADSExcel;
VisualControl := True;
end;
destructor TEduceLink.Destroy;
begin
ClearMapping;
inherited Destroy;
end;
function TEduceLink.GetDefaultFields: Boolean;
var
I: Integer;
begin
Result := True;
if DataSet <> nil then
Result := DataSet.DefaultFields;
if Result and SparseMap then
for I := 0 to FFieldCount-1 do
if FFieldMap[I] < 0 then
begin
Result := False;
Exit;
end;
end;
function TEduceLink.GetFields(I: Integer): TField;
begin
if (0 <= I) and (I < FFieldCount) and (FFieldMap[I] >= 0) then
Result := DataSet.FieldList[FFieldMap[I]]
else
Result := nil;
end;
function TEduceLink.AddMapping(const FieldName: string): Boolean;
var
Field: TField;
NewSize: Integer;
begin
Result := True;
if FFieldCount >= MaxMapSize then
RaiseGridError(STooManyColumns);
if SparseMap then
Field := DataSet.FindField(FieldName)
else
Field := DataSet.FieldByName(FieldName);
if FFieldCount = Length(FFieldMap) then
begin
NewSize := Length(FFieldMap);
if NewSize = 0 then
NewSize := 8
else
Inc(NewSize, NewSize);
if (NewSize < FFieldCount) then
NewSize := FFieldCount + 1;
if (NewSize > MaxMapSize) then
NewSize := MaxMapSize;
SetLength(FFieldMap, NewSize);
end;
if Assigned(Field) then
begin
FFieldMap[FFieldCount] := Dataset.FieldList.IndexOfObject(Field);
Field.FreeNotification(FCells);
end
else
FFieldMap[FFieldCount] := -1;
Inc(FFieldCount);
end;
procedure TEduceLink.ActiveChanged;
begin
if Active and Assigned(DataSource) then
if Assigned(DataSource.DataSet) then
if DataSource.DataSet.IsUnidirectional then
DatabaseError(SDataSetUnidirectional);
FCells.LinkActive(Active);
FModified := False;
end;
procedure TEduceLink.ClearMapping;
begin
FFieldMap := nil;
FFieldCount := 0;
end;
procedure TEduceLink.LayoutChanged;
var
SaveState: Boolean;
begin
SaveState := FCells.LayoutSet;
FCells.LayoutSet := True;
try
FCells.LayoutChanged;
finally
FCells.LayoutSet := SaveState;
end;
inherited LayoutChanged;
end;
function TEduceLink.GetMappedIndex(ColIndex: Integer): Integer;
begin
if (0 <= ColIndex) and (ColIndex < FFieldCount) then
Result := FFieldMap[ColIndex]
else
Result := -1;
end;
function TEduceLink.IsAggRow(Value: Integer): Boolean;
begin
Result := False;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -