generatormessagesgrid.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

    property ParentShowHint;
    property PopupMenu write SetPopupMenu;
    property RowCount: Integer read FRowCount write SetRowCount default 2;
    property RowHeight: Integer read FRowHeight write SetRowHeight default 14;
    property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars
                                                                default ssBoth;

    property ImageList: TImageList read FImageList write FImageList
                                                                   default nil;
    property ImageIndexDown: Integer read FImageIndices[False]
                                     write FImageIndices[False] default 0;
    property ImageIndexUp: Integer read FImageIndices[True]
                                   write FImageIndices[True] default 1;

    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnFixedClick: TGMFixedClick read FOnFixedClick
                                         write FOnFixedClick;
    property OnFixedDblClick: TGMFixedClick read FOnFixedDblClick
                                            write FOnFixedDblClick;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnSelectField: TGMSelectFieldEvent read FOnSelectField
                                                write FOnSelectField;
    property OnStartDock;
    property OnStartDrag;
    property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged
                                            write FOnTopLeftChanged;
  end;



implementation

uses SysUtils, Math, Consts,
     General;


      //the maximum/normal scrolling range of the scroll bars
const ScrollBarMax = High(SmallInt);


    //these variables are kind of class variables;
    //they could be made object fields, but are move here to save some memory;
    //as they are all used for input purposes only, and input can only happen
    //to one component/grid at a time, this shouldn't be a problem

    //the index of the column to be resized
var ExSizingIndex: Integer;
    //original size of the column being resized
    ExSizingOrgSize: Integer;
    //offset of the mouse pointer to the sizing line
    ExSizingOfs: Integer;

    //the index of the column to be moved
    ExMoveIndex: Integer;
    //the index of the column to move the current column to, by default the
    //same index as the column itself
    ExMovePos: Integer;
    //the original index of the moved column, used to restore the columns to
    //their original order when the moving is canceled
    ExOrgMoveIndex: Integer;

    //position of a click in the fixed title row, used to distinguish between
    //the attempt to move a column and a click on the title
    ExClickDragPosition: TPoint;
    //whether the a fixed title of a column has not been simply clicked, if the
    //mouse is moved more than a few pixels while the mouse button was down, it
    //is interpreted as an attempt to move the column instead of a click on it
    ExWasDragged: Boolean;

    //the internal index of the row a quick search was started, mainly used to
    //be able to move backward, when the backspace key is pressed
    ExQuickSearchStartIndex: Integer;
    //the current text to make a quick search for
    ExQuickSearch: String;





{Checks whether the point is in the rectangle (more or less the same as
 the WinAPI function PtInRect).
~param X, Y the position to check whether it is in the rectangle
~param Rect the rectangle to check the point against
~result whether the point is within the rectangle }
function XYInGridRect(X, Y: Integer; Rect: TRect): Boolean;
begin
 Result := (X >= Rect.Left) and (Y >= Rect.Top) and
           (X <= Rect.Right) and (Y <= Rect.Bottom);
end;


     //used to calculate exclusive rectangles of two rectangles
type TRectDifferences = array[0..3] of TRect;

{Calculates the differences between two rectangles. This is used to calculate
 the regions of the grid that need to be repainted after the selection within
 it has been changed.
~param R1, R2   the rectangles whose difference should be calculated
~param XorRects out: the list of rectangles containing the differences between
                     the two rectangles, some of them may be "empty" }
procedure CalculateRectDifference(const R1, R2: TRect;
                                  var XorRects: TRectDifferences);

 {Returns whether the point is in any of the two rectangles
 ~param P the point to check whether it is in any of the two rectangles
 ~result whether the point is in any of the two rectangles }
 function PointInAnyRect(const P: TPoint): Boolean;
 begin      //check both rectangles
  Result := XYInGridRect(P.X, P.Y, R1) or XYInGridRect(P.X, P.Y, R2);
 end;

 {Builds a rectangle from the three specified points.
 ~param R       out: the rectangle to build
 ~param PStart  the primary possible starting point of the rectangle
 ~param PMiddle the secondary start and ending point of the rectangle
 ~param PEnd    the primary possible ending point of the rectangle
 ~result whether a valid rectangle could be constructed (should always be the
         case) }
 function Build(var R: TRect; const PStart, PMiddle, PEnd: TPoint): Boolean;
 begin
  Result := True;                       //assume rectangle can be build
  if PointInAnyRect(PStart) then        //primary start point is valid?
   begin
    R.TopLeft := PStart;                  //use it
    if PointInAnyRect(PEnd) then            //primary ending point is valid?
     R.BottomRight := PEnd                    //use it
    else
     R.BottomRight := PMiddle;                //use secondary ending point
   end
  else
   if PointInAnyRect(PMiddle) then        //secondary start point is valid?
    begin
     R.TopLeft := PMiddle;                  //use it
     R.BottomRight := PEnd;                 //and use the end point
    end
   else
    begin
     Result := False;                       //no valid rectangle possible
     Assert(False);                         //(should never happen)
    end;
 end;

