uxlsbaserecords.pas

来自「DELPHI界面增强控件,非常好,里面有显示GIF的图片控件,更美观的下拉框控件」· PAS 代码 · 共 1,072 行 · 第 1/3 页

procedure TRowRecord.AutoHeight;
begin
  Data[12]:= Data[12] and not $40;
end;

function TRowRecord.IsAutoHeight: boolean;
begin
  Result:=  not (Data[12] and $40 = $40);
end;

procedure TRowRecord.SetXF(const Value: word);
begin
  Data[12]:= Data[12] or $80;
  Data[13]:= Data[13] or $01;
  SetWord(Data, 14, Value);
end;

procedure TRowRecord.SaveRangeToStream(const DataStream: TStream; const aMinCol, aMaxCol: integer);
var
  sMinCol, sMaxCol: integer;
begin
  sMinCol:=MinCol;
  sMaxCol:=MaxCol;
  try
    if sMinCol<aMinCol then MinCol:=aMinCol;
    if sMaxCol>aMaxCol+1 then MaxCol:=aMaxCol+1;
    inherited SaveToStream(DataStream);
  finally
    MinCol:=sMinCol;
    MaxCol:=sMaxCol;
  end; //Finally

end;

function TRowRecord.IsFormatted: boolean;
begin
  Result:=Data[12] and $80= $80;
end;

function TRowRecord.IsModified: boolean;
begin
  Result:=(Data[12]<>0) or (Data[13]<>1);
end;

{ TCellRecord }

constructor TCellRecord.CreateFromData(const aId, aDataSize, aRow, aCol, aXF: word);
begin
  GetMem(Data, aDataSize);
  Create(aId, Data, 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.SetValue(const Value: Variant);
begin
  //Nothing
end;

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

{ TWindow1Record }

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

procedure TWindow1Record.SetActiveSheet(const Value: integer);
begin
  SetWord(Data, 10, Value);
  SetWord(Data, 12, 0);
  SetWord(Data, 14, 1);
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;

procedure TWindow2Record.SetSelected(const Value: boolean);
begin
  if Value then SetWord(Data, 0, GetWord(Data, 0) or (1 shl 9)) //Selected=true
  else SetWord(Data, 0, GetWord(Data, 0) and not (1 shl 9)); //Selected=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;

{ 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.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.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);
begin
  GetMem(Data, 4);
  Create(xlr_SCL, Data, 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;

end.