easygrid.pas

delphi制作表格的控件

    property Aligns;
    property ForeTexts;
    property BackTexts;
    property Colors;
    property Merges;
    property Cells;
    property EditorMode;
    property GridHeight;
    property GridWidth;
    property LeftCol;
    property Selection;
    property Row;
    property RowHeights;
    property ColCanSizes;
    property RowCanSizes;
    property TabStops;
    property TopRow;
////////////////////////////////////////////
    property RunMode; // add by liuzhigang in 2004.07.29
    { Public declarations }
  published
    property Align;
    property AlwaysDrawFocus;
    property Anchors;
    property AutoUpdate;
    property BiDiMode;
    property BorderStyle;
    property ClientSizeable;
    property CellDataStyle;
    property CellAlignMode;
    property CellShowForeText;
    property CellReadOnly;
    property CellAutoWordBreak;
    property CellLineWidth;
    property CellPenStyle;
    property CellAllowNegative;
    property CellTrailingZero;
    property CellZeroNull;
    property CellThousandSep;
    property CellMaxLength;
    property CellIntLength;
    property CellDecLength;
    property CellColor;
    property CellFontSize;
    property CellFontColor;
    property CellFontStyle;
    property Color;
    property ColCount;
    property Constraints;
    property Ctl3D;
    property DefaultColWidth;
    property DefaultRowHeight;
    property DefaultDrawing;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FixedLineColor;
    property ClientLineColor;
    property FixedCols;
    property RowCount;
    property FixedRows;
    property Font;
    property GridLineWidth;
    property Options;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property GridCanCopyMove;
    property GridCanFill;
    property ScrollBars;
    property ShowHint;
    property ShowPopup;
    property TabOrder;
    property TabStop;
    property Visible;
    property VisibleColCount;
    property VisibleRowCount;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawCell: TDrawCellEvent read FOnDrawCell write FOnDrawCell;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetEditMask: TGetEditEvent read FOnGetEditMask write FOnGetEditMask;
    property OnGetEditText: TGetEditEvent read FOnGetEditText write FOnGetEditText;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnSelectCell: TSelectCellEvent read FOnSelectCell write FOnSelectCell;
    property OnSetEditText: TSetEditEvent read FOnSetEditText write FOnSetEditText;
    property OnHideEdit: TSetEditEvent read FOnHideEdit write FOnHideEdit;
    property OnSetForeText: TSetCellTextEvent read FOnSetForeText write FOnSetForeText;
    property OnSetBackText: TSetCellTextEvent read FOnSetBackText write FOnSetBackText;
    property BeforeSetCellProp: TBeforeSetCellPropEvent read FBeforeSetCellProp write FBeforeSetCellProp;
    property AfterSetCellProp: TAfterSetCellPropEvent read FAfterSetCellProp write FAfterSetCellProp;
    property OnStartDock;
    property OnStartDrag;
    property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged;
    property OnInsertCol: TInsertColEvent read FOnInsertCol write FOnInsertCol;
    property OnInsertRow: TInsertRowEvent read FOnInsertRow write FOnInsertRow;
    property OnDeleteCol: TDeleteColEvent read FOnDeleteCol write FOnDeleteCol;
    property OnDeleteRow: TDeleteRowEvent read FOnDeleteRow write FOnDeleteRow;
    property OnInsertCellRight: TInsertCellRightEvent read FOnInsertCellRight write FOnInsertCellRight;
    property OnInsertCellDown: TInsertCellDownEvent read FOnInsertCellDown write FOnInsertCellDown;
    property OnDeleteCellRight: TDeleteCellRightEvent read FOnDeleteCellRight write FOnDeleteCellRight;
    property OnDeleteCellDown: TDeleteCellDownEvent read FOnDeleteCellDown write FOnDeleteCellDown;
    property OnPasteCells: TPasteCellsEvent read FOnPasteCells write FOnPasteCells;
    property OnCutCells: TCutCellsEvent read FOnCutCells write FOnCutCells;
    property OnCopyMoveCells: TCopyMoveCellsEvent read FOnCopyMoveCells write FOnCopyMoveCells;
    property OnFillCells: TFillCellsEvent read FOnFillCells write FOnFillCells;
//---------Add By Liuzhigang In 2004.07.30--------------------
    property DataSource;
    property ControlCollection;
    //User Define
    property HighLightColor;
    property TitleColor;
    property ShowColTitle;
    property ShowRowTitle;
    property FocusedTitleColor;
    property HighLightTextColor;
  end;


implementation
uses Math, Consts;


procedure KillMessage(Wnd: HWnd; Msg: Integer);
// Delete the requested message from the queue, but throw back
// any WM_QUIT msgs that PeekMessage may also return
var
  M: TMsg;