var       Intersect   :TRect;               //intersection of both rectangles
          Union       :TRect;               //minimal rectangle containing both
begin
 if not IntersectRect(Intersect, R1, R2) then //calculate intersection
  begin
   //they don't intersect, so its simple, just return both rectangles
   XorRects[0] := R1;
   XorRects[1] := R2;
   //clear the other two rectangles, there is no other difference
   FillChar(XorRects[2], SizeOf(XorRects[2]) * 2, 0);
  end
 else
  begin
   UnionRect(Union, R1, R2);                  //calculate union of rectangles

   //build rectangle with difference of the left side and top-left-corner
   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;        //set span of the rectangle

   //build rectangle with difference of the upper side and top-right-corner
   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;        //set span of the rectangle

   //build rectangle with difference of the right side and bottom-right-corner
   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;        //set span of the rectangle

   //build rectangle with difference of the lower side and bottom-left-corner
   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;        //set span of the rectangle
  end;
end;










{ **************************************************************************
                                  TGMGrid
  ************************************************************************** }


{Creates the component.
~param AOwner the component owning this one }
constructor TGMGrid.Create(AOwner: TComponent);
            //the style of the component
const       GridStyle = [csOpaque, csClickEvents,
                         csDoubleClicks, csCaptureMouse];
var         i2            :Integer;          //counter through all columns
            i             :TGMColumnShowed;  //counter through all column types
begin
 inherited Create(AOwner);                   //create the control

 if NewStyleControls then                    //set its styles
  ControlStyle := GridStyle
 else
  ControlStyle := GridStyle + [csFramed];

 FTitleHeight := 4;                          //by default show only mini titles
 FShowTitle := stMini;

 for i2 := Low(FColumns) to High(FColumns) do //show each column type
  FColumns[i2] := TGMColumnShowed(i2);

 FDefaultColumnWidth := 35;                  //set default width of all columns
 for i := Low(TGMColumnShowed) to High(TGMColumnShowed) do
  FColWidths[i] := FDefaultColumnWidth;

 FColCount := 5;                             //show first 5 columns
 FRowCount := 1;                             //but grid is empty, no messages
 FScrollBars := ssBoth;                      //scroll in both dimensions
 FBorderStyle := bsNone;
 FRowHeight := 14;                           //the text will fit in this height
 //set default options of the grid
 FOptions := [goRowSelect, goMoveCursorOnCol, goFillFixedRow,
              goScrollBarThumb, goQuickSearch];

 FSortCount := 0;                            //by default don't sort

 ParentColor := False;
 Color := clWindow;

 //set default index to indicate descending sort order (ascending = 0)
 FImageIndices[True] := 1;

 TabStop := True;                            //can be focused

// FTopLeft.x := 0;
// FTopLeft.y := 1;

 FTopLeft.X := 0;                            //show first (non-existant) row
 FTopLeft.Y := GetFixedRows;
 FCurrent := FTopLeft;                       //and select it
 FAnchor := FCurrent;
end;





{Returns the width of the grid used by its columns.
~result the width of the client width used by the columns }
function TGMGrid.GetGridWidth: Integer;
var      DrawInfo      :TGridDrawInfo; //information about the view of the grid
begin
 CalcDrawInfo(DrawInfo);               //calculate current view
 Result := DrawInfo.Horz.GridBoundary; //return used horizontal width
end;

{Returns the height of the grid used by its rows.
~result the height of the client height used by the rows }
function TGMGrid.GetGridHeight: Integer;
var      DrawInfo      :TGridDrawInfo; //information about the view of the grid