flatexcel.pas

comerose_flatstyle_v4.42.9.0_d7.rar

    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