recordstorage2.pas

一个经典的读写Excel的控件

  SETUP.PaperSize := 0;
  SETUP.Scale     := 100; // $FF;
  SETUP.PageStart := 1;
  SETUP.FitWidth  := 1;
  SETUP.FitHeight := 1;
  SETUP.Options   := $06B6;
  SETUP.Resolution:= 0;
  SETUP.VertResolution := 0;
  SETUP.HeaderMargin := 0.5;
  SETUP.FooterMargin := 0.5;
  SETUP.Copies    := 0;

  PPROTECT := AddDefRecWord(BIFFRECID_PROTECT,$0000);

  PDEFCOLWIDTH := AddDefRecWord(BIFFRECID_DEFCOLWIDTH,$0008);

  P_INT_COLINFO := AddDefRec(INTERNAL_COLINFO,0);
  P_INT_CELLDATA := AddDefRec(INTERNAL_CELLDATA,0);

  PDIMENSIONS := AddDefRec(BIFFRECID_DIMENSIONS,SizeOf(TRecDIMENSIONS8));
  DIMENSIONS.FirstCol := 0;
  DIMENSIONS.LastCol := 0;
  DIMENSIONS.FirstRow := 0;
  DIMENSIONS.LastRow := 0;

  P_INT_SUFFIXDATA  := AddDefRec(INTERNAL_SUFFIXDATA,0);
  
  PWINDOW2 := AddDefRec(BIFFRECID_WINDOW2,SizeOf(TRecWINDOW2_8));
  WINDOW2.Options := $06B6 and not ($0200);
  WINDOW2.TopRow := 0;
  WINDOW2.LeftCol := 0;
  WINDOW2.HeaderColorIndex := $00000040;
  WINDOW2.ZoomPreview := 0;
  WINDOW2.Zoom := 0;
  WINDOW2.Reserved := 0;

  PSELECTION := AddDefRec(BIFFRECID_SELECTION,SizeOf(TRecSELECTION));
  SELECTION.Pane := 3;
  SELECTION.ActiveRow := 1;
  SELECTION.ActiveCol := 1;
  SELECTION.ActiveRef := 0;
  SELECTION.Refs := 1;
  SELECTION.Col1 := 1;
  SELECTION.Row1 := 1;
  SELECTION.Col2 := 1;
  SELECTION.Row2 := 1;

  PEOF := AddDefRec(BIFFRECID_EOF,0);
end;

function TRecordStorageSheet.GetCALCCOUNT: word;
begin
  Result := PWordArray(@PCALCCOUNT.Data)[0];
end;

procedure TRecordStorageSheet.SetCALCCOUNT(const Value: word);
begin
  PWordArray(@PCALCCOUNT.Data)[0] := Value;
end;

function TRecordStorageSheet.GetITERATION: boolean;
begin
  Result := PWordArray(@PITERATION.Data)[0] = 1;
end;

function TRecordStorageSheet.GetREFMODE: word;
begin
  Result := PWordArray(@PREFMODE.Data)[0];
end;

function TRecordStorageSheet.GetSAVERECALC: boolean;
begin
  Result := PWordArray(@PSAVERECALC.Data)[0] = 1;
end;

procedure TRecordStorageSheet.SetITERATION(const Value: boolean);
begin
  PWordArray(@PITERATION.Data)[0] := Word(Value);
end;

procedure TRecordStorageSheet.SetREFMODE(const Value: word);
begin
  PWordArray(@PREFMODE.Data)[0] := Value;
end;

procedure TRecordStorageSheet.SetSAVERECALC(const Value: boolean);
begin
  PWordArray(@PSAVERECALC.Data)[0] := Word(Value);
end;

function TRecordStorageSheet.GetPRINTGRIDLINES: boolean;
begin
  Result := PWordArray(@PPRINTGRIDLINES.Data)[0] = 1;
end;

function TRecordStorageSheet.GetPRINTHEADERS: boolean;
begin
  Result := PWordArray(@PPRINTHEADERS.Data)[0] = 1;
end;

procedure TRecordStorageSheet.SetPRINTGRIDLINES(const Value: boolean);
begin
  PWordArray(@PPRINTGRIDLINES.Data)[0] := Word(Value);
end;

procedure TRecordStorageSheet.SetPRINTHEADERS(const Value: boolean);
begin
  PWordArray(@PPRINTHEADERS.Data)[0] := Word(Value);
end;

function TRecordStorageSheet.GetGRIDSET: word;
begin
  Result := PWordArray(@PGRIDSET.Data)[0];
end;

