rm_wawexcel.pas

这是一个功能强大

  finally
    if SaveFont <> HFont(nil) then
      SelectObject(DC, SaveFont);
    F.Free;
  end;
  ReleaseDC(0, DC);
end;

function GetPixelPerInch: Integer;
var
  DC: HDC;
begin
  DC := GetDC(0);
  Result := GetDeviceCaps(DC, LOGPIXELSX); // LOGPIXELSX = $58
  ReleaseDC(0, DC);
end;

function PointInRect(X: Integer; Y: Integer; var R: TRect): Boolean;
begin
  Result := ((X >= R.Left) and (X <= R.Right)) and ((Y >= R.Top) and (Y <= R.Bottom))
end;

function RectOverRect(var r1: TRect; var r2: TRect): Boolean;
begin
  Result := ((((r2.Left >= r1.Left) and (r2.Left <= r1.Right)) or ((r2.Right >= r1.Left) and (r2.Right <= r1.Right))) and
    (((r2.Top >= r1.Top) and (r2.Top <= r1.Bottom)) or ((r2.Bottom <= r1.Bottom) and (r2.Bottom >= r1.Top)))) or
    ((((r1.Left >= r2.Left) and (r1.Left <= r2.Right)) or ((r1.Right >= r2.Left) and (r1.Right <= r2.Right))) and
    (((r1.Top >= r2.Top) and (r1.Top <= r2.Bottom)) or ((r1.Bottom <= r2.Bottom) and (r1.Bottom >= r2.Top))));
end;

function RectEqualRect(var r1: TRect; var r2: TRect): Boolean;
begin
  Result := (r1.Top = r2.Top) and (r1.Left = r2.Left) and (r1.Bottom = r2.Bottom) and (r1.Right = r2.Right);
end;

constructor TwawXLSRow.Create;
begin
  inherited Create;
  FHeight := XLSDefaultRowHeight;
end;

function TwawXLSRow.GetPixelHeight: Integer;
begin
  Result := MulDiv(GetPixelPerInch, FHeight, wawPointPerInch14);
end;

procedure TwawXLSRow.SetPixelHeight(value: Integer);
begin
  FHeight := MulDiv(value, wawPointPerInch14, GetPixelPerInch);
end;

function TwawXLSRow.GetInchHeight: Double;
begin
  Result := FHeight / wawPointPerInch14;
end;

procedure TwawXLSRow.SetInchHeight(value: Double);
begin
  FHeight := Round(value * wawPointPerInch14);
end;

function TwawXLSRow.GetCentimeterHeight: Double;
begin
  Result := GetInchHeight * wawSmRepInch;
end;

procedure TwawXLSRow.SetCentimeterHeight(value: Double);
begin
  SetInchHeight(value / wawSmRepInch);
end;

function TwawXLSRow.GetExcelHeight: Double;
begin
  Result := FHeight / wawExcelHeightC;
end;

procedure TwawXLSRow.SetExcelHeight(value: Double);
begin
  FHeight := Round(value * wawExcelHeightC);
end;

constructor TwawXLSCol.Create;
begin
  inherited Create;
  FWidth := (XLSDefaultColumnWidthInChars + 1) * wawPointPerInch10;
end;

procedure TwawXLSCol.SetWidth(Value: Integer);
begin
  FWidth := Min(Value, $FF00);
end;

function TwawXLSCol.GetPixelWidth: Integer;
begin
  Result := MulDiv(GetCharacterWidth, FWidth, wawPointPerInch10);
end;

procedure TwawXLSCol.SetPixelWidth(value: Integer);
begin
  FWidth := MulDiv(value, wawPointPerInch10, GetCharacterWidth);
end;

function TwawXLSCol.GetInchWidth: Double;
begin
  Result := GetCharacterWidth * FWidth / (GetPixelPerInch * wawPointPerInch10);
end;

procedure TwawXLSCol.SetInchWidth(value: Double);
begin
  FWidth := Round(GetPixelPerInch * wawPointPerInch10 * value / GetCharacterWidth);
end;

function TwawXLSCol.GetCentimeterWidth: Double;
begin
  Result := GetInchWidth * wawSmRepInch;
end;

