home *** CD-ROM | disk | FTP | other *** search
/ PC Open 19 / pcopen19.iso / Zipped / CALMIR21.ZIP / SOURCE.ZIP / VCL / SCRTREE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-02-20  |  4.4 KB  |  160 lines
  1. {*********************************************************}
  2. {                                                         }
  3. {    Calmira Visual Component Library 2.1                 }
  4. {    by Li-Hsin Huang,                                    }
  5. {    released into the public domain January 1998         }
  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.     function ChildNodeSelected : Boolean;
  62.     procedure DeleteSelectedNode;
  63.     property DropFocus: Integer read FDropFocus write SetDropFocus;
  64.   published
  65.     { Published declarations }
  66.     property ThumbTracking : Boolean
  67.       read FThumbTRacking write FThumbTracking default False;
  68.   end;
  69.  
  70. procedure Register;
  71.  
  72. implementation
  73.  
  74. constructor TScrollTree.Create(AOwner : TComponent);
  75. begin
  76.   inherited Create(AOwner);
  77.   FDropFocus := -1;
  78. end;
  79.  
  80. procedure TScrollTree.WMVScroll(var Msg : TWMVScroll);
  81. var
  82.   NewTopRow : Longint;
  83. begin
  84.   { This calculation uses 16-bit maths.  Switch to 32-bit LongMulDiv()
  85.     from the VCL if there are problems }
  86.  
  87.   if ThumbTracking and (Msg.ScrollCode = SB_THUMBTRACK) then begin
  88.     NewTopRow := MulDiv( Integer(RowCount - VisibleRowCount), Msg.Pos, MaxInt);
  89.     if NewTopRow >= 0 then TopRow := NewTopRow;
  90.   end
  91.   else
  92.     inherited;
  93. end;
  94.  
  95.  
  96. function TScrollTree.GetItemAt(X, Y: Integer): Longint;
  97. begin
  98.   Result := 0;
  99.   if PtInRect(CellRect(0, MouseCoord(X, Y).Y), Point(X, Y)) then
  100.     Result := GetItem(X, Y);
  101. end;
  102.  
  103.  
  104. function TScrollTree.GetCellAt(X, Y: Integer): Longint;
  105. var
  106.   Coords : TGridCoord;
  107. begin
  108.   Coords := MouseCoord(X, Y);
  109.   if PtInRect(CellRect(0, Coords.Y), Point(X, Y)) then
  110.     Result := Coords.Y
  111.   else
  112.     Result := 0;
  113. end;
  114.  
  115.  
  116. procedure TScrollTree.SetDropFocus(value: Integer);
  117. begin
  118.   if FDropFocus <> Value then begin
  119.     if FDropFocus <> -1 then
  120.       Canvas.DrawFocusRect(CellRect(0, FDropFocus));
  121.     if value <> -1 then
  122.       Canvas.DrawFocusRect(CellRect(0, value));
  123.  
  124.     FDropFocus := value;
  125.   end;
  126. end;
  127.  
  128.  
  129. function TScrollTree.ChildNodeSelected : Boolean;
  130. begin
  131.   Result := (SelectedItem > 0) and (Items[SelectedItem].Level > 1);
  132. end;
  133.  
  134. procedure TScrollTree.DeleteSelectedNode;
  135. var
  136.   node : TOutlineNode;
  137.   i, sel : Longint;
  138. begin
  139.  { If a node is deleted when its previous sibling is expanded,
  140.    the TOutline code often crashes }
  141.  
  142.   sel := SelectedItem;
  143.  
  144.   if sel > 0 then begin
  145.     node := Items[sel];
  146.     node.Collapse;
  147.     i := node.Parent.GetPrevChild(sel);
  148.     if i > 0 then Items[i].Collapse;
  149.     Delete(sel);
  150.   end;
  151. end;
  152.  
  153.  
  154. procedure Register;
  155. begin
  156.   RegisterComponents('Samples', [TScrollTree]);
  157. end;
  158.  
  159. end.
  160.