flatexcel.pas

comerose_flatstyle_v4.42.9.0_d7.rar

  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.