ucustomexcel.pas

韩国的一个数据表控件2 很好用 支持D4-5 一共5个 Korea, a data table control

var
  i: Integer;
begin
  Clear;

  FRowHeight := 1;
  with AExcel.FGrid do
    for i := 0 to VGroupCount - 1 do
    begin
      FGroups.Add(TwExcelGroup.Create);

      FRowHeight := IMax(FRowHeight, VGroups[i].Levels);
    end;

  FColWidth := Ord(AExcel.RowNumber);

  for i := 0 to Count - 1 do
  begin
    Groups[i].Load(AExcel.FGrid.VGroups[i], FRowHeight);
    Inc(FColWidth, Groups[i].Width);
  end;
end;

procedure TwExcelGroups.LoadTitle(AExcel: TwCustomExcel);
var
  i: Integer;
begin
  Clear;

  FRowHeight := 1;
  with AExcel.FGrid do
    for i := 0 to VGroupCount - 1 do
    begin
      FGroups.Add(TwExcelGroup.Create);

      FRowHeight := IMax(FRowHeight, VGroups[i].Levels + Ord(VGroups[i].Title.Visible));
    end;

  FColWidth := Ord(AExcel.RowNumber);

  for i := 0 to Count - 1 do
  begin
    Groups[i].LoadTitle(AExcel.FGrid.VGroups[i], FRowHeight);
    Inc(FColWidth, Groups[i].Width);
  end;
end;

{ TwCustomExcel }
//== init & final ====================================================================//
constructor TwCustomExcel.Create(AComponent: TComponent);
begin
  inherited;

  FTitle  := TwExcelTitle.Create;
  FHeader := TwExcelHeader.Create;
  FFooter := TwExcelFooter.Create;

  FBorderColor  := clGray;
  FBorderStyle  := psSolid;
  FBorderWeight := xlThin;
  FRowNumber    := True;
  FSheetName    := 'Sheet1';
  FShowExcel    := True;
end;

destructor TwCustomExcel.Destroy;
begin
  FreeAndNil(FTitle);
  FreeAndNil(FHeader);
  FreeAndNil(FFooter);

  FreeAndNil(FGroups);

  inherited;
end;

//== property methods ================================================================//
//== protected methods ===============================================================//
function TwCustomExcel.CheckBook: Boolean;
begin
  Result := not VarIsEmpty(FBook) and not VarIsNull(FBook); // VarIsNull篮 鞘夸绝促.
end;

procedure TwCustomExcel.CalcExtents;
begin
  Assert(FGrid <> nil);

  with FGrid do
    if ColumnMode then
      FWidth := IMax(1, Ord(FRowNumber) + VColCount)
    else
    begin
      if FGroups = nil then
        FGroups := TwExcelGroups.Create;

      FGroups.LoadTitle(Self);
      FWidth := FGroups.ColWidth;
    end;
end;

function TwCustomExcel.GetRange(x1, y1, x2, y2: Integer): OleVariant;
begin
//  Result := FSheet.Range[FSheet.Cells[y1, x1], FSheet.Cells[y2, x2]];
  Result := FSheet.Range[ XLChar(X1) + IntToStr( y1 ), XLChar( X2 )+ Inttostr( y2 ) ];

end;

{
function TwCustomExcel.GetRange(range: OleVariant; x1, y1, x2, y2: Integer): OleVariant;
begin
//  Result := FSheet.Range[range.Cells[y1, x1], range.Cells[y2, x2]];
  Result := FSheet.Range[ XLChar(X1) + IntToStr( y1 ), XLChar(  X2 )+ Inttostr( y2  ) ];

end;
}

procedure TwCustomExcel.SetBorder(V: OleVariant);
begin
  V.Borders.LineStyle   := _EXCEL_PENSTYLE[BorderStyle];
  V.Borders.Weight      := _EXCEL_BORDERWEIGHT[BorderWeight];
  V.Borders.Color       := ColorToRGB(BorderColor);
end;

//== override methods ================================================================//
procedure TwCustomExcel.Notification(AComponent: TComponent; Op: TOperation);
begin
  inherited;

  if Op= opRemove then
    if AComponent = Grid then
      Grid := nil;