procedure TwawXLSCol.SetCentimeterWidth(value: Double);
begin
  SetInchWidth(value / wawSmRepInch);
end;

function TwawXLSCol.GetExcelWidth: Double;
begin
  if FWidth > wawExcelWidthC1 then
    Result := (FWidth - wawExcelWidthC2) / wawPointPerInch10
  else
    Result := FWidth / wawExcelWidthC1;
end;

procedure TwawXLSCol.SetExcelWidth(value: Double);
begin
  if value > 1 then
    FWidth := Round(value * wawPointPerInch10) + wawExcelWidthC2
  else
    FWidth := Round(value * wawExcelWidthC1);
end;

constructor TwawXLSBorder.Create;
begin
  inherited Create;
// Init to default values
  FLineStyle := wawlsNone;
  FWeight := wawxlHairline;
  FColor := clBlack;
end;

destructor TwawXLSBorder.Destroy;
begin
  inherited Destroy;
end;

constructor TwawXLSBorders.Create;
var
  i: TwawXLSBorderType;
begin
  inherited Create;
  for i := Low(TwawXLSBorderType) to High(TwawXLSBorderType) do
    FBorders[i] := TwawXLSBorder.Create;
end;

destructor TwawXLSBorders.Destroy;
var
  i: TwawXLSBorderType;
begin
  for i := Low(TwawXLSBorderType) to High(TwawXLSBorderType) do
    FBorders[i].Free;
  inherited Destroy;
end;

function TwawXLSBorders.GetItem(i: TwawXLSBorderType): TwawXLSBorder;
begin
  Result := FBorders[i];
end;

procedure TwawXLSBorders.SetAttributes(ABorders: TwawXLSBorderTypes;
  AColor: TColor; ALineStyle: TwawXLSLineStyleType;
  AWeight: TwawXLSWeightType);
var
  i: Integer;
begin
  for i := Ord(Low(TwawXLSBorderType)) to Ord(High(TwawXLSBorderType)) do
  begin
    if TwawXLSBorderType(i) in TwawXLSBorderTypes(ABorders) then
    begin
      Borders[TwawXLSBorderType(i)].FColor := AColor;
      Borders[TwawXLSBorderType(i)].FLineStyle := ALineStyle;
      Borders[TwawXLSBorderType(i)].FWeight := AWeight;
    end;
  end;
end;

constructor TwawXLSRange.Create(AWorksheet: TwawXLSWorksheet);
begin
// inherited Create;
  FVerticalAlignment := wawxlVAlignBottom;
  FHorizontalAlignment := wawxlHAlignGeneral;
  FWorksheet := AWorksheet;
  FBorders := TwawXLSBorders.Create;
  FFont := TFont.Create;
  FFont.Name := sDefaultFontName;
  FFont.Size := 10;
  FFont.Color := clBlack;
end;

destructor TwawXLSRange.Destroy;
begin
// inherited Destroy;
  FBorders.Free;
  FFont.Free;
end;

function TwawXLSRange.GetWorkbook: TwawXLSWorkbook;
begin
  Result := nil;
  if FWorksheet <> nil then
    Result := FWorksheet.Workbook;
end;

