columns2.pas

一个经典的读写Excel的控件

procedure TXLSColumn.SetWidth(Value: integer);
begin
  if (Value < 0) or (Value > $FFFF) then
    raise Exception.Create(ersInvalidValue);
  FWidth := Value;
end;

{ TXLSColumns }

procedure TXLSColumns.SetRecCOLINFO(Rec: PRecCOLINFO);
var
  i,C1,C2: integer;
  XCol: TXLSColumn;
begin
  // There exists records with at least Col2 = 256. This is illegal as max
  // col # is 255. This is also what the docs says.
  C1 := Min(Rec.Col1,MAXCOL);
  C2 := Min(Rec.Col2,MAXCOL);
  for i := C1 to C2 do begin
    XCol := TXLSColumn.Create(i,FFormats,Rec.FormatIndex,FFormatChangeEvent);
    XCol.FWidth := Rec.Width;
    XCol.Hidden := (Rec.Options and $0001) = $0001;
    XCol.FUnknownOptionsFlag := (Rec.Options and $0002) = $0002;
    XCol.FOutlineLevel := (Rec.Options shr 8) and $0007;
    XCol.FCollapsedOutline := (Rec.Options and $1000) = $1000;
    if FCols[i] <> Nil then
      FCols[i].Free;
    FCols[i] := XCol;
  end;
end;

function TXLSColumns.GetColWidth(Col: integer): integer;
begin
  if FCols[Col] <> Nil then
    Result := FCols[Col].Width
  else
    Result := DEFAULT_COLWIDTH;
end;

procedure TXLSColumns.CopyColumns(Col1, Col2, DestCol: integer);
var
  i: integer;
  XCol: TXLSColumn;
begin
  if not ValidColumns(Col1,Col2) then
    raise Exception.Create('Invalid source columns');
  if not ValidColumns(DestCol,DestCol + (Col2 - Col1)) then
    raise Exception.Create('Invalid destination columns');
  ClearColumns(DestCol,DestCol + (Col2 - Col1));
  for i := Col1 to Col2 do begin
    if FCols[i] <> Nil then begin
      XCol := TXLSColumn.Create(i,FFormats,DEFAULT_FORMAT,FFormatChangeEvent);
      XCol.Assign(FCols[i]);
      FCols[DestCol + Col1 - i + 1] := XCol;
    end;
  end;
end;

constructor TXLSColumns.Create(Formats: TCellFormats);
begin
  FFormats := Formats;
end;

destructor TXLSColumns.Destroy;
begin
  ClearColumns(0,MAXCOL);
  inherited;
end;

procedure TXLSColumns.Clear;
begin
  ClearColumns(0,MAXCOL);
end;

procedure TXLSColumns.DeleteColumns(Col1, Col2: integer);
var
  i,Cnt: integer;
begin
  if not ValidColumns(Col1,Col2) then
    raise Exception.Create('Invalid columns');
  Cnt := Col2 - Col1 + 1;
  ClearColumns(Col1,Col2);
  for i := Col1 to (MAXCOL - Cnt) do begin
    FCols[i] := FCols[i + Cnt];
    if FCols[i] <> Nil then
      FCols[i].FIndex := i;
  end;
end;

procedure TXLSColumns.ClearColumns(Col1, Col2: integer);
var
  i: integer;
begin
  if not ValidColumns(Col1,Col2) then
    raise Exception.Create('Invalid columns');
  for i := Col1 to Col2 do begin
    if FCols[i] <> Nil then begin
      FCols[i].Free;
      FCols[i] := Nil;
    end;
  end;
end;

function TXLSColumns.GeTXLSColumn(Col: integer): TXLSColumn;
begin
  Result := FCols[Col];
end;

procedure TXLSColumns.InsertColumns(Col, ColCount: integer);
var
  i: integer;
  XCol: TXLSColumn;
begin
  if (Col < 0) or (Col > MAXCOL) or (ColCount < 1) or ((ColCount + Col) > MAXCOL) then
    raise Exception.Create('Invalid column');

  if (Col > 0) and (FCols[Col - 1] <> Nil) then
    XCol := FCols[Col - 1]
  else
    XCol := Nil;
  ClearColumns(MAXCOL - ColCount,MAXCOL);
  for i := (MAXCOL - ColCount) downto Col do begin
    FCols[i] := FCols[i - ColCount];
    if FCols[i] <> Nil then
      FCols[i].FIndex := i;
  end;

  for i := Col to Col + ColCount do begin
    if XCol <> Nil then begin
      FCols[i] := TXLSColumn.Create(i,FFormats,DEFAULT_FORMAT,FFormatChangeEvent);
      FCols[i].Assign(XCol);
    end
    else
      FCols[i] := Nil;
  end;