end;

function TwCustomExcel.ConvertTitle(rStart: Integer): Integer;
var
  r: OleVariant;
begin
  Result := 0;

  if FTitle.Visible then
  begin
    r := GetRange(rStart, 1, FWidth, rStart);
    r.Merge;

    try
      r.Select;
    except
    end;

    with FTitle do
    begin
      SetBorder(r);
      r.Interior.Color      := ColorToRGB(Color);
      r.HorizontalAlignment := _EXCEL_HALIGN[HAlign];
      r.VerticalAlignment   := _EXCEL_VALIGN[VAlign];
      _Convert(Font, r.Font);
      r.Value               := Text;
    end;

    Result := 1;
  end;
end;

function TwCustomExcel.ConvertHeader(rStart: Integer): Integer;
var
  r: OleVariant;
begin
  Result := 0;

  if FHeader.Visible then
  begin
    r := GetRange(1, rStart, FWidth, rStart);
    r.Merge;

    if not FTitle.Visible then
      try
        r.Select;
      except
      end;

    with FHeader do
    begin
      SetBorder(r);
      r.Interior.Color      := ColorToRGB(Color);
      r.HorizontalAlignment := _EXCEL_HALIGN[HAlign];
      r.VerticalAlignment   := _EXCEL_VALIGN[VAlign];
      _Convert(Font, r.Font);
      r.Value               := _Convert(Lines);
      r.Rows[1].RowHeight   := r.Rows[1].RowHeight * IMax(1, Lines.Count);
    end;

    Result := 1;
  end;
end;

function TwCustomExcel.ConvertFooter(rStart: Integer): Integer;
var
  r: OleVariant;
begin
  Result := 0;

  if FFooter.Visible then
  begin
    r := GetRange(1, rStart, FWidth, rStart);
    r.Merge;

    with FFooter do
    begin
      SetBorder(r);
      r.Interior.Color      := ColorToRGB(Color);
      r.HorizontalAlignment := _EXCEL_HALIGN[HAlign];
      r.VerticalAlignment   := _EXCEL_VALIGN[VAlign];
      _Convert(Font, r.Font);
      r.Value               := _Convert(Lines);
      r.Rows[1].RowHeight   := r.Rows[1].RowHeight * IMax(1, Lines.Count);
    end;

    Result := 1;
  end;
end;

function TwCustomExcel.ConvertColumnTitles(rStart: Integer): Integer;

  function DrawColumns: Integer;
  var
    bNum: Integer;
    i   : Integer;
    r   : OleVariant;
  begin
    bNum := Ord(RowNumber);

    with FGrid do
    begin
      if bNum > 0 then
      begin
        r := FSheet.Cells[rStart, 1];

        if not FTitle.Visible and not FHeader.Visible then
          try
            r.Select;
          except
          end;

        with _GetIndicators(FGrid) do
        begin
          SetBorder(r);
          r.Interior.Color      := ColorToRGB(Color);
        end;
      end;

      for i := 0 to VColCount - 1 do
      begin
        r := FSheet.Cells[rStart, i + bNum + 1];

        with VColumns[i].Title do
        begin
          if not FAutoFit then
            r.ColumnWidth := (VColumns[i].Width + 7) div 8;

          SetBorder(r);
          r.HorizontalAlignment := _EXCEL_HALIGN[Alignment];
          r.VerticalAlignment   := _EXCEL_VALIGN[Layout];
          _Convert(Font, r.Font);
          r.Interior.Color      := ColorToRGB(Color);
          r.Value               := Caption;
        end;
      end;
    end;

    Result := 1;
  end;

  function DrawGroups: Integer;
  var
    g      : TwExcelGroups;
    x      : Integer;
    i, j, k: Integer;
    r, c   : OleVariant;
  begin
    g    := FGroups;
    x    := 1;

    with FGrid do
    begin
      if RowNumber then
      begin
        r := GetRange(x, rStart, x, rStart + g.RowHeight - 1);
        r.Merge;
        if not FTitle.Visible and not FHeader.Visible then
          r.Select;

        with _GetHeaders(FGrid) do
        begin
          SetBorder(r);
          r.Interior.Color := ColorToRGB(Title.Color);
        end;

        Inc(x);
      end;

      for i := 0 to VGroupCount - 1 do
      begin
        r := GetRange(x, rStart, x + g[i].Width - 1, rStart + g.RowHeight - 1);

        with VGroups[i] do
        begin
          if Title.Visible then
            with Title do
            begin
              with g[i][0, 0] do
