uxlsbaserecords.pas

来自「delphi 第三方控件很出色,表格制作的」· PAS 代码 · 共 1,229 行 · 第 1/3 页

end;

function TRowRecord.GetOptions: word;
begin
  Result:=GetWord(Data, 12);
end;

procedure TRowRecord.SetOptions(const Value: word);
begin
  SetWord(Data, 12, Value);
end;

procedure TRowRecord.SetRowOutlineLevel(const Level: integer);
begin
  Data[12]:=(Data[12] and not 7) or (Level and 7);
end;

{ TCellRecord }

function TCellRecord.CanJoinNext(const NextRecord: TCellRecord;
  const MaxCol: integer): boolean;
begin
  Result:=false;
end;

constructor TCellRecord.CreateFromData(const aId, aDataSize, aRow, aCol, aXF: word);
var
  aData: pointer;
begin
  GetMem(aData, aDataSize);
  FillChar(aData^, aDataSize, 0);
  Create(aId, aData, aDataSize);
  Row:=aRow;
  Column:=aCol;
  XF:=aXF;
end;

function TCellRecord.GetValue: Variant;
begin
  Result:=unassigned;
end;

function TCellRecord.GetXF: word;
begin
  Result:= GetWord(Data, 4);
end;

procedure TCellRecord.SaveFirstMul(const Workbook: TStream;
  const JoinedRecordSize: Word);
begin
  SaveToStream(Workbook);
end;

procedure TCellRecord.SaveLastMul(const Workbook: TStream);
begin

end;

procedure TCellRecord.SaveMidMul(const Workbook: TStream);
begin

end;

procedure TCellRecord.SetValue(const Value: Variant);
begin
  //Nothing
end;

procedure TCellRecord.SetXF(const Value: word);
begin
  SetWord(Data, 4, Value);
end;

function TCellRecord.TotalSizeFirst: integer;
begin
  Result:=TotalSize;
end;

function TCellRecord.TotalSizeLast: integer;
begin
  Result:=TotalSize;
end;

function TCellRecord.TotalSizeMid: integer;
begin
  Result:=TotalSize;
end;

{ TWindow1Record }

function TWindow1Record.GetActiveSheet: integer;
begin
  Result:= GetWord(Data, 10);
end;

function TWindow1Record.GetFirstSheetVisible: integer;
begin
  Result:= GetWord(Data, 12);
end;

procedure TWindow1Record.SetActiveSheet(const Value: integer);
begin
  SetWord(Data, 10, Value);
  SetWord(Data, 12, 0);
  SetWord(Data, 14, 1);
end;

procedure TWindow1Record.SetFirstSheetVisible(const Value: integer);
begin
  SetWord(Data, 12, Value);
end;

{ TWindow2Record }


function TWindow2Record.DoCopyTo: TBaseRecord;
begin
  Result:= inherited DoCopyTo;
  (Result as TWindow2Record).Selected:=False;
end;

function TWindow2Record.GetSelected: boolean;
begin
  Result:=GetWord(Data, 0) and (1 shl 9) = (1 shl 9);
end;

function TWindow2Record.GetSheetZoom: integer;
begin
  Result:=GetWord(Data, 12);
end;

function TWindow2Record.GetShowGridLines: boolean;
begin
  Result:=GetWord(Data, 0) and $2 = $2;
end;

function TWindow2Record.GetShowGridHeaders: boolean;
begin
  Result:=GetWord(Data, 0) and $4 = $4;
end;

procedure TWindow2Record.SetSelected(const Value: boolean);
begin
  if Value then SetWord(Data, 0, GetWord(Data, 0) or (3 shl 9)) //Selected=true, showing on window=true
  else SetWord(Data, 0, GetWord(Data, 0) and not (3 shl 9)); //Selected=false, showing on window=false
end;

procedure TWindow2Record.SetSheetZoom(const Value: integer);
begin
  if Value<10 then SetWord(Data, 12, 10) else
    if Value>400 then SetWord(Data, 12, 400)else
    SetWord(Data, 12, Value);
end;

procedure TWindow2Record.SetShowGridLines(const Value: boolean);
begin
  if Value then SetWord(Data, 0, GetWord(Data, 0) or $2) //GridLines=true
  else SetWord(Data, 0, GetWord(Data, 0) and not $2); //GridLines=false
end;

procedure TWindow2Record.SetShowGridHeaders(const Value: boolean);
begin
  if Value then SetWord(Data, 0, GetWord(Data, 0) or $4) //GridHeaders=true
  else SetWord(Data, 0, GetWord(Data, 0) and not $4); //GridHeaders=false
end;

{ TDefColWidthRecord }

function TDefColWidthRecord.Width: Word;
begin
  Result:= GetWord(Data, 0);
end;

{ TDefRowHeightRecord }

function TDefRowHeightRecord.Height: Word;
begin
  Result:= GetWord(Data, 2);
end;

{ TSubListRecord }

constructor TSubListRecord.CreateAndAssign(const aSubList: TObjectList);
begin
  inherited Create(0,nil,0);
  FSubList:=aSubList;
end;

function TSubListRecord.DoCopyTo: TBaseRecord;
begin
  Assert(true, 'Sublist record can''t be copied'); //To copy, it should change the reference to FList
  Result:=inherited DoCopyTo;
end;

procedure TSubListRecord.SaveToStream(const Workbook: TStream);
begin
  (FSubList as TBaseRecordList).SaveToStream(Workbook);
end;

function TSubListRecord.TotalSize: integer;
begin
  Result:=0;
