home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Calmira / Src / VCL / SCRTREE.PAS < prev    next >
Pascal/Delphi Source File  |  1997-02-15  |  4KB  |  133 lines
  1. {*********************************************************}
  2. {                                                         }
  3. {    Calmira Visual Component Library 1.0                 }
  4. {    by Li-Hsin Huang,                                    }
  5. {    released into the public domain January 1997         }
  6. {                                                         }
  7. {*********************************************************}
  8.  
  9. unit Scrtree;
  10.  
  11. { TScrollTree }
  12.  
  13. { This is an enhanced TOutline control.
  14.  
  15.   Properties
  16.  
  17.   ThumbTracking - when True, causes the outline to scroll while the
  18.     user is dragging the vertical scrollbar.  The TOutline object sets
  19.     its inherited Options to [], leaving out TCustomGrid's goThumbTracking.
  20.     And since it also redefines the Options property, the inherited Options
  21.     cannot be accessed (well, I can't think of a way!)  For fast owner-draw
  22.     outlines, thumb tracking is useful, so a simple scroll message override
  23.     does the trick.
  24.  
  25.   DropFocus - used to display a focusrect during drag and drop.  Set to
  26.     -1 to erase the rectangle.
  27.  
  28.   Methods
  29.  
  30.   GetItemAt - same as GetItem except that it returns 0 if the specified
  31.     point doesn't actually contain a graphic of an outline item.
  32.     TOutline's GetItem simply returns the nearest node, which is not
  33.     always what you want!
  34.  
  35.   GetCellAt - returns the index of the cell at the given point, regardless
  36.     of whether there is an outline node present.  This is the "row"
  37.     of TCustomGrid and has nothing really to do with TOutline.
  38. }
  39.  
  40. interface
  41.  
  42. uses
  43.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  44.   Forms, Dialogs, Grids, Outline;
  45.  
  46. type
  47.   TScrollTree = class(TOutline)
  48.   private
  49.     { Private declarations }
  50.     FThumbTracking : Boolean;
  51.     FDropFocus : Integer;
  52.     procedure WMVScroll(var Msg : TWMVScroll); message WM_VSCROLL;
  53.     procedure SetDropFocus(value: Integer);
  54.   protected
  55.     { Protected declarations }
  56.   public
  57.     { Public declarations }
  58.     constructor Create(AOwner : TComponent); override;
  59.     function GetItemAt(X, Y: Integer): Longint;
  60.     function GetCellAt(X, Y: Integer): Longint;
  61.     property DropFocus: Integer read FDropFocus write SetDropFocus;
  62.   published
  63.     { Published declarations }
  64.     property ThumbTracking : Boolean
  65.       read FThumbTRacking write FThumbTracking default False;
  66.   end;
  67.  
  68. procedure Register;
  69.  
  70. implementation
  71.  
  72. constructor TScrollTree.Create(AOwner : TComponent);
  73. begin
  74.   inherited Create(AOwner);
  75.   FDropFocus := -1;
  76. end;
  77.  
  78. procedure TScrollTree.WMVScroll(var Msg : TWMVScroll);
  79. var
  80.   NewTopRow : Longint;
  81. begin
  82.   { This calculation uses 16-bit maths.  Switch to 32-bit LongMulDiv()
  83.     from the VCL if there are problems }
  84.  
  85.   if ThumbTracking and (Msg.ScrollCode = SB_THUMBTRACK) then begin
  86.     NewTopRow := MulDiv( Integer(RowCount - VisibleRowCount), Msg.Pos, MaxInt);
  87.     if NewTopRow >= 0 then TopRow := NewTopRow;
  88.   end
  89.   else
  90.     inherited;
  91. end;
  92.  
  93.  
  94. function TScrollTree.GetItemAt(X, Y: Integer): Longint;
  95. begin
  96.   Result := 0;
  97.   if PtInRect(CellRect(0, MouseCoord(X, Y).Y), Point(X, Y)) then
  98.     Result := GetItem(X, Y);
  99. end;
  100.  
  101.  
  102. function TScrollTree.GetCellAt(X, Y: Integer): Longint;
  103. var
  104.   Coords : TGridCoord;
  105. begin
  106.   Coords := MouseCoord(X, Y);
  107.   if PtInRect(CellRect(0, Coords.Y), Point(X, Y)) then
  108.     Result := Coords.Y
  109.   else
  110.     Result := 0;
  111. end;
  112.  
  113.  
  114. procedure TScrollTree.SetDropFocus(value: Integer);
  115. begin
  116.   if FDropFocus <> Value then begin
  117.     if FDropFocus <> -1 then
  118.       Canvas.DrawFocusRect(CellRect(0, FDropFocus));
  119.     if value <> -1 then
  120.       Canvas.DrawFocusRect(CellRect(0, value));
  121.  
  122.     FDropFocus := value;
  123.   end;
  124. end;
  125.  
  126.  
  127. procedure Register;
  128. begin
  129.   RegisterComponents('Samples', [TScrollTree]);
  130. end;
  131.  
  132. end.
  133.