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 |
|
---|