end;

{ TDimensionsRecord }

function TDimensionsRecord.Dim: PDimensionsRec;
begin
  Result:=PDimensionsRec(Data);
end;

{ TPageHeaderFooterRecord }

function TPageHeaderFooterRecord.GetText: WideString;
var
  Xs: TExcelString;
  MySelf: TBaseRecord;
  Ofs: integer;
begin
  if Data=nil then
  begin
    Result:='';
    exit;
  end;
  MySelf:=Self;
  Ofs:= 0;
  Xs:=TExcelString.Create(2, MySelf, Ofs );
  try
    Result:=Xs.Value;
  finally
    FreeAndNil(Xs);
  end; //finally
end;

procedure TPageHeaderFooterRecord.SetText(const Value: WideString);
  //Important: This method changes the size of the record without notifying it's parent list
  //It's necessary to adapt the Totalsize in the parent list.
var
  Xs: TExcelString;
  NewDataSize: integer;
begin
  Xs:=TExcelString.Create(2, Value);
  try
    NewDataSize:=Xs.TotalSize;
    ReallocMem( Data, NewDataSize);
    DataSize:=NewDataSize;
    Xs.CopyToPtr( Data, 0 );
  finally
    FreeAndNil(Xs);
  end;  //finally
end;

{ TPrintGridLinesRecord }

function TPrintGridLinesRecord.GetValue: boolean;
begin
  Result:=GetWord(Data,0)=1;
end;

procedure TPrintGridLinesRecord.SetValue(const Value: boolean);
begin
  if Value then SetWord(Data,0,1) else SetWord(Data,0,0)
end;

{ TMarginRecord }

function TMarginRecord.GetValue: double;
begin
  move(Data[0], Result, SizeOf(Result));
end;

procedure TMarginRecord.SetValue(const Value: double);
begin
  Assert(SizeOf(Value)=DataSize,'Error in Margin Record');
  move(Value,Data[0],sizeof(Value));
end;

{ TSetupRecord }

function TSetupRecord.GetFitHeight: word;
begin
  Result:=PSetupRec(Data).FitHeight;
end;

function TSetupRecord.GetFitWidth: word;
begin
  Result:=PSetupRec(Data).FitWidth;
end;

function TSetupRecord.GetFooterMargin: extended;
begin
  Result:=PSetupRec(Data).FooterMargin;
end;

function TSetupRecord.GetHeaderMargin: extended;
begin
  Result:=PSetupRec(Data).HeaderMargin;
end;

function TSetupRecord.GetPrintOptions: word;
begin
  Result:=PSetupRec(Data).GrBit;
end;

function TSetupRecord.GetScale: word;
begin
  if (PSetupRec(Data).GrBit and $4)=$4 then Result:=100 else
  Result:=PSetupRec(Data).Scale;
end;

function TSetupRecord.GetValue: TSetupRec;
begin
  move(Data[0], Result, SizeOf(Result));
end;

procedure TSetupRecord.SetFitHeight(const Value: word);
begin
  PSetupRec(Data).FitHeight:=Value;
end;

procedure TSetupRecord.SetFitWidth(const Value: word);
begin
  PSetupRec(Data).FitWidth:=Value;
end;

procedure TSetupRecord.SetFooterMargin(const Value: extended);
begin
  PSetupRec(Data).FooterMargin:=Value;
end;

procedure TSetupRecord.SetHeaderMargin(const Value: extended);
begin
  PSetupRec(Data).HeaderMargin:=Value;
end;

procedure TSetupRecord.SetPrintOptions(const Value: word);
begin
  PSetupRec(Data).GrBit:=Value and $FF;
end;

procedure TSetupRecord.SetScale(const Value: word);
begin
  PSetupRec(Data).GrBit:=PSetupRec(Data).GrBit or $4;
  PSetupRec(Data).Scale:=Value;
end;

procedure TSetupRecord.SetValue(const Value: TSetupRec);
begin
  Assert(SizeOf(Value)=DataSize,'Error in Setup Record');
  move(Value, Data[0], SizeOf(Value));
end;

{ TWsBoolRecord }

function TWsBoolRecord.GetFitToPage: boolean;
begin
  Result:= Data[1] and 1=1;
end;

function TWsBoolRecord.GetValue: word;
begin
  Result:=GetWord(Data,0);
end;

procedure TWsBoolRecord.SetFitToPage(const Value: boolean);
begin
  if Value then Data[1]:=Data[1] or 1 else Data[1]:=Data[1] and $FF-1;
end;

procedure TWsBoolRecord.SetValue(const Value: word);
begin
  SetWord(Data, 0, Value);
end;

{ TSCLRecord }

constructor TSCLRecord.CreateFromData(const aZoom: integer);
var
  aData:pointer;
begin
  GetMem(aData, 4);
  Create(xlr_SCL, aData, 4);
  SetZoom(aZoom);
end;

function TSCLRecord.GetZoom: integer;
begin
  if GetWord(Data,2)= 0 then Result:=100 else
    Result:=Round(100*GetWord(Data,0)/GetWord(Data,2));
end;

procedure TSCLRecord.SetZoom(const Value: integer);
var
  v: integer;
begin
  if Value<10 then v:=10 else if Value>400 then v:=400 else v:=Value;
  SetWord(Data,0,v);
  SetWord(Data,2,100);
end;

{ TStandardWidthRecord }

function TStandardWidthRecord.Width: Word;
begin
  Result:= GetWord(Data, 0);
end;

end.