begin
  M.Message := 0;
  if PeekMessage(M, Wnd, Msg, Msg, pm_Remove) and (M.Message = WM_QUIT) then
    PostQuitMessage(M.wparam);
end;

function ColTitle(Index: Integer) : string;
var
  Hi,Lo : Integer;
begin
  Result := '';
  if (Index < 0) or (Index > 255) then Exit;
  Hi := Index div 26;
  Lo := Index mod 26;
  if Index<=25 then
     Result := Chr(Ord('A')+Lo)
  else
     Result := Chr(Ord('A')+Hi-1) + Chr(Ord('A')+Lo);
end;

procedure InvalidOp(const id: string);
begin
  raise EInvalidGridOperation.Create(id);
end;

function GridCoord(X, Y: Integer): TGridCoord;
begin
  Result.X := X;
  Result.Y := Y;
end;

function GridRect(Coord1, Coord2: TGridCoord): TGridRect;
begin
  with Result do
  begin
    Left := Coord2.X;
    if Coord1.X < Coord2.X then Left := Coord1.X;
    Right := Coord1.X;
    if Coord1.X < Coord2.X then Right := Coord2.X;
    Top := Coord2.Y;
    if Coord1.Y < Coord2.Y then Top := Coord1.Y;
    Bottom := Coord1.Y;
    if Coord1.Y < Coord2.Y then Bottom := Coord2.Y;
  end;
end;

function PointInGridRect(Col, Row: Longint; const Rect: TGridRect): Boolean;
begin
  Result := (Col >= Rect.Left) and (Col <= Rect.Right) and (Row >= Rect.Top)
    and (Row <= Rect.Bottom);
end;

function GridRectInterSects(GridRect1, GridRect2: TGridRect): Boolean;
var
  i, j: Integer;
begin
  Result := True;
  for i:=GridRect1.Left to GridRect1.Right do
    for j:=GridRect1.Top to GridRect1.Bottom do
      if PointInGridRect(i, j, GridRect2) then
         Exit;
  Result := False;
end;

type
  TXorRects = array[0..3] of TRect;

procedure XorRects(const R1, R2: TRect; var XorRects: TXorRects);
var
  Intersect, Union: TRect;

  function PtInRect(X, Y: Integer; const Rect: TRect): Boolean;
  begin
    with Rect do Result := (X >= Left) and (X <= Right) and (Y >= Top) and
      (Y <= Bottom);
  end;

  function Includes(const P1: TPoint; var P2: TPoint): Boolean;
  begin
    with P1 do
    begin
      Result := PtInRect(X, Y, R1) or PtInRect(X, Y, R2);
      if Result then P2 := P1;
    end;
  end;

  function Build(var R: TRect; const P1, P2, P3: TPoint): Boolean;
  begin
    Build := True;
    with R do
      if Includes(P1, TopLeft) then
      begin
        if not Includes(P3, BottomRight) then BottomRight := P2;
      end
      else if Includes(P2, TopLeft) then BottomRight := P3
      else Build := False;
  end;

begin
  FillChar(XorRects, SizeOf(XorRects), 0);
  if not Bool(IntersectRect(Intersect, R1, R2)) then
  begin
    { Don't intersect so its simple }
    XorRects[0] := R1;
    XorRects[1] := R2;
  end
  else
  begin
    UnionRect(Union, R1, R2);
    if Build(XorRects[0],
      Point(Union.Left, Union.Top),
      Point(Union.Left, Intersect.Top),
      Point(Union.Left, Intersect.Bottom)) then
      XorRects[0].Right := Intersect.Left;
    if Build(XorRects[1],
      Point(Intersect.Left, Union.Top),
      Point(Intersect.Right, Union.Top),
      Point(Union.Right, Union.Top)) then
      XorRects[1].Bottom := Intersect.Top;
    if Build(XorRects[2],
      Point(Union.Right, Intersect.Top),
      Point(Union.Right, Intersect.Bottom),
      Point(Union.Right, Union.Bottom)) then
      XorRects[2].Left := Intersect.Right;
    if Build(XorRects[3],
      Point(Union.Left, Union.Bottom),
      Point(Intersect.Left, Union.Bottom),
      Point(Intersect.Right, Union.Bottom)) then
      XorRects[3].Top := Intersect.Bottom;
  end;
end;

procedure ModifyExtents(var Extents: Pointer; Index, Amount: Longint;
  Default: Integer);
var
  LongSize, OldSize: LongInt;
  NewSize: Integer;
  I: Integer;
begin
  // Index 为最后一元素的序号
  // Amount 为新元素数减去旧元素数(可能小于0)
  if Amount <> 0 then
  begin
    // OldSize 设为原有元素数,即第 0 个元素
    if not Assigned(Extents) then OldSize := 0
    else OldSize := PIntArray(Extents