ucustomexcel.pas

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

unit UCustomExcel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, URGrids, UExcelUtils;

type
  TwCustomExcel = class;

  { TwExcelObject }
  TwExcelObject = class(TPersistent)
  private
    (* property objects *)
    FFont: TFont;

    (* property fields *)
    FBorderColor : TColor;
    FBorderStyle : TPenStyle;
    FBorderWeight: TXlBorderWeight;
    FColor       : TColor;
    FHAlign      : TAlignment;
    FVAlign      : TTextLayout;
    FVisible     : Boolean;

    (* property methods *)
    procedure SetFont(V: TFont);

  protected
    procedure SetBorder(V: OleVariant);

  public
    constructor Create;
    destructor  Destroy; override;

  published
    (* properties *)
    property BorderColor : TColor          read FBorderColor  write FBorderColor  default clGray;
    property BorderStyle : TPenStyle       read FBorderStyle  write FBorderStyle  default psSolid;
    property BorderWeight: TXlBorderWeight read FBorderWeight write FBorderWeight default xlThin;
    property Color       : TColor          read FColor        write FColor        default clWhite;
    property Font        : TFont           read FFont         write SetFont;
    property HAlign      : TAlignment      read FHAlign       write FHAlign       default taCenter;
    property VAlign      : TTextLayout     read FVAlign       write FVAlign       default tlCenter;
    property Visible     : Boolean         read FVisible      write FVisible      default True;
  end;

  { TwExcelTitle }
  TwExcelTitle = class(TwExcelObject)
  private
    (* property fields *)
    FText     : string;

  protected
  public
    constructor Create;
    destructor  Destroy; override;

  published
    (* properties *)
    property Text: string read FText write FText;
  end;

  { TwExcelHeader }
  TwExcelHeader = class(TwExcelObject)
  private
    (* property objects *)
    FLines: TStrings;

    (* property methods *)
    procedure SetLines(V: TStrings);

  protected
  public
    constructor Create;
    destructor  Destroy; override;

  published
    (* properties *)
    property HAlign default taLeftJustify;
    property VAlign default tlTop;

    property Lines: TStrings read FLines write SetLines;
  end;

  { TwExcelFooter }
  TwExcelFooter = class(TwExcelHeader)
  private
  protected
  public
    constructor Create;
    destructor  Destroy; override;

  published
  end;

  { TwColRanges }
  PwColRange = ^TwColRange;
  TwColRange = record
    X1, Y1, X2, Y2: Word;
  end;

  PwColRangeArray = ^TwColRangeArray;
  TwColRangeArray = array[0..MaxInt div SizeOf(TwColRange) - 1] of TwColRange;

  TwRangeData = class
  private
    FRanges: PwColRangeArray;
    FCount : Word;
  end;

  { TwExcelGroup }
  TwExcelGroup = class
  private
    (* internal objects *)
    FLines: TList;

    (* internal fields *)
    FWidth: Integer;

    (* property methods *)
    function GetCount: Integer;
    function GetColCount(L: Integer): Integer;
    function GetRanges(L, I: Integer): TwColRange;

    (* internal methods *)
    procedure Clear;

  public
    constructor Create;
    destructor  Destroy; override;

    procedure Load(AGroup: TwGroup; AHeight: Integer);
    procedure LoadTitle(AGroup: TwGroup; AHeight: Integer);

    (* properties *)
    property Count                : Integer    read GetCount;
    property ColCount[L: Integer] : Integer    read GetColCount;
    property Ranges[L, I: Integer]: TwColRange read GetRanges; default;
    property Width                : Integer    read FWidth;
  end;

  { TwExcelGroups }
  TwExcelGroups = class
  private
    (* internal objects *)
    FGroups: TList;

    (* internal fields *)
    FColWidth : Integer;
    FRowHeight: Integer;

    (* property methods *)
    function GetCount: Integer;
    function GetGroups(I: Integer): TwExcelGroup;

    (* internal methods *)
    procedure Clear;

  public
    constructor Create;
    destructor  Destroy; override;

    procedure Load(AExcel: TwCustomExcel);
    procedure LoadTitle(AExcel: TwCustomExcel);

    (* properties *)
    property Count    : Integer read GetCount;
    property Groups[I: Integer]: TwExcelGroup read GetGroups; default;

    property ColWidth : Integer read FColWidth;
    property RowHeight: Integer read FRowHeight;
  end;

  { TwCustomExcel }
  TwCustomExcel = class(TComponent)
  private
    (* property objects *)
    FTitle : TwExcelTitle;
    FHeader: TwExcelHeader;
    FFooter: TwExcelFooter;

    (* property fields *)
    FAutoFit     : Boolean;
    FBorderColor : TColor;
    FBorderStyle : TPenStyle;
    FBorderWeight: TXlBorderWeight;
    FGrid        : TwCustomGrid;
    FFileName    : string;
    FRowNumber   : Boolean;
    FUpdateLock  : Boolean;
    FSheetName   : string;
    FShowExcel   : Boolean;

  protected
    (* internal objects *)
    FGroups: TwExcelGroups;

    (* internal fields *)
    FExcel : OleVariant;
    FBook  : OleVariant;
    FSheet : OleVariant;
    FWidth : Integer; // 钎矫瞪 拿烦狼 荐
    FHeight: Integer; // 弊缝葛靛俊辑 阿 Row啊 爱绰 弥措 饭骇荐

    (* internal methods *)
    function  CheckBook: Boolean;
    procedure CalcExtents;
    function  GetRange(x1, y1, x2, y2: Integer): OleVariant; overload;