end;

procedure TXLSColumns.MoveColumns(Col1, Col2, DestCol: integer);
begin
  CopyColumns(Col1,Col2,DestCol);
  ClearColumns(Col1,Col2);
end;

function TXLSColumns.ValidColumns(Col1, Col2: integer): boolean;
begin
  Result := (Col1 >= 0) and (Col2 >= 0) and (Col1 <= MAXCOL) and (Col2 <= MAXCOL) and (Col2 >= Col1);
end;

procedure TXLSColumns.SetColWidth(Col1,Col2: integer; Value: integer);
var
  i: integer;
begin
  if Col1 > Col2 then
    raise Exception.Create('Invalid columns');

  for i := Col1 to Col2 do begin
    if (FCols[i] <> Nil) and (FCols[i].FWidth = Value) then
      Continue;
    if FCols[i] <> Nil then begin
      FCols[i].FWidth := Value;
      if FCols[i].IsDefault then begin
        FCols[i].Free;
        FCols[i] := Nil;
      end;
    end
    else if Value <> DEFAULT_COLWIDTH then begin
      FCols[i] := TXLSColumn.Create(i,FFormats,DEFAULT_FORMAT,FFormatChangeEvent);
      FCols[i].FWidth := Value;
    end;
  end;
end;

procedure TXLSColumns.SetColWidthChar(Col1, Col2: integer; Value: double);
begin
  SetColWidth(Col1,Col2,Round(Value * 256));
end;

procedure TXLSColumns.SaveToStream(Stream: TXLSStream; PBuf: PByteArray);
var
  i,j: integer;
begin
  i := 0;
  while i <= MAXCOL do begin
    if FCols[i] <> Nil then begin
      j := i;
      while (j <= MAXCOL) and (FCols[j] <> Nil) and FCols[j].Equal(FCols[i]) do
        Inc(j);
      PRecCOLINFO(PBuf).Col1 := i;
      PRecCOLINFO(PBuf).Col2 := j - 1;
      PRecCOLINFO(PBuf).Width := FCols[i].Width;
      PRecCOLINFO(PBuf).FormatIndex := FCols[i].FormatIndex;
      PRecCOLINFO(PBuf).Reserved := $0000;
      PRecCOLINFO(PBuf).Options := 0;
      if FCols[i].Hidden then
        PRecCOLINFO(PBuf).Options := PRecCOLINFO(PBuf).Options or $0001;
      if FCols[i].FUnknownOptionsFlag then
        PRecCOLINFO(PBuf).Options := PRecCOLINFO(PBuf).Options or $0002;
      PRecCOLINFO(PBuf).Options := PRecCOLINFO(PBuf).Options or (FCols[i].OutlineLevel shl 8);
      if FCols[i].CollapsedOutline then
        PRecCOLINFO(PBuf).Options := PRecCOLINFO(PBuf).Options or $1000;
      Stream.WriteHeader(BIFFRECID_COLINFO,SizeOf(TRecCOLINFO));
      Stream.Write(PBuf^,SizeOf(TRecCOLINFO));
      i := j;
    end
    else
      Inc(i);
  end;
end;

function TXLSColumns.GetColWidthPixels(Canvas: TCanvas; Col: integer): integer;
begin
  if FCols[Col] = Nil then
    Result := Round((DEFAULT_COLWIDTH / 256) * Canvas.TextWidth('8'))
  else
    Result := Round((Items[Col].FWidth / 256) * Canvas.TextWidth('8'));
end;

procedure TXLSColumns.CopyList(List: TList; Col1, Col2: integer);
var
  i: integer;
begin
  if not ValidColumns(Col1,Col2) then
    raise Exception.Create('Invalid columns');
  for i := Col1 to Col2 do begin
    if FCols[i] <> Nil then
      List.Add(FCols[i]);
  end;
end;

procedure TXLSColumns.InsertList(List: TList; DestCol,ColCount: integer);
var
  i: integer;
  XCol: TXLSColumn;
begin
  MoveColumns(DestCol,DestCol + ColCount,DestCol + ColCount + 1);
  for i := 0 to List.Count - 1 do begin
    XCol := TXLSColumn.Create(TXLSColumn(List[i]).FIndex,FFormats,DEFAULT_FORMAT,FFormatChangeEvent);
    XCol.Assign(TXLSColumn(List[i]));
    FCols[XCol.FIndex] := XCol;
  end;
end;

end.