procedure TwawXLSRange.SetValue(Value: Variant);
begin
  if (VarType(Value) = varOleStr) or (VarType(Value) = varString) then
    FValue := StringReplace(VarToStr(Value), #13#10, #10, [rfReplaceAll])
  else
    FValue := Value;
end;

function TwawXLSRange.GetCellDataType: TwawCellDataType;
var
  vt: Integer;
begin
  if FFormula = '' then
  begin
    vt := VarType(FValue);
    if (vt = varSmallint) or
      (vt = varInteger) or
      (vt = varSingle) or
      (vt = varDouble) or
      (vt = varCurrency) or
      (vt = varByte) then
      Result := wawcdtNumber
    else
      Result := wawcdtString;
  end
  else
    Result := wawcdtFormula;
end;

constructor TwawXLSPageSetup.Create;
begin
  inherited Create;
  FLeftMargin := 2;
  FRightMargin := 2;
  FTopMargin := 2.5;
  FBottomMargin := 2.5;
  FPaperSize := wawxlPaperA4;
  FZoom := 100;
  FitToPagesTall := 1;
  FitToPagesWide := 1;
  FirstPageNumber := 1;
end;

constructor TwawImage.Create(_Left: Integer; _Top: Integer;
  _Right: Integer; _Bottom: Integer; _Picture: TPicture;
  _OwnsImage: Boolean);
begin
  inherited Create;
  FLeft := _Left;
  FTop := _Top;
  FRight := _Right;
  FBottom := _Bottom;
  FOwnsImage := _OwnsImage;
  FBorderLineColor := $00FFFFFF;
  FBorderLineStyle := wawblsSolid;
  FBorderLineWeight := wawblwHairline;
  FScalePercentX := 0;
  FScalePercentY := 0;

  if FOwnsImage = True then
  begin
    FPicture := TPicture.Create;
    FPicture.Assign(_Picture);
  end
  else
    FPicture := _Picture;
end;

constructor TwawImage.CreateWithOffsets(_Left: Integer; _LeftCO: Integer;
  _Top: Integer; _TopCO: Integer; _Right: Integer; _RightCO: Integer;
  _Bottom: Integer; _BottomCO: Integer; _Picture: TPicture;
  _OwnsImage: Boolean);
begin
  Create(_Left, _Top, _Right, _Bottom, _Picture, _OwnsImage);
  FLeftCO := _LeftCO;
  FTopCO := _TopCO;
  FRightCO := _RightCO;
  FBottomCO := _BottomCO;
end;

constructor TwawImage.CreateScaled(_Left: Integer; _LeftCO: Integer;
  _Top: Integer; _TopCO: Integer; _ScalePercentX: Integer;
  _ScalePercentY: Integer; _Picture: TPicture; _OwnsImage: Boolean);
begin
  CreateWithOffsets(_Left, _LeftCO, _Top, _TopCO, $FF, $FF, $FF, $FF, _Picture, _OwnsImage);
  FScalePercentX := _ScalePercentX;
  FScalePercentY := _ScalePercentY;
end;

destructor TwawImage.Destroy;
begin
  if FOwnsImage then
    FPicture.Free;
  inherited Destroy;
end;

destructor TwawImages.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TwawImages.GetItm(i: Integer): TwawImage;
begin
  Result := inherited Items[i];
end;

procedure TwawImages.Clear;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    Items[i].Free;
  inherited Clear;
end;

constructor TwawXLSWorksheet.Create(AWorkbook: TwawXLSWorkbook);
var
  i: Integer;
  j: Integer;
begin
  inherited Create;
  FDimensions := Rect(-1, -1, -1, -1);
  FWorkbook := AWorkbook;
  FRanges := TList.Create;
  FCols := TList.Create;
  FRows := TList.Create;
  FPageSetup := TwawXLSPageSetup.Create;
  FImages := TwawImages.Create;
  FPageBreaks := TList.Create;

  i := Workbook.FSheets.Count + 1;
  while true do
  begin
    j := 0;
    while (j < FWorkbook.FSheets.Count) and
      (AnsiCompareText(TwawXLSWorksheet(FWorkbook.FSheets[j]).Title,
      sXLSWorksheetTitlePrefix + IntToStr(i)) = 0) do Inc(j);
    if (j >= FWorkbook.FSheets.Count) or
      (AnsiCompareText(TwawXLSWorksheet(FWorkbook.FSheets[j]).Title,
      sXLSWorksheetTitlePrefix + IntToStr(i)) <> 0) then
      break;
    Inc(i);
  end;
  Title := sXLSWorksheetTitlePrefix + IntToStr(i);
end;

destructor TwawXLSWorksheet.Destroy;
var
  i: Integer;
begin
  for i := 0 to FRanges.Count - 1 do
    TwawXLSRange(FRanges.List[i]).Free;
  for i := 0 to FCols.Count - 1 do
    TwawXLSCol(FCols[i]).Free;
  for i := 0 to FRows.Count - 1 do
    TwawXLSRow(FRows[i]).Free;
  FPageBreaks.Free;
  FRanges.Free;
  FCols.Free;
  FRows.Free;
  FPageSetup.Free;
  FImages.Free;
  inherited Destroy;
end;

function TwawXLSWorksheet.GetIndexInWorkBook: Integer;
begin
  if WorkBook = nil then
    Result := -1
  else