//    function  GetRange(range: OleVariant; x1, y1, x2, y2: Integer): OleVariant; overload;
    procedure SetBorder(V: OleVariant);

    (* override methods *)
    procedure Notification(AComponent: TComponent; Op: TOperation); override;

    (* virtual methods *)
    // rStart row俊辑 何磐 矫累窍绊, 函券茄 row 肮荐甫 馆券茄促.
    function ConvertTitle(rStart: Integer): Integer; dynamic;
    function ConvertHeader(rStart: Integer): Integer; dynamic;
    function ConvertFooter(rStart: Integer): Integer; dynamic;
    function ConvertColumnTitles(rStart: Integer): Integer; dynamic;
    function ConvertColumnFooter(rStart: Integer; AFooter: TwGridFooter): Integer; dynamic;
    function ConvertColumnFooters(rStart: Integer): Integer; dynamic;

    (* abastract methods *)
    function ConvertBody(rStart: Integer): Integer; virtual; abstract;

    (* properties *)
    property Title : TwExcelTitle  read FTitle  write FTitle ;
    property Header: TwExcelHeader read FHeader write FHeader;
    property Footer: TwExcelFooter read FFooter write FFooter;

    property AutoFit     : Boolean         read FAutoFit      write FAutoFit      default False;
    property BorderColor : TColor          read FBorderColor  write FBorderColor  default clGray;
    property BorderStyle : TPenStyle       read FBorderStyle  write FBorderStyle  default psSolid;
    property BorderWeight: TXlBorderWeight read FBorderWeight write FBorderWeight default xlThin;
    property Grid        : TwCustomGrid    read FGrid         write FGrid;
    property FileName    : string          read FFileName     write FFileName;
    property RowNumber   : Boolean         read FRowNumber    write FRowNumber    default True;
    property SheetName   : string          read FSheetName    write FSheetName;
    property ShowExcel   : Boolean         read FShowExcel    write FShowExcel    default True;
    property UpdateLock  : Boolean         read FUpdateLock   write FUpdateLock   default False;

  public
    constructor Create(AComponent: TComponent); override;
    destructor  Destroy; override;

    procedure OpenBook(bShow: Boolean);
    procedure ShowBook;
    procedure SaveBook;
    procedure CloseBook;
    procedure Convert;

  published
  end;

function XLChar(iColIdx : integer):string;

implementation

uses ComObj, UExcelPrograss;

function XLChar(iColIdx : integer):string;
var
  iMok, iRem : Integer;
  sRtn : string;
begin
  iRem := iColIdx Mod 26;

  if iRem = 0 then
  begin
    iMok := iColIdx div 26 - 1;
    iRem :=26;
  end
  else
    iMok :=iColIdx div 26;

  if iMok = 0 then
    sRtn := CHR(64 + iColIdx)
  else
    sRtn := CHR(64 + iMok) + CHR(64 + iRem);

  Result :=sRtn;
end;

{ TwExcelObject }
//== init & final ====================================================================//
constructor TwExcelObject.Create;
begin
  FFont := TFont.Create;

  FBorderColor  := clGray;
  FBorderStyle  := psSolid;
  FBorderWeight := xlThin;
  FColor        := clWhite;
  FHAlign       := taCenter;
  FVAlign       := tlCenter;
  FVisible      := True;
end;

destructor TwExcelObject.Destroy;
begin
  FreeAndNil(FFont);

  inherited;
end;

//== property methods ================================================================//
procedure TwExcelObject.SetFont(V: TFont);
begin
  FFont.Assign(V);
end;

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

{ TwExcelTitle }
//== init & final ====================================================================//
constructor TwExcelTitle.Create;
begin
  inherited;
end;

destructor TwExcelTitle.Destroy;
begin
  inherited;
end;

{ TwExcelHeader }
//== init & final ====================================================================//
constructor TwExcelHeader.Create;
begin
  inherited;

  FLines := TStringList.Create;

  HAlign := taLeftJustify;
  VAlign := tlTop;
end;

destructor TwExcelHeader.Destroy;
begin
  FreeAndNil(FLines);

  inherited;
end;

//== property methods ================================================================//
procedure TwExcelHeader.SetLines(V: TStrings);
begin
  FLines.Assign(V);
end;

{ TwExcelFooter }
//== init & final ====================================================================//
constructor TwExcelFooter.Create;
begin
  inherited;