procedure TRecordStorageSheet.SetGRIDSET(const Value: word);
begin
  PWordArray(@PGRIDSET.Data)[0] := Value;
end;

function TRecordStorageSheet.GetGUTS: PRecGUTS;
begin
  Result := PRecGUTS(@PGUTS.Data);
end;

function TRecordStorageSheet.GetDEFAULTROWHEIGHT: PRecDEFAULTROWHEIGHT;
begin
  Result := PRecDEFAULTROWHEIGHT(@PDEFAULTROWHEIGHT.Data);
end;

function TRecordStorageSheet.GetWSBOOL: word;
begin
  Result := PWordArray(@PWSBOOL.Data)[0];
end;

procedure TRecordStorageSheet.SetWSBOOL(const Value: word);
begin
  PWordArray(@PWSBOOL.Data)[0] := Value;
end;

function TRecordStorageSheet.GetHCENTER: boolean;
begin
  Result := PWordArray(@PHCENTER.Data)[0] = 1;
end;

procedure TRecordStorageSheet.SetHCENTER(const Value: boolean);
begin
  PWordArray(@PHCENTER.Data)[0] := Word(Value);
end;

function TRecordStorageSheet.GetVCENTER: boolean;
begin
  Result := PWordArray(@PVCENTER.Data)[0] = 1;
end;

procedure TRecordStorageSheet.SetVCENTER(const Value: boolean);
begin
  PWordArray(@PVCENTER.Data)[0] := Word(Value);
end;

procedure TRecordStorageSheet.Clear;
begin
  inherited Clear;
end;

function TRecordStorageSheet.GetSETUP: PRecSETUP;
begin
  Result := PRecSETUP(@PSETUP.Data);
end;

function TRecordStorageSheet.PostCheck: integer;
begin
  Result := -1;
end;

function TRecordStorageSheet.GetDEFCOLWIDTH: word;
begin
  Result := PWordArray(@PDEFCOLWIDTH.Data)[0];
end;

procedure TRecordStorageSheet.SetDEFCOLWIDTH(const Value: word);
begin
  PWordArray(@PDEFCOLWIDTH.Data)[0] := Value;
end;

function TRecordStorageSheet.GetDIMENSIONS: PRecDIMENSIONS8;
begin
  Result := PRecDIMENSIONS8(@PDIMENSIONS.Data[0]);
end;

function TRecordStorageSheet.GetWINDOW2: PRecWINDOW2_8;
begin
  Result := PRecWINDOW2_8(@PWINDOW2.Data[0]);
end;

constructor TRecordStorageSheet.Create;
begin
  inherited Create;
end;

procedure TRecordStorageSheet.UpdateInternal(Id: word);
begin
  case Id of
    INTERNAL_PAGEBREAKES: UpdateIntRec(P_INT_PAGEBREAKES,Id);
    INTERNAL_HEADER:      UpdateIntRec(P_INT_HEADER,Id);
    INTERNAL_MARGINS:     UpdateIntRec(P_INT_MARGINS,Id);
    INTERNAL_COLINFO:     UpdateIntRec(P_INT_COLINFO,Id);
    INTERNAL_CELLDATA:    UpdateIntRec(P_INT_CELLDATA,Id);
    INTERNAL_SUFFIXDATA:  UpdateIntRec(P_INT_SUFFIXDATA,Id);
    else
      raise Exception.CreateFmt('[int] Unknown int. default record %.4X',[Id]);
  end;
end;

function TRecordStorageSheet.GetBOF: PRecBOF8;
begin
  Result := PRecBOF8(@PBOF.Data);
end;

