[15] | 1 | Unit SplitBar;
|
---|
| 2 |
|
---|
| 3 | Interface
|
---|
| 4 |
|
---|
| 5 | Uses
|
---|
| 6 | Classes, Forms, ExtCtrls, Graphics;
|
---|
| 7 |
|
---|
| 8 | Type
|
---|
| 9 | TSplitChange = procedure( NewSplit: longint ) of Object;
|
---|
| 10 |
|
---|
| 11 | TSplitBar=Class(TPanel)
|
---|
| 12 | Protected
|
---|
| 13 | FOldFgMode: TPenMode;
|
---|
| 14 | FOldPanelX: longint;
|
---|
| 15 | FOffset: longint;
|
---|
| 16 | FMinimum: longint;
|
---|
| 17 | FMaximum: longint;
|
---|
| 18 |
|
---|
| 19 | FOnChange: TSplitChange;
|
---|
| 20 |
|
---|
| 21 | Function GetX( XInParent: longint ): longint;
|
---|
| 22 | Procedure DrawSplitLine( X: longint );
|
---|
| 23 | Procedure SetupComponent; Override;
|
---|
| 24 | Procedure MouseDown( Button: TMouseButton;
|
---|
| 25 | Shift: TShiftState;
|
---|
| 26 | X: LongInt; Y: LongInt ); override;
|
---|
| 27 | Procedure MouseMove( Shift: TShiftState;
|
---|
| 28 | X: LongInt; Y: LongInt); override;
|
---|
| 29 | Procedure MouseUp( Button: TMouseButton;
|
---|
| 30 | Shift: TShiftState;
|
---|
| 31 | X: LongInt; Y: LongInt); override;
|
---|
| 32 |
|
---|
| 33 | Protected
|
---|
| 34 | Procedure SetMinimum( Minimum: longint );
|
---|
| 35 | Procedure SetMaximum( Maximum: longint );
|
---|
| 36 | Protected
|
---|
| 37 | // Hide some properties
|
---|
| 38 | property Caption;
|
---|
| 39 | property Align;
|
---|
| 40 | property Alignment;
|
---|
| 41 | property DragCursor;
|
---|
| 42 | property DragMode;
|
---|
| 43 | property Font;
|
---|
| 44 | property ParentFont;
|
---|
| 45 | property PenColor;
|
---|
| 46 | property ParentPenColor;
|
---|
| 47 |
|
---|
| 48 | property OnCanDrag;
|
---|
| 49 | property OnDragDrop;
|
---|
| 50 | property OnDragOver;
|
---|
| 51 | property OnEndDrag;
|
---|
| 52 | property OnFontChange;
|
---|
| 53 | property OnMouseDown;
|
---|
| 54 | property OnMouseMove;
|
---|
| 55 | property OnMouseUp;
|
---|
| 56 | property OnStartDrag;
|
---|
| 57 | Public
|
---|
| 58 | Destructor Destroy; Override;
|
---|
| 59 | published
|
---|
| 60 | property Minimum: longint read FMinimum write SetMinimum;
|
---|
| 61 | property Maximum: longint read FMaximum write SetMaximum;
|
---|
| 62 | property OnChange: TSplitChange read FOnChange write FOnChange;
|
---|
| 63 |
|
---|
| 64 | End;
|
---|
| 65 |
|
---|
| 66 | Exports
|
---|
| 67 | TSplitBar,'User','SplitBar.bmp';
|
---|
| 68 |
|
---|
| 69 | Implementation
|
---|
| 70 |
|
---|
| 71 | Procedure TSplitBar.SetupComponent;
|
---|
| 72 | Begin
|
---|
| 73 | Inherited SetupComponent;
|
---|
| 74 | Width:= 6;
|
---|
| 75 | BevelWidth:= 2;
|
---|
| 76 | FMinimum:= 0;
|
---|
| 77 | FMaximum:= -1; // maximum in parent
|
---|
| 78 | Caption:= '';
|
---|
| 79 | Name:= 'SplitBar';
|
---|
| 80 | Cursor:= crHSplit;
|
---|
| 81 | End;
|
---|
| 82 |
|
---|
| 83 | Destructor TSplitBar.Destroy;
|
---|
| 84 | Begin
|
---|
| 85 | Inherited Destroy;
|
---|
| 86 | End;
|
---|
| 87 |
|
---|
| 88 | Procedure TSplitBar.SetMinimum( Minimum: longint );
|
---|
| 89 | begin
|
---|
| 90 | FMinimum:= Minimum;
|
---|
| 91 | if Left < Minimum then
|
---|
| 92 | Left:= Minimum;
|
---|
| 93 | end;
|
---|
| 94 |
|
---|
| 95 | Procedure TSplitBar.SetMaximum( Maximum: longint );
|
---|
| 96 | begin
|
---|
| 97 | FMaximum:= Maximum;
|
---|
| 98 | if Left > Maximum then
|
---|
| 99 | Left:= Maximum;
|
---|
| 100 | end;
|
---|
| 101 |
|
---|
| 102 | Function TSplitBar.GetX( XInParent: longint ): longint;
|
---|
| 103 | begin
|
---|
| 104 | Result:= Left + XInParent - FOffset;
|
---|
| 105 | if Result < FMinimum then
|
---|
| 106 | Result:= FMinimum;
|
---|
| 107 | if Result < 0 then
|
---|
| 108 | Result:= 0;
|
---|
| 109 |
|
---|
| 110 | if FMaximum <> -1 then
|
---|
| 111 | begin
|
---|
| 112 | if Result > FMaximum then
|
---|
| 113 | Result:= FMaximum;
|
---|
| 114 | end;
|
---|
| 115 | if Result > ( Parent.ClientWidth - Width ) then
|
---|
| 116 | Result:= Parent.ClientWidth - Width;
|
---|
| 117 | end;
|
---|
| 118 |
|
---|
| 119 | Procedure TSplitBar.DrawSplitLine( X: longint );
|
---|
| 120 | var
|
---|
| 121 | ClientPoint, ScreenPoint: TPoint;
|
---|
| 122 | r: TRect;
|
---|
| 123 | begin
|
---|
| 124 | ClientPoint.x:= X;
|
---|
| 125 | ClientPoint.y:= Bottom;
|
---|
| 126 | ScreenPoint:= Parent.ClientToScreen( ClientPoint );
|
---|
| 127 | r.Left:= ScreenPoint.X;
|
---|
| 128 | r.Bottom:= ScreenPoint.Y;
|
---|
| 129 | r.Top:= ScreenPoint.Y + Height - 1;
|
---|
| 130 | r.Right:= ScreenPoint.X + Width - 1;
|
---|
| 131 | Screen.Canvas.Box( r );
|
---|
| 132 | end;
|
---|
| 133 |
|
---|
| 134 | Procedure TSplitBar.MouseUp( Button: TMouseButton;
|
---|
| 135 | Shift: TShiftState;
|
---|
| 136 | X: LongInt; Y: LongInt);
|
---|
| 137 | Begin
|
---|
| 138 | if not MouseCapture then
|
---|
| 139 | exit;
|
---|
| 140 |
|
---|
| 141 | // final erase of cursor
|
---|
| 142 | DrawSplitLine( FOldPanelX );
|
---|
| 143 | MouseCapture:= false;
|
---|
| 144 |
|
---|
| 145 | Left:= GetX( X );
|
---|
| 146 | if FOnChange <> nil then
|
---|
| 147 | FOnChange( Left );
|
---|
| 148 | End;
|
---|
| 149 |
|
---|
| 150 | Procedure TSplitBar.MouseMove( Shift: TShiftState;
|
---|
| 151 | X: LongInt; Y: LongInt);
|
---|
| 152 | Begin
|
---|
| 153 | if not MouseCapture then
|
---|
| 154 | exit;
|
---|
| 155 |
|
---|
| 156 | // erase cursor
|
---|
| 157 | DrawSplitLine( FOldPanelX );
|
---|
| 158 |
|
---|
| 159 | X:= GetX( X );
|
---|
| 160 |
|
---|
| 161 | FOldPanelX:= X;
|
---|
| 162 |
|
---|
| 163 | // draw new cursor
|
---|
| 164 | DrawSplitLine( X );
|
---|
| 165 |
|
---|
| 166 | End;
|
---|
| 167 |
|
---|
| 168 | Procedure TSplitBar.MouseDown( Button: TMouseButton;
|
---|
| 169 | Shift: TShiftState;
|
---|
| 170 | X: LongInt; Y: LongInt );
|
---|
| 171 | Begin
|
---|
| 172 | if Button <> mbLeft then
|
---|
| 173 | exit;
|
---|
| 174 |
|
---|
| 175 | MouseCapture:= true;
|
---|
| 176 | FOldFgMode := Screen.Canvas.Pen.Mode;
|
---|
| 177 |
|
---|
| 178 | Screen.Canvas.Pen.Mode := pmNot;
|
---|
| 179 |
|
---|
| 180 | // Store the offset within the control that the mouse was clicked
|
---|
| 181 | FOffset:= X;
|
---|
| 182 |
|
---|
| 183 | X:= Left;
|
---|
| 184 |
|
---|
| 185 | // Draw cursor
|
---|
| 186 | DrawSplitLine( X );
|
---|
| 187 |
|
---|
| 188 | FOldPanelX:= X;
|
---|
| 189 | End;
|
---|
| 190 |
|
---|
| 191 | Initialization
|
---|
| 192 | {Register classes}
|
---|
| 193 | RegisterClasses([TSplitBar]);
|
---|
| 194 | End.
|
---|
| 195 |
|
---|