end;

destructor TwExcelFooter.Destroy;
begin
  inherited;
end;

{ TwExcelGroup }
//== init & final ====================================================================//
constructor TwExcelGroup.Create;
begin
  FLines := TList.Create;
end;

destructor TwExcelGroup.Destroy;
begin
  Clear;
  FreeAndNil(FLines);

  inherited;
end;

//== property methods ================================================================//
function TwExcelGroup.GetCount: Integer;
begin
  Result := FLines.Count;
end;

function TwExcelGroup.GetColCount(L: Integer): Integer;
begin
  Result := TwRangeData(FLines[L]).FCount;
end;

function TwExcelGroup.GetRanges(L, I: Integer): TwColRange;
begin
  Result := TwRangeData(FLines[L]).FRanges[I];
end;

//== private methods =================================================================//
procedure TwExcelGroup.Clear;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    with TwRangeData(FLines[i]) do
    begin
      ReallocMem(FRanges, 0);
      Free;
    end;

  FLines.Clear;
end;

//== public methods ==================================================================//
procedure TwExcelGroup.Load(AGroup: TwGroup; AHeight: Integer);
var
  i, j: Integer;
  h, w: Integer;
  d   : TwRangeData;
begin
  Assert(AGroup <> nil);

  Clear;

  with AGroup do
  begin
    FWidth := 1;

    for i := 0 to Levels - 1 do
    begin
      d := TwRangeData.Create;

      ReallocMem(d.FRanges, SizeOf(TwColRange) * ColCount[i]);
      d.FCount := ColCount[i];

      FLines.Add(d);
      FWidth := IMax(FWidth, ColCount[i]);
    end;

    for i := 0 to Levels - 1 do
    begin
      d := TwRangeData(FLines[i]);

      if i < Levels - 1 then
        h := 1
      else
        h := AHeight - Levels + 1;

      for j := 0 to ColCount[i] - 1 do
      begin
        if j < d.FCount - 1 then
          w := 1
        else
          w := FWidth - d.FCount + 1;

        with d.FRanges[j] do
        begin
          X1 := j + 1;
          X2 := X1 + w - 1;
          Y1 := i + 1;
          Y2 := Y1 + h - 1;
        end;
      end;
    end;
  end;
end;

procedure TwExcelGroup.LoadTitle(AGroup: TwGroup; AHeight: Integer);
var
  i, j: Integer;
  h, w: Integer;
  d   : TwRangeData;
begin
  Assert(AGroup <> nil);

  if not AGroup.Title.Visible then
  begin
    Load(AGroup, AHeight);
    Exit;
  end;

  Clear;

  with AGroup do
  begin
    FWidth := 1;

    if Title.Visible then
    begin
      d := TwRangeData.Create;

      ReallocMem(d.FRanges, SizeOf(TwColRange));
      d.FCount := 1;

      FLines.Add(d);
    end;

    for i := 0 to Levels - 1 do
    begin
      d := TwRangeData.Create;

      ReallocMem(d.FRanges, SizeOf(TwColRange) * ColCount[i]);
      d.FCount := ColCount[i];

      FLines.Add(d);
      FWidth := IMax(FWidth, ColCount[i]);
    end;

    if Title.Visible then
    begin
      d := TwRangeData(FLines[0]);

      with d.FRanges[0] do
      begin
        X1 := 1;
        X2 := FWidth;
        Y1 := 1;
        Y2 := 1;
      end;
    end;

    for i := 0 to Levels - 1 do
    begin
      d := TwRangeData(FLines[i + 1]);

      if i < Levels - 1 then
        h := 1
      else
        h := AHeight - (Levels + Ord(Title.Visible)) + 1;

      for j := 0 to ColCount[i] - 1 do
      begin
        if j < d.FCount - 1 then
          w := 1
        else
          w := FWidth - d.FCount + 1;

        with d.FRanges[j] do
        begin
          X1 := j + 1;
          X2 := X1 + w - 1;
          Y1 := i + 1 + Ord(Title.Visible);
          Y2 := Y1 + h - 1;
        end;
      end;
    end;
  end;
end;

{ TwExcelGroups }
//== init & final ====================================================================//
constructor TwExcelGroups.Create;
begin
  FGroups := TList.Create;
end;

destructor TwExcelGroups.Destroy;
begin
  Clear;
  FreeAndNil(FGroups);

  inherited;
end;

//== property methods ================================================================//
function TwExcelGroups.GetCount: Integer;
begin
  Result := FGroups.Count;
end;

function TwExcelGroups.GetGroups(I: Integer): TwExcelGroup;
begin
  Result := TwExcelGroup(FGroups[I]);
end;

//== private methods =================================================================//
procedure TwExcelGroups.Clear;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    Groups[i].Free;

  FGroups.Clear;
end;

//== public methods ==================================================================//
procedure TwExcelGroups.Load(AExcel: TwCustomExcel);