//                c := GetRange(r, X1, Y1, X2, Y2);
                c := GetRange(x+X1 -1, rStart+Y1 -1,x + X2 -1, rStart + Y2 -1);

              c.Merge;

              SetBorder(c);
              c.HorizontalAlignment := _EXCEL_HALIGN[Alignment];
              c.VerticalAlignment   := _EXCEL_VALIGN[Layout];
              _Convert(Font, r.Font);
              c.Interior.Color      := ColorToRGB(Color);
              c.Value := Caption;
            end;

          for j := 0 to Levels - 1 do
            for k := 0 to ColCount[j] - 1 do
            begin
                with g[i][j + Ord(Title.Visible), k] do
//                  c := GetRange(r, X1, Y1, X2, Y2);
                c := GetRange(x+X1 -1, rStart+Y1 -1,x + X2 -1, rStart + Y2 -1);

                c.Merge;

                with Columns[j, k].Title do
                begin
                  SetBorder(c);
                  c.HorizontalAlignment := _EXCEL_HALIGN[Alignment];
                  c.VerticalAlignment   := _EXCEL_VALIGN[Layout];
                  _Convert(Font, r.Font);
                  c.Interior.Color      := ColorToRGB(Color);
                  c.Value               := Caption;
                end;
            end;
        end;

        Inc(x, g[i].Width);
      end;
    end;

    Result := g.RowHeight;
  end;

begin
  Result := 0;

  if _HeadersVisible(FGrid) then
    if FGrid.ColumnMode then
      Result := DrawColumns
    else
      Result := DrawGroups;
end;

function TwCustomExcel.ConvertColumnFooter(rStart: Integer; AFooter: TwGridFooter): Integer;

  function DrawColumns: Integer;
  var
    bNum: Integer;
    i   : Integer;
    r   : OleVariant;
  begin
    bNum := Ord(RowNumber);

    with FGrid do
    begin
      if bNum > 0 then
      begin
        r := FSheet.Cells[rStart, 1];

        with AFooter.Title do
        begin
          SetBorder(r);
          r.HorizontalAlignment := _EXCEL_HALIGN[Alignment];
          r.VerticalAlignment   := _EXCEL_VALIGN[Layout];
          _Convert(Font, r.Font);
          r.Interior.Color      := ColorToRGB(Color);
          r.Value               := Caption;
        end;
      end;

      for i := 0 to FGrid.VColCount - 1 do
      begin
        r := FSheet.Cells[rStart, i + bNum + 1];

        with VColumns[i].Footer do
        begin
          SetBorder(r);
          r.HorizontalAlignment := _EXCEL_HALIGN[Alignment];
          r.VerticalAlignment   := _EXCEL_VALIGN[Layout];
          _Convert(Font, r.Font);
          r.Interior.Color      := ColorToRGB(Color);
          r.Value               := Text[AFooter.Index];
        end;
      end;
    end;

    Result := 1;
  end;

  function DrawGroups: Integer;
  var
    g      : TwExcelGroups;
    x      : Integer;
    i, j, k: Integer;
    r, c   : OleVariant;
  begin
    g    := FGroups;

    x    := 1;

    with FGrid do
    begin
      if RowNumber then
      begin
        r := GetRange(x, rStart, x, rStart + g.RowHeight - 1);
        r.Merge;

        with AFooter.Title do
        begin
          SetBorder(r);
          r.HorizontalAlignment := _EXCEL_HALIGN[Alignment];
          r.VerticalAlignment   := _EXCEL_VALIGN[Layout];
          _Convert(Font, r.Font);
          r.Interior.Color      := ColorToRGB(Color);
          r.Value               := Caption;
        end;

        Inc(x);
      end;

      for i := 0 to VGroupCount - 1 do
      begin
        r := GetRange(x, rStart, x + g[i].Width - 1, rStart + g.RowHeight - 1);

        with VGroups[i] do
        begin
          for j := 0 to Levels - 1 do
            for k := 0 to ColCount[j] - 1 do
            begin
                with g[i][j, k] do