procedure TRecordStorageSheet.MoveDefault(Rec, NewRec: PRecordData);
begin
  case Rec.RecId of
    INTERNAL_PAGEBREAKES:       P_INT_PAGEBREAKES := NewRec;
    INTERNAL_HEADER:            P_INT_HEADER := NewRec;
    INTERNAL_MARGINS:           P_INT_MARGINS := NewRec;
    INTERNAL_COLINFO:           P_INT_COLINFO := NewRec;
    INTERNAL_CELLDATA:          P_INT_CELLDATA := NewRec;
    INTERNAL_SUFFIXDATA:        P_INT_SUFFIXDATA := NewRec;

    BIFFRECID_CALCMODE:         PCALCMODE := NewRec;
    BIFFRECID_CALCCOUNT:        PCALCCOUNT := NewRec;
    BIFFRECID_REFMODE:          PREFMODE := NewRec;
    BIFFRECID_ITERATION:        PITERATION := NewRec;
    BIFFRECID_DELTA:            PDELTA := NewRec;
    BIFFRECID_SAVERECALC:       PSAVERECALC := NewRec;
    BIFFRECID_PRINTGRIDLINES:   PPRINTGRIDLINES := NewRec;
    BIFFRECID_PRINTHEADERS:     PPRINTHEADERS := NewRec;
    BIFFRECID_GRIDSET:          PGRIDSET := NewRec;
    BIFFRECID_GUTS:             PGUTS := NewRec;
    BIFFRECID_DEFAULTROWHEIGHT: PDEFAULTROWHEIGHT := NewRec;
    BIFFRECID_WSBOOL:           PWSBOOL := NewRec;
    BIFFRECID_HCENTER:          PHCENTER := NewRec;
    BIFFRECID_VCENTER:          PVCENTER := NewRec;
    BIFFRECID_SETUP:            PSETUP := NewRec;
    BIFFRECID_PROTECT:          PPROTECT := NewRec;
    BIFFRECID_DEFCOLWIDTH:      PDEFCOLWIDTH := NewRec;
    BIFFRECID_DIMENSIONS:       PDIMENSIONS := NewRec;
    BIFFRECID_WINDOW2:          PWINDOW2 := NewRec;
    BIFFRECID_SELECTION:        PSELECTION := NewRec;
    BIFFRECID_EOF:              PEOF := NewRec;
    else
      raise Exception.CreateFmt('[int] Unknown move default record %.4X',[Rec.RecID]);
  end;
end;

function TRecordStorageSheet.GetSELECTION: PRecSELECTION;
begin
  Result := PRecSELECTION(@PSELECTION.Data[0]);
end;

{ TRecordStorageDefault }

function TRecordStorageDefault.AddDefRec(Id, Length: integer): PRecordData;
var
  P: PRecordData;
begin
  GetMem(P,Length + TRecordData_FixedSz);
  P.Index := -1;
  P.RecId := Id;
  P.Length := Length;
  FDefault.Add(P);
  Result := P;
end;

function TRecordStorageDefault.AddDefRecWord(Id: integer; Data: word): PRecordData;
var
  P: PRecordData;
begin
  GetMem(P,TRecordData_FixedSz + 2);
  P.Index := -1;
  P.RecId := Id;
  P.Length := 2;
  System.Move(Data,P.Data[0],2);
  FDefault.Add(P);
  Result := P;
end;

procedure TRecordStorageDefault.Clear;
begin
  inherited Clear;
  FDefault.Clear;
end;

constructor TRecordStorageDefault.Create;
begin
  inherited Create;
  FDefault := TBaseRecordStorage.Create;
end;

destructor TRecordStorageDefault.Destroy;
begin
  inherited;
  FDefault.Free;
end;

procedure TRecordStorageDefault.MoveAllDefault;
var
  i: integer;
begin
  inherited Clear;
  for i := 0 to FDefault.Count - 1 do begin
    if FDefault[i] <> Nil then begin
      Add(FDefault[i]);
      FDefault[i] := Nil;
    end;
  end;
end;

procedure TRecordStorageDefault.UpdateIntRec(var Rec: PRecordData; Id: word);
var
  i,j: integer;
begin
  j := FDefault.IndexOf(Rec);
  if j >= 0 then begin
    FDefault[j] := Nil;
    for i := j - 1 downto 0 do begin
      if FDefault[i] = Nil then
        Break;
      FDefault[i].Index := Add(FDefault[i]);
      MoveDefault(FDefault[i],Self[Count - 1]);
      FDefault[i] := Nil;
    end;
    if Rec.Index >= 0 then
      Items[Rec.Index] := Rec
    else
      Rec.Index := Add(Rec);
  end;
end;

procedure TRecordStorageDefault.UpdateRec(var Rec: PRecordData; Header: TBIFFHeader; Data: PByteArray);
var
  i,j: integer;
  NewRec: PRecordData;
begin
  j := FDefault.IndexOf(Rec);
  if j >= 0 then begin
    FDefault[j] := Nil;
    for i := j - 1 downto 0 do begin
      if FDefault[i] = Nil then
        Break;
      FDefault[i].Index := Add(FDefault[i]);
      MoveDefault(FDefault[i],Self[Count - 1]);
      FDefault[i] := Nil;
    end;
  end;
  GetMem(NewRec,Header.Length + TRecordData_FixedSz);
  System.Move(Rec^,NewRec^,TRecordData_FixedSz);
  System.Move(Data^,NewRec.Data,Header.Length);
  FreeMem(Rec);
  Rec := NewRec;
  if Rec.Index >= 0 then
    Delete(Rec.Index);
  Rec.Index := Add(Rec);
end;

end.