//                  c := GetRange(r, X1, Y1, X2, Y2);
                  c := GetRange( X+X1-1, rStart+Y1-1, x+X2-1, rStart + Y2-1);

                c.Merge;

                with Columns[j, k].Footer do
                begin
                  SetBorder(c);
                  c.HorizontalAlignment := _EXCEL_HALIGN[Alignment];
                  c.VerticalAlignment   := _EXCEL_VALIGN[Layout];
                  _Convert(Font, c.Font);
                  c.Interior.Color      := ColorToRGB(Color);
                  c.Value               := Text[AFooter.Index];
                end;
            end;
        end;

        Inc(x, g[i].Width);
      end;
    end;

    Result := g.RowHeight;
  end;

begin
  if FGrid.ColumnMode then
    Result := DrawColumns
  else
  begin
    FGroups.Load(Self);
    Result := DrawGroups;
  End;
end;

function TwCustomExcel.ConvertColumnFooters(rStart: Integer): Integer;
var
  i: Integer;
begin
  Result := 0;

  for i := 0 to FGrid.Footers.VCount - 1 do
    Inc(Result, ConvertColumnFooter(rStart + Result, FGrid.Footers.VItems[i]));
end;

//== override methods ================================================================//
procedure TwCustomExcel.OpenBook(bShow: Boolean);
begin
//  if VarIsEmpty(FExcel) then
  begin
    FExcel := CreateOleObject('Excel.Application');

//    FExcel.Visible := bShow;
    FBook := FExcel.WorkBooks.Add;
  end;
end;

procedure TwCustomExcel.ShowBook;
begin
  if CheckBook then
    FExcel.Visible := True;
end;

procedure TwCustomExcel.SaveBook;
begin
  if CheckBook then
    if FileName <> '' then
      FBook.SaveAs(FFileName)
    else
      raise Exception.Create('颇老疙捞 瘤沥登瘤 臼疽嚼聪促.');
end;

procedure TwCustomExcel.CloseBook;
begin
  if CheckBook then
    FBook.Close;
end;

procedure TwCustomExcel.Convert;
var
  r: Integer;
begin
  if Grid = nil then
    raise Exception.Create('弊府靛啊 汲沥登瘤 臼疽嚼聪促.');

//  OpenBook(FShowExcel);
  Excel_process_Create;
  try
    FExcel := CreateOleObject('Excel.Application');
    FBook := FExcel.WorkBooks.Add;

  //  XL.workbooks.add;
  //  XL.Workbooks[1].WorkSheets[1].Name := 'Delphi Data';
    FSheet := FExcel.Workbooks[1].WorkSheets[1];
    FSheet.Name := FSheetName;

  {
    try
      FSheet := FBook.Sheets[FSheetName];

    except

      FSheet := FBook.Sheets.Add;
      FSheet.Name := FSheetName;
    end;
  }

    try
      FSheet.Activate;
    except
    end;

    CalcExtents;

    if CheckBook and FUpdateLock then
      FExcel.ScreenUpdating := False;

    r := 1;
    Inc(r, ConvertTitle(r));
    Inc(r, ConvertHeader(r));

    if (FGrid.ColumnMode and (FGrid.VColCount > 0)) or
       (FGrid.GroupMode and (FGrid.VGroupCount > 0)) then
    begin
      Inc(r, ConvertColumnTitles(r));
      Inc(r, ConvertBody(r));
      Inc(r, ConvertColumnFooters(r));

      if FAutoFit then
        FSheet.Columns.AutoFit;
    end;

    ConvertFooter(r);

  finally
    FExcel.Visible := FShowExcel;
    FExcel.ScreenUpdating := True;
    Excel_process_Free;
  end;
end;

end.