Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

COMCTRLS.PAS@ 8

Last change on this file since 8 was 7, checked in by RBRi, 19 years ago
+ sibyl staff
Property svn:eol-style set to `native`
File size: 103.1 KB

Line
1
2	{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
3	º º
4	º Sibyl Portable Component Classes º
5	º º
6	º Copyright (C) 1995,97 SpeedSoft Germany, All rights reserved. º
7	º º
8	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ}
9
10	Unit ComCtrls;
11
12
13	Interface
14
15	Uses Messages,Classes,Forms,Graphics,Buttons,ExtCtrls,Dos;
16
17	Type
18	{$M+}
19	TProgressString=(psPercent,psCaption,psPosition);
20	TProgressOrigin=(poLeft,poRight,poBottom,poTop);
21	{$M-}
22
23	TProgressBar=Class(TControl)
24	Protected
25	FBorderStyle:TBorderStyle;
26	FInterior:TRect;
27	FMin:LongInt;
28	FMax:LongInt;
29	FPosition:LongInt;
30	FBitmap:TBitmap;
31	FProgressString:TProgressString;
32	FOrigin:TProgressOrigin;
33	FOnChange:TNotifyEvent;
34	Procedure CMTextChanged(Var Msg:TMessage);Message CM_TEXTCHANGED;
35	Procedure SetBorderStyle(bs:TBorderStyle);
36	Procedure SetMin(lr:LongInt);
37	Procedure SetMax(hr:LongInt);
38	Procedure SetPosition(ps:LongInt);
39	Procedure SetProgressString(ps:TProgressString);
40	Procedure SetBitmap(NewBitmap:TBitmap);
41	Function GetBitmap:TBitmap;
42	Procedure SetOrigin(NewOrigin:TProgressOrigin);
43	Procedure DrawInterior(Const rec:TRect);
44	Protected
45	Procedure SetupComponent;Override;
46	Procedure SetupShow;Override;
47	Procedure Change;Virtual;
48	Public
49	Procedure Redraw(Const rec:TRect);Override;
50	Destructor Destroy;Override;
51	Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
52	Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
53	Property XAlign;
54	Property XStretch;
55	Property YAlign;
56	Property YStretch;
57	Published
58	Property Align;
59	Property Color;
60	Property Bitmap:TBitmap Read GetBitmap Write SetBitmap;
61	Property BorderStyle:TBorderStyle Read FBorderStyle Write SetBorderStyle;
62	Property Caption;
63	Property PenColor;
64	Property DragCursor;
65	Property DragMode;
66	Property Enabled;
67	Property Font;
68	Property Max:LongInt Read FMax Write SetMax;
69	Property Min:LongInt Read FMin Write SetMin;
70	Property Origin:TProgressOrigin Read FOrigin Write SetOrigin;
71	Property ParentColor;
72	Property ParentPenColor;
73	Property ParentFont;
74	Property ParentShowHint;
75	Property ProgressString:TProgressString Read FProgressString Write SetProgressString;
76	Property Position:LongInt Read FPosition Write SetPosition;
77	Property ShowHint;
78	Property TabOrder;
79	Property TabStop;
80	Property Visible;
81	Property ZOrder;
82
83	Property OnCanDrag;
84	Property OnChange:TNotifyEvent Read FOnChange Write FOnChange;
85	Property OnDragDrop;
86	Property OnDragOver;
87	Property OnEndDrag;
88	Property OnEnter;
89	Property OnExit;
90	Property OnFontChange;
91	Property OnMouseClick;
92	Property OnMouseDblClick;
93	Property OnMouseDown;
94	Property OnMouseMove;
95	Property OnMouseUp;
96	Property OnSetupShow;
97	Property OnStartDrag;
98	End;
99
100
101	{$M+}
102	TUDOrientation=(udHorizontal,udVertical);
103	TUDAlignButton=(udLeft,udRight,udBottom,udTop,udNone);
104	TUDBtnType=(btNext,btPrev);
105
106	TOnUDChangingEvent=Procedure(Sender:TComponent;Var AllowChange:Boolean) Of Object;
107	TOnUDClickEvent=Procedure(Sender:TComponent;Button:TUDBtnType) Of Object;
108	{$M-}
109
110	TUpDown=Class(TControl)
111	Protected
112	FArrowKeys:Boolean;
113	FIncrement:LongInt;
114	FMin:LongInt;
115	FMax:LongInt;
116	FOrientation:TUDOrientation;
117	FPosition:LongInt;
118	FThousands:Boolean;
119	FWrap:Boolean;
120	FAssociate:TControl;
121	FAlignButton:TUDAlignButton;
122	FUpRightButton:TSpeedButton;
123	FDownLeftButton:TSpeedButton;
124	FOnChanging:TOnUDChangingEvent;
125	FOnClick:TOnUDClickEvent;
126	Procedure SetAssociate(NewControl:TControl);
127	Procedure SetMin(NewValue:LongInt);
128	Procedure SetMax(NewValue:LongInt);
129	Procedure SetOrientation(NewValue:TUDOrientation);
130	Procedure SetPosition(NewValue:LongInt);
131	Procedure SetAlignButton(NewValue:TUDAlignButton);
132	Procedure AlignButtons;
133	Procedure EvButtonClick(Sender:TObject);
134	Protected
135	Procedure SetupComponent;Override;
136	Procedure SetupShow;Override;
137	Procedure Resize;Override;
138	Function CanChange:Boolean;Virtual;
139	Procedure Click(Button:TUDBtnType);Virtual;
140	Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
141	Public
142	Property XAlign;
143	Property XStretch;
144	Property YAlign;
145	Property YStretch;
146	Published
147	Property Align;
148	Property AlignButton:TUDAlignButton Read FAlignButton Write SetAlignButton;
149	Property ArrowKeys:Boolean Read FArrowKeys Write FArrowKeys;
150	Property Associate:TControl Read FAssociate Write SetAssociate;
151	Property PenColor;
152	Property DragCursor;
153	Property DragMode;
154	Property Enabled;
155	Property Increment:LongInt Read FIncrement Write FIncrement;
156	Property Max:LongInt Read FMax Write SetMax;
157	Property Min:LongInt Read FMin Write SetMin;
158	Property Orientation:TUDOrientation Read FOrientation Write SetOrientation;
159	Property ParentColor;
160	Property ParentPenColor;
161	Property ParentShowHint;
162	Property Position:LongInt Read FPosition Write SetPosition;
163	Property ShowHint;
164	Property TabOrder;
165	Property TabStop;
166	Property Thousands:Boolean Read FThousands Write FThousands;
167	Property Visible;
168	Property Wrap:Boolean Read FWrap Write FWrap;
169	Property ZOrder;
170
171	Property OnCanDrag;
172	Property OnChanging:TOnUDChangingEvent Read FOnChanging Write FOnChanging;
173	Property OnClick:TOnUDClickEvent Read FOnClick Write FOnClick;
174	Property OnDragDrop;
175	Property OnDragOver;
176	Property OnEndDrag;
177	Property OnEnter;
178	Property OnExit;
179	Property OnMouseMove;
180	Property OnScan;
181	Property OnSetupShow;
182	Property OnStartDrag;
183	End;
184
185
186	{$M+}
187	TTrackBarOrientation=(trHorizontal,trVertical);
188	TTickMarks=(tmBoth,tmBottomRight,tmTopLeft);
189	TTickStyle=(tsAuto,tsManual,tsNone);
190	TTrackBarSelMode=(smManual,smAuto);
191	TTrackSliderShape=(tsArrow,tsBox);
192	TTrackSliderSize=(tssAuto,tssVeryLarge,tssLarge,tssMedium,tssSmall);
193	{$M-}
194
195	TTrackBar=Class(TControl)
196	Protected
197	FPosition:LongInt;
198	FLineSize:LongInt;
199	FPageSize:LongInt;
200	FMax:LongInt;
201	FMin:LongInt;
202	FOrientation:TTrackBarOrientation;
203	FSelEnd:LongInt;
204	FSelStart:LongInt;
205	FTickMarks:TTickMarks;
206	FTickStyle:TTickStyle;
207	FFrequency:LongInt;
208	FTracking:Boolean;
209	FSelMode:TTrackBarSelMode;
210	FTickSize:LongInt;
211	FTrackTimer:TTimer;
212	FSliderShape:TTrackSliderShape;
213	FOnChange:TNotifyEvent;
214	FTicks:TList;
215	FUpdating:Boolean;
216	FShowFocusRect:Boolean;
217	FSliderSize:TTrackSliderSize;
218	Procedure SetMax(NewValue:LongInt);
219	Procedure SetMin(NewValue:LongInt);
220	Procedure SetOrientation(NewValue:TTrackBarOrientation);
221	Procedure SetPosition(NewValue:LongInt);
222	Procedure SetSelEnd(NewValue:LongInt);
223	Procedure SetSelStart(NewValue:LongInt);
224	Procedure SetTickMarks(NewValue:TTickMarks);
225	Procedure SetTickStyle(NewValue:TTickStyle);
226	Procedure SetFrequency(NewValue:LongInt);
227	Procedure SetSliderSize(NewSize:TTrackSliderSize);
228	Procedure SetSelMode(NewMode:TTrackBarSelMode);
229	Procedure DrawTrack(SliderW,SliderH:LongInt);
230	Procedure DrawSlider(SliderW,SliderH:LongInt);
231	Procedure GetSliderExtent(Var SliderWidth,SliderHeight:LongInt);
232	Function PosInsideSlider(X,Y:LongInt):Boolean;
233	Function PosInsideTrack(X,Y:LongInt):Boolean;
234	Procedure UpdateSlider;
235	Procedure EvTimer(Sender:TObject);
236	Protected
237	Procedure SetupComponent;Override;
238	Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
239	Procedure MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
240	Procedure MouseMove(ShiftState:TShiftState;X,Y:LongInt);Override;
241	Procedure MouseClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
242	Procedure MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
243	Procedure SetFocus;Override;
244	Procedure KillFocus;Override;
245	Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Override;
246	Procedure Change;Virtual;
247	Public
248	Destructor Destroy;Override;
249	Procedure Redraw(Const rec:TRect);Override;
250	Function CoordFromPos(Position:LongInt):LongInt;
251	Function PosFromCoord(Coord:LongInt):LongInt;
252	Procedure SetTick(Pos:LongInt);
253	Procedure ClearTicks;
254	Procedure BeginUpdate;
255	Procedure EndUpdate;
256	Property Tracking:Boolean Read FTracking;
257	Property XAlign;
258	Property XStretch;
259	Property YAlign;
260	Property YStretch;
261	Published
262	Property Align;
263	Property Color;
264	Property DragCursor;
265	Property DragMode;
266	Property Enabled;
267	Property Frequency:LongInt Read FFrequency Write SetFrequency;
268	Property LineSize:LongInt Read FLineSize Write FLineSize;
269	Property Max:LongInt Read FMax Write SetMax;
270	Property Min:LongInt Read FMin Write SetMin;
271	Property Orientation:TTrackBarOrientation Read FOrientation Write SetOrientation;
272	Property PageSize:LongInt Read FPageSize Write FPageSize;
273	Property ParentColor;
274	Property ParentShowHint;
275	Property PopupMenu;
276	Property Position:LongInt Read FPosition Write SetPosition;
277	Property SelEnd:LongInt Read FSelEnd Write SetSelEnd;
278	Property SelMode:TTrackBarSelMode Read FSelMode Write SetSelMode;
279	Property SelStart:LongInt Read FSelStart Write SetSelStart;
280	Property ShowFocusRect:Boolean Read FShowFocusRect Write FShowFocusRect;
281	Property ShowHint;
282	Property SliderSize:TTrackSliderSize Read FSliderSize Write SetSliderSize;
283	Property TabOrder;
284	Property TabStop;
285	Property TickMarks:TTickMarks Read FTickMarks Write SetTickMarks;
286	Property TickStyle:TTickStyle Read FTickStyle Write SetTickStyle;
287	Property Visible;
288	Property ZOrder;
289
290	Property OnCanDrag;
291	Property OnChange:TNotifyEvent Read FOnChange Write FOnChange;
292	Property OnDragDrop;
293	Property OnDragOver;
294	Property OnEndDrag;
295	Property OnEnter;
296	Property OnExit;
297	Property OnMouseClick;
298	Property OnMouseDblClick;
299	Property OnMouseDown;
300	Property OnMouseMove;
301	Property OnMouseUp;
302	Property OnScan;
303	Property OnSetupShow;
304	Property OnStartDrag;
305	End;
306
307	{$M+}
308	TStatusPanelStyle=(psText, psOwnerDraw);
309	TStatusPanelBevel=(pbNone, pbLowered, pbRaised);
310	{$M-}
311
312	TStatusPanel=Class(TCollectionItem)
313	Protected
314	FText:PString;
315	FWidth:LongInt;
316	FAlignment:TAlignment;
317	FBevel:TStatusPanelBevel;
318	FStyle:TStatusPanelStyle;
319	Protected
320	Function GetText:String;
321	Procedure SetText(Const NewValue:String);
322	Procedure SetWidth(NewValue:LongInt);
323	Procedure SetAlignment(NewValue:TAlignment);
324	Procedure SetBevel(NewValue:TStatusPanelBevel);
325	Procedure SetStyle(NewValue:TStatusPanelStyle);
326	Public
327	Constructor Create(ACollection:TCollection);Override;
328	Destructor Destroy;Override;
329	Procedure Assign(Source:TCollectionItem);Override;
330	Published
331	Property Text:String Read GetText Write SetText;
332	Property Width:LongInt Read FWidth Write SetWidth;
333	Property Alignment:TAlignment Read FAlignment Write SetAlignment;
334	Property Bevel:TStatusPanelBevel Read FBevel Write SetBevel;
335	Property Style:TStatusPanelStyle Read FStyle Write SetStyle;
336	End;
337
338	TStatusBar=Class;
339
340	{$HINTS OFF}
341	TStatusPanels=Class(TCollection)
342	Protected
343	FStatusBar:TStatusBar;
344	Function GetItem(Index:LongInt):TStatusPanel;
345	Procedure SetItem(Index:LongInt;Value:TStatusPanel);
346	Public
347	Procedure Update(Item:TCollectionItem);Override;
348	Procedure SetupComponent;Override;
349	Function Add:TStatusPanel;
350	Public
351	Property Items[Index:LongInt]:TStatusPanel Read GetItem Write SetItem;Default;
352	Property StatusBar:TStatusBar Read FStatusBar;
353	End;
354	{$HINTS ON}
355
356	{$M+}
357	TDrawPanelEvent=Procedure(StatusBar:TStatusBar;Panel:TStatusPanel;Const rc:TRect) Of Object;
358	{$M-}
359
360	TStatusBar=Class(TBevel)
361	Protected
362	FSimpleText:String;
363	FSimplePanel:Boolean;
364	FPanels:TStatusPanels;
365	FSizeGrip:Boolean;
366	FSpacing:LongInt;
367	FOnDrawPanel:TDrawPanelEvent;
368	Procedure SetSimpleText(Const NewText:String);
369	Procedure SetSimplePanel(NewValue:Boolean);
370	Procedure SetPanels(NewValue:TStatusPanels);
371	Procedure SetSizeGrip(NewValue:Boolean);
372	Procedure UpdatePanel(Panel:TStatusPanel);
373	Procedure SetSpacing(NewValue:LongInt);
374	Property Shape;
375	Protected
376	Procedure SetupComponent;Override;
377	Destructor Destroy;Override;
378	Procedure DrawPanel(Panel:TStatusPanel;Const rc:TRect);Virtual;
379	Function IsPointOnSizeGrip(X,Y:longint):Boolean;
380	Procedure MouseDown(Button:TMouseButton;
381	ShiftState:TShiftState;
382	X,Y:LongInt);Override;
383	Procedure MouseMove(ShiftState:TShiftState;
384	X,Y:LongInt);Override;
385	Public
386	Procedure Redraw(Const rec:TRect);Override;
387	Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
388	Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
389	Published
390	Property Color;
391	Property PenColor;
392	Property DragCursor;
393	Property DragMode;
394	Property Enabled;
395	Property Font;
396	Property ParentColor;
397	Property ParentPenColor;
398	Property ParentFont;
399	Property ParentShowHint;
400	Property ShowHint;
401	Property TabOrder;
402	Property TabStop;
403	Property Visible;
404	Property ZOrder;
405
406	Property OnCanDrag;
407	Property OnDragDrop;
408	Property OnDragOver;
409	Property OnEndDrag;
410	Property OnEnter;
411	Property OnExit;
412	Property OnFontChange;
413	Property OnMouseClick;
414	Property OnMouseDblClick;
415	Property OnMouseDown;
416	Property OnMouseMove;
417	Property OnMouseUp;
418	Property OnSetupShow;
419	Property OnStartDrag;
420	Property OnClick;
421	Property OnDblClick;
422	Property Panels:TStatusPanels Read FPanels Write SetPanels;
423	Property SimpleText:String Read FSimpleText Write SetSimpleText;
424	Property SimplePanel:Boolean Read FSimplePanel Write SetSimplePanel;
425	Property SizeGrip:Boolean Read FSizeGrip Write SetSizeGrip;
426	Property OnDrawPanel:TDrawPanelEvent Read FOnDrawPanel Write FOnDrawPanel;
427	Property Spacing:LongInt Read FSpacing Write SetSpacing;
428	End;
429
430	THeaderControl=Class;
431
432	{$M+}
433	THeaderSectionStyle=(hsText,hsOwnerDraw);
434	{$M-}
435
436	THeaderSection=Class(TCollectionItem)
437	Protected
438	FText:PString;
439	FWidth:LongInt;
440	FMinWidth:LongInt;
441	FMaxWidth:LongInt;
442	FAlignment:TAlignment;
443	FStyle:THeaderSectionStyle;
444	FAllowClick:Boolean;
445	FAllowSize:Boolean;
446	Protected
447	Function GetText:String;
448	Procedure SetText(Const NewValue:String);
449	Procedure SetWidth(NewValue:LongInt);
450	Function GetLeft:LongInt;
451	Function GetRight:LongInt;
452	Procedure SetStyle(NewValue:THeaderSectionStyle);
453	Procedure SetAlignment(NewValue:TAlignment);
454	Procedure SetMaxWidth(NewValue:LongInt);
455	Procedure SetMinWidth(NewValue:LongInt);
456	Public
457	Constructor Create(ACollection:TCollection);Override;
458	Destructor Destroy;Override;
459	Procedure Assign(Source:TCollectionItem);Override;
460	Public
461	Property Left:LongInt Read GetLeft;
462	Property Right:LongInt Read GetRight;
463	Published
464	Property Text:String Read GetText Write SetText;
465	Property Width:LongInt Read FWidth Write SetWidth;
466	Property MinWidth:LongInt Read FMinWidth Write SetMinWidth;
467	Property MaxWidth:LongInt Read FMaxWidth Write SetMaxWidth;
468	Property Alignment:TAlignment Read FAlignment Write SetAlignment;
469	Property AllowClick:Boolean Read FAllowClick Write FAllowClick;
470	Property AllowSize:Boolean Read FAllowSize Write FAllowSize;
471	Property Style:THeaderSectionStyle Read FStyle Write SetStyle;
472	End;
473
474	{$HINTS OFF}
475	THeaderSections=Class(TCollection)
476	Protected
477	FHeaderControl:THeaderControl;
478	Function GetItem(Index:LongInt):THeaderSection;
479	Procedure SetItem(Index:LongInt;NewValue:THeaderSection);
480	Public
481	Procedure Update(Item:TCollectionItem);Override;
482	Procedure SetupComponent;Override;
483	Function Add:THeaderSection;
484	Public
485	Property Items[Index:LongInt]:THeaderSection Read GetItem Write SetItem;Default;
486	Property HeaderControl:THeaderControl Read FHeaderControl;
487	End;
488	{$HINTS ON}
489	THeaderSectionsClass=Class Of THeaderSections;
490
491	{$M+}
492	TSectionTrackState=(tsTrackBegin,tsTrackMove,tsTrackEnd);
493
494	TSectionNotifyEvent=Procedure(HeaderControl:THeaderControl;section:THeaderSection) Of Object;
495	TDrawSectionEvent=Procedure(HeaderControl:THeaderControl;section:THeaderSection;
496	Const rc:TRect;Pressed:Boolean) Of Object;
497	TSectionTrackEvent=Procedure(HeaderControl:THeaderControl;section:THeaderSection;
498	Width:LongInt;State:TSectionTrackState) Of Object;
499
500	THeaderControl=Class(TControl)
501	Protected
502	FSections:THeaderSections;
503	FSpacing:LongInt;
504	FOnDrawSection:TDrawSectionEvent;
505	FOnSectionClick:TSectionNotifyEvent;
506	FOnSectionResize:TSectionNotifyEvent;
507	FOnSectionTrack:TSectionTrackEvent;
508	FSectionTrackState:TSectionTrackState;
509	FClickSection:THeaderSection;
510	FClickBase:THeaderSection;
511	FSizeStartX:LongInt;
512	FSizeX:LongInt;
513	FSizeSection:THeaderSection;
514	FBevelWidth:LongInt;
515	FShape:TCursor;
516	FSectionsClass:THeaderSectionsClass;
517	Protected
518	Procedure SetSections(NewValue:THeaderSections);
519	Procedure SetSpacing(NewValue:LongInt);
520	Procedure SetBevelWidth(NewValue:LongInt);
521	Function GetSections:THeaderSections;
522	Protected
523	Function GetMouseHeader(X,Y:LongInt):THeaderSection;Virtual;
524	Procedure UpdateHeader(Header:THeaderSection);Virtual;
525	Procedure DrawSection(section:THeaderSection;Const rc:TRect;Pressed:Boolean);Virtual;
526	Procedure SectionClick(section:THeaderSection);Virtual;
527	Procedure SectionResize(section:THeaderSection);Virtual;
528	Procedure SectionTrack(section:THeaderSection;Width:LongInt;State:TSectionTrackState);Virtual;
529	Procedure SetupComponent;Override;
530	Destructor Destroy;Override;
531	Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
532	Procedure MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
533	Procedure MouseMove(ShiftState:TShiftState;X,Y:LongInt);Override;
534	Procedure MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
535	Protected
536	Property ClickSection:THeaderSection read FClickSection write FClickSection;
537	Public
538	Procedure Redraw(Const rec:TRect);Override;
539	Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
540	Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
541	Public
542	Property SectionsClass:THeaderSectionsClass read FSectionsClass write FSectionsClass;
543	Published
544	Property Align;
545	Property BevelWidth:LongInt Read FBevelWidth Write SetBevelWidth;
546	Property DragCursor;
547	Property DragMode;
548	Property Enabled;
549	Property Font;
550	Property Sections:THeaderSections Read GetSections Write SetSections;
551	Property ShowHint;
552	Property ParentFont;
553	Property ParentShowHint;
554	Property PopupMenu;
555	Property Spacing:LongInt Read FSpacing Write SetSpacing;
556	Property TabOrder;
557	Property TabStop;
558	Property OnDragDrop;
559	Property OnDragOver;
560	Property OnStartDrag;
561	Property OnEndDrag;
562	Property OnMouseDown;
563	Property OnMouseMove;
564	Property OnMouseUp;
565	Property OnSectionClick:TSectionNotifyEvent Read FOnSectionClick Write FOnSectionClick;
566	Property OnDrawSection:TDrawSectionEvent Read FOnDrawSection Write FOnDrawSection;
567	Property OnSectionResize:TSectionNotifyEvent Read FOnSectionResize Write FOnSectionResize;
568	Property OnSectionTrack:TSectionTrackEvent Read FOnSectionTrack Write FOnSectionTrack;
569	End;
570
571	THeader=Class(THeaderControl) //For Delphi 1.0 compatibility
572	Protected
573	Function GetSectionWidth(Index:LongInt):LongInt;
574	Procedure SetSectionWidth(Index:LongInt;NewValue:LongInt);
575	Public
576	Property SectionWidth[Index:LongInt]:LongInt Read GetSectionWidth Write SetSectionWidth;
577	End;
578
579	Function InsertProgressBar(parent:TControl;Left,Bottom,Width,Height:LongInt):TProgressBar;
580	Function InsertUpDown(parent:TControl;Left,Bottom,Width,Height:LongInt):TUpDown;
581	Function InsertTrackBar(parent:TControl;Left,Bottom,Width,Height:LongInt):TTrackBar;
582	Function InsertStatusBar(parent:TControl;Left,Bottom,Width,Height:LongInt):TStatusBar;
583	Function InsertHeaderControl(parent:TControl;Left,Bottom,Width,Height:LongInt):THeaderControl;
584
585	Implementation
586
587	{$IFDEF OS2}
588	Uses PmWin;
589	{$ENDIF}
590
591	{$IFDEF WIN32}
592	Uses WinUser;
593	{$ENDIF}
594
595	Function InsertProgressBar(parent:TControl;Left,Bottom,Width,Height:LongInt):TProgressBar;
596	Begin
597	Result.Create(parent);
598	Result.SetWindowPos(Left,Bottom,Width,Height);
599	Result.parent := parent;
600	End;
601
602
603	Function InsertUpDown(parent:TControl;Left,Bottom,Width,Height:LongInt):TUpDown;
604	Begin
605	Result.Create(parent);
606	Result.SetWindowPos(Left,Bottom,Width,Height);
607	Result.parent := parent;
608	End;
609
610
611	Function InsertTrackBar(parent:TControl;Left,Bottom,Width,Height:LongInt):TTrackBar;
612	Begin
613	Result.Create(parent);
614	Result.SetWindowPos(Left,Bottom,Width,Height);
615	Result.parent := parent;
616	End;
617
618	Function InsertStatusBar(parent:TControl;Left,Bottom,Width,Height:LongInt):TStatusBar;
619	Begin
620	Result.Create(parent);
621	Result.SetWindowPos(Left,Bottom,Width,Height);
622	Result.parent := parent;
623	End;
624
625	Function InsertHeaderControl(parent:TControl;Left,Bottom,Width,Height:LongInt):THeaderControl;
626	Begin
627	Result.Create(parent);
628	Result.SetWindowPos(Left,Bottom,Width,Height);
629	Result.parent := parent;
630	End;
631
632	{
633	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
634	º º
635	º Speed-Pascal/2 Version 2.0 º
636	º º
637	º Speed-Pascal Component Classes (SPCC) º
638	º º
639	º This section: TProgressBar Class Implementation º
640	º º
641	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
642	º º
643	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
644	}
645
646	Procedure TProgressBar.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
647	Begin
648	If ResName = rnBitmap Then
649	Begin
650	If DataLen <> 0 Then Bitmap.ReadSCUResource(rnBitmap,Data,DataLen);
651	End
652	Else Inherited ReadSCUResource(ResName,Data,DataLen);
653	End;
654
655
656	Function TProgressBar.WriteSCUResource(Stream:TResourceStream):Boolean;
657	Begin
658	Result := Inherited WriteSCUResource(Stream);
659	If Not Result Then Exit;
660
661	If FBitmap <> Nil
662	Then Result := FBitmap.WriteSCUResourceName(Stream,rnBitmap);
663	End;
664
665
666	Procedure TProgressBar.SetBitmap(NewBitmap:TBitmap);
667	Var OldBitmap:TBitmap;
668	Begin
669	OldBitmap := FBitmap;
670
671	{Create internal Copy}
672	If NewBitmap <> Nil Then FBitmap := NewBitmap.Copy
673	Else FBitmap := Nil;
674
675	If FBitmap <> Nil Then Include(FBitmap.ComponentState, csDetail);
676
677	If OldBitmap <> Nil Then
678	If OldBitmap <> NewBitmap Then OldBitmap.Destroy;
679
680	If Handle <> 0 Then Invalidate;
681	End;
682
683
684	Function TProgressBar.GetBitmap:TBitmap;
685	Begin
686	If FBitmap = Nil Then
687	Begin
688	FBitmap.Create;
689	Include(FBitmap.ComponentState, csDetail);
690	End;
691	Result := FBitmap;
692	End;
693
694
695	{$HINTS OFF}
696	Procedure TProgressBar.CMTextChanged(Var Msg:TMessage);
697	Begin
698	DrawInterior(ClientRect);
699	End;
700	{$HINTS ON}
701
702
703	Procedure TProgressBar.SetBorderStyle(bs:TBorderStyle);
704	Begin
705	FBorderStyle := bs;
706	If Handle<>0 Then Invalidate;
707	End;
708
709
710	Procedure TProgressBar.SetMin(lr:LongInt);
711	Begin
712	If lr > FMax Then Exit;
713	FMin := lr;
714	If Handle<>0 Then DrawInterior(ClientRect);
715	Change;
716	End;
717
718
719	Procedure TProgressBar.SetMax(hr:LongInt);
720	Begin
721	If hr < FMin Then Exit;
722	FMax := hr;
723	If Handle<>0 Then DrawInterior(ClientRect);
724	Change;
725	End;
726
727
728	Procedure TProgressBar.SetPosition(ps:LongInt);
729	Begin
730	FPosition := ps;
731	If Handle<>0 Then DrawInterior(ClientRect);
732	Change;
733	End;
734
735
736	Procedure TProgressBar.SetProgressString(ps:TProgressString);
737	Begin
738	FProgressString := ps;
739	If Handle<>0 Then DrawInterior(ClientRect);
740	End;
741
742
743	Procedure TProgressBar.SetOrigin(NewOrigin:TProgressOrigin);
744	Begin
745	FOrigin := NewOrigin;
746	If Handle<>0 Then DrawInterior(ClientRect);
747	End;
748
749
750	{$HINTS OFF}
751	Procedure TProgressBar.DrawInterior(Const rec:TRect);
752	Var X,Y,CX,CY,xm,ym:LongInt;
753	Percent:LongInt;
754	rec1:TRect;
755	S:String;
756	Begin
757	If Canvas = Nil Then Exit;
758	If FMax = FMin Then
759	Begin
760	If FPosition < FMin Then Percent := 0
761	Else Percent := 100;
762	End
763	Else Percent := ((FPosition-FMin) * 100) Div (FMax-FMin);
764	If Percent < 0 Then Percent := 0;
765	If Percent > 100 Then Percent := 100;
766
767	If Percent <> 0 Then
768	Begin
769	Case FOrigin Of
770	poLeft:
771	Begin
772	xm := ((FInterior.Right-FInterior.Left) * Percent) Div 100;
773	Inc(xm,FInterior.Left);
774	End;
775	poRight:
776	Begin
777	xm := ((FInterior.Right-FInterior.Left) * Percent) Div 100;
778	xm := FInterior.Right - xm;
779	End;
780	poBottom:
781	Begin
782	ym := ((FInterior.Top-FInterior.Bottom) * Percent) Div 100;
783	Inc(ym,FInterior.Bottom);
784	End;
785	poTop:
786	Begin
787	ym := ((FInterior.Top-FInterior.Bottom) * Percent) Div 100;
788	ym := FInterior.Top - ym;
789	End;
790	End;
791	End
792	Else
793	Begin
794	Case FOrigin Of
795	poLeft: xm := FInterior.Left-1;
796	poRight: xm := FInterior.Right+1;
797	poBottom: ym := FInterior.Bottom-1;
798	poTop: ym := FInterior.Top+1;
799	End;
800	End;
801
802	Case FProgressString Of
803	psCaption: S := Caption;
804	psPosition: S := tostr(FPosition) + Caption;
805	psPercent: S := tostr(Percent) + ' %' + Caption;
806	End;
807	Canvas.GetTextExtent(S,CX,CY);
808	Inc(CX);
809	X := FInterior.Left + (FInterior.Right-FInterior.Left-CX) Div 2;
810	Y := FInterior.Bottom + (FInterior.Top-FInterior.Bottom-CY) Div 2;
811	If Y < FInterior.Bottom Then Y := FInterior.Bottom;
812
813	If (FBitmap <> Nil) And (Not FBitmap.Empty)
814	Then Canvas.Brush.Mode := bmTransparent
815	Else Canvas.Brush.Mode := bmOpaque;
816
817	rec1 := FInterior;
818	Case FOrigin Of
819	poLeft: rec1.Right := xm;
820	poRight: rec1.Left := xm;
821	poBottom: rec1.Top := ym;
822	poTop: rec1.Bottom := ym;
823	End;
824	Canvas.SetClipRegion([rec1]);
825	If (FBitmap <> Nil) And (Not FBitmap.Empty) Then
826	Begin
827	Canvas.StretchDraw(FInterior.Left,
828	FInterior.Bottom,
829	FInterior.Right-FInterior.Left,
830	FInterior.Top-FInterior.Bottom,
831	FBitmap);
832	End
833	Else Canvas.FillRect(ClientRect,PenColor);
834
835	Canvas.Pen.color := color;
836	Canvas.Brush.color := PenColor;
837	Canvas.Brush.Mode := bmTransparent;
838	Canvas.TextOut(X,Y,S);
839
840	rec1 := FInterior;
841	Case FOrigin Of
842	poLeft: rec1.Left := xm+1;
843	poRight: rec1.Right := xm-1;
844	poBottom: rec1.Bottom := ym+1;
845	poTop: rec1.Top := ym-1;
846	End;
847	Canvas.SetClipRegion([rec1]);
848	Canvas.FillRect(ClientRect,color);
849
850	Canvas.Pen.color := PenColor;
851	Canvas.Brush.color := color;
852	Canvas.TextOut(X,Y,S);
853	End;
854	{$HINTS ON}
855
856
857	Procedure TProgressBar.Redraw(Const rec:TRect);
858	Begin
859	If Canvas = Nil Then Exit;
860
861	FInterior:=ClientRect;
862
863	DrawSystemBorder(Self,FInterior,FBorderStyle);
864
865	DrawInterior(rec);
866	End;
867
868
869	Procedure TProgressBar.SetupComponent;
870	Begin
871	Inherited SetupComponent;
872
873	Name := 'ProgressBar';
874	Width := 200;
875	Height := 25;
876	PenColor := clHighlight;
877	ParentPenColor := False;
878	ParentColor := True;
879	TabStop := False;
880
881	FBorderStyle := bsSingle;
882	FMin := 0;
883	FMax := 100;
884	FPosition := 0;
885	FProgressString := psPercent;
886	FBitmap := Nil;
887	FOrigin := poLeft;
888	End;
889
890
891	Procedure TProgressBar.SetupShow;
892	Var I:LongInt;
893	Begin
894	Inherited SetupShow;
895
896	If FBorderStyle = bsNone Then I := 1
897	Else I := 3;
898	FInterior := ClientRect;
899	Forms.InflateRect(FInterior,-I,-I);
900	End;
901
902
903	Procedure TProgressBar.Change;
904	Begin
905	If FOnChange <> Nil Then FOnChange(Self);
906	End;
907
908
909	Destructor TProgressBar.Destroy;
910	Begin
911	If FBitmap <> Nil Then FBitmap.Destroy;
912	FBitmap := Nil;
913
914	Inherited Destroy;
915	End;
916
917
918	{
919	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
920	º º
921	º Speed-Pascal/2 Version 2.0 º
922	º º
923	º Speed-Pascal Component Classes (SPCC) º
924	º º
925	º This section: TUpDown Class Implementation º
926	º º
927	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
928	º º
929	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
930	}
931
932	Type
933	TUpDownBtn=Class(TSpeedButton)
934	Protected
935	FUp:Boolean;
936	FTimer:TTimer;
937	Protected
938	Procedure SetupComponent;Override;
939	Public
940	Procedure Redraw(Const rec:TRect);Override;
941	Procedure OnTimer(Sender:TObject);
942	Procedure OnMDown(Sender:TObject;Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
943	Procedure OnMUp(Sender:TObject;Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
944	End;
945
946	Procedure TUpDownBtn.SetupComponent;
947	Begin
948	Inherited SetupComponent;
949	Include(ComponentState, csDetail);
950	Caption := '';
951	ParentPenColor := True;
952	FTimer.Create(Self);
953	FTimer.Interval:=400;
954	FTimer.OnTimer:=OnTimer;
955	OnMouseDown:=OnMDown;
956	OnMouseUp:=OnMUp;
957	End;
958
959	Procedure TUpDownBtn.OnMDown(Sender:TObject;Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
960	Begin
961	FTimer.Stop;
962	FTimer.Interval:=400;
963	FTimer.Start;
964	End;
965
966	Procedure TUpDownBtn.OnMUp(Sender:TObject;Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
967	Begin
968	FTimer.Stop;
969	End;
970
971	Procedure TUpDownBtn.OnTimer(Sender:TObject);
972	Begin
973	FTimer.Stop;
974	OnClick(Self);
975	FTimer.Interval:=150;
976	FTimer.Start;
977	End;
978
979	Procedure TUpDownBtn.Redraw(Const rec:TRect);
980	Var pts:Array[0..2] Of TPoint;
981	WH:LongInt;
982	space:LongInt;
983	Const MinSpace=2;
984	Begin
985	Inherited Redraw(rec);
986
987	Canvas.ClipRect:=rec;
988
989	WH:=Height;
990	If Width<WH Then WH:=Width;
991	Dec(WH,4);
992	If WH<1 Then WH:=1;
993	space:=WH Div 5;
994	If space<MinSpace Then space:=MinSpace;
995	Dec(WH,space*2);
996
997	If TUpDown(Owner).Orientation=udHorizontal Then
998	Begin
999	pts[0].X:=(Width-WH) Div 2;
1000	If Down Then Inc(pts[0].X);
1001	If pts[0].X<MinSpace Then pts[0].X:=MinSpace;
1002
1003	If FUp Then //Pfeil nach rechts
1004	Begin
1005	pts[0].Y:=Height-((Height-WH) Div 2);
1006	If pts[0].Y>Height-MinSpace Then pts[0].Y:=Height-MinSpace;
1007
1008	End
1009	Else //Pfeil nach links
1010	Begin
1011	pts[0].Y:=Height Div 2;
1012	If pts[0].Y<MinSpace Then pts[0].Y:=MinSpace;
1013	End;
1014	If Down Then Dec(pts[0].Y);
1015
1016	pts[1].X:=Width-((Width-WH) Div 2);
1017	If Down Then Inc(pts[1].X);
1018	If pts[1].X>Width-MinSpace Then pts[1].X:=Width-MinSpace;
1019
1020	If FUp Then
1021	Begin
1022	pts[1].Y:=Height Div 2;
1023	If pts[1].Y<MinSpace Then pts[1].Y:=MinSpace;
1024	End
1025	Else
1026	Begin
1027	pts[1].Y:=Height-((Height-WH) Div 2);
1028	If pts[1].Y>Height-MinSpace Then pts[1].Y:=Height-MinSpace;
1029	End;
1030	If Down Then Dec(pts[1].Y);
1031
1032	If FUp Then pts[2].X:=pts[0].X
1033	Else pts[2].X:=pts[1].X;
1034
1035	pts[2].Y:=(Height-WH) Div 2;
1036	If pts[2].Y<MinSpace Then pts[2].Y:=MinSpace;
1037	If Down Then Dec(pts[2].Y);
1038	End
1039	Else
1040	Begin
1041	pts[0].X:=(Width-WH) Div 2;
1042	If Down Then Inc(pts[0].X);
1043	If pts[0].X<MinSpace Then pts[0].X:=MinSpace;
1044
1045	If FUp Then
1046	Begin
1047	pts[0].Y:=(Height-WH) Div 2;
1048	If pts[0].Y<MinSpace Then pts[0].Y:=MinSpace;
1049	End
1050	Else
1051	Begin
1052	pts[0].Y:=Height-((Height-WH) Div 2);
1053	If pts[0].Y>Height-MinSpace Then pts[0].Y:=Height-MinSpace;
1054	End;
1055	If Down Then Dec(pts[0].Y);
1056
1057	pts[1].X:=Width-((Width-WH) Div 2);
1058	If Down Then Inc(pts[1].X);
1059	If pts[1].X>Width-MinSpace Then pts[1].X:=Width-MinSpace;
1060
1061	pts[1].Y:=pts[0].Y;
1062
1063	pts[2].X:=pts[0].X+WH Div 2;
1064	If Down Then Inc(pts[2].X);
1065
1066	If FUp Then
1067	Begin
1068	pts[2].Y:=Height-((Height-WH) Div 2);
1069	If pts[2].Y>Height-MinSpace Then pts[2].Y:=Height-MinSpace;
1070	End
1071	Else
1072	Begin
1073	pts[2].Y:=(Height-WH) Div 2;
1074	If pts[2].Y<MinSpace Then pts[2].Y:=MinSpace;
1075	End;
1076	If Down Then Dec(pts[2].Y);
1077	End;
1078
1079	Canvas.Pen.color:=PenColor;
1080	Canvas.BeginPath;
1081	Canvas.Polygon(pts);
1082	Canvas.EndPath;
1083	Canvas.FillPath;
1084	End;
1085
1086	///////////////////////////////////////////////////////////////////////
1087
1088	Procedure TUpDown.SetAssociate(NewControl:TControl);
1089	Begin
1090	If NewControl=Self Then Exit;
1091
1092	If FAssociate<>Nil Then FAssociate.Notification(Self,opRemove);
1093	FAssociate := NewControl;
1094	If FAssociate <> Nil Then FAssociate.FreeNotification(Self);
1095	AlignButton := FAlignButton;
1096
1097	If Associate<>Nil Then
1098	Begin
1099	If Associate Is TScrollBar Then TScrollBar(Associate).Position:=FMin
1100	Else If Associate Is TProgressBar Then TProgressBar(Associate).Position:=FMin
1101	Else If Associate Is TTrackBar Then TTrackBar(Associate).Position:=FMin
1102	Else Associate.Caption:=tostr(FMin);
1103	End;
1104	End;
1105
1106
1107	Procedure TUpDown.Notification(AComponent:TComponent;Operation:TOperation);
1108	Begin
1109	Inherited Notification(AComponent,Operation);
1110
1111	If Operation = opRemove Then
1112	If AComponent = FAssociate Then FAssociate := Nil;
1113	End;
1114
1115
1116	Procedure TUpDown.SetOrientation(NewValue:TUDOrientation);
1117	Begin
1118	FOrientation:=NewValue;
1119	AlignButtons;
1120	End;
1121
1122
1123	Procedure TUpDown.SetPosition(NewValue:LongInt);
1124	Begin
1125	If NewValue<Min Then NewValue:=Min;
1126	If NewValue>Max Then NewValue:=Max;
1127	If NewValue=FPosition Then Exit;
1128	FPosition:=NewValue;
1129	If Associate<>Nil Then
1130	Begin
1131	If Associate Is TScrollBar Then TScrollBar(Associate).Position:=FPosition
1132	Else If Associate Is TProgressBar Then TProgressBar(Associate).Position:=FPosition
1133	Else If Associate Is TTrackBar Then TTrackBar(Associate).Position:=FPosition
1134	Else Associate.Caption:=tostr(FPosition);
1135	End;
1136	End;
1137
1138
1139	Procedure TUpDown.SetMin(NewValue:LongInt);
1140	Begin
1141	If NewValue>Max Then Exit;
1142	FMin:=NewValue;
1143	If Position<FMin Then Position:=FMin;
1144	End;
1145
1146
1147	Procedure TUpDown.SetMax(NewValue:LongInt);
1148	Begin
1149	If NewValue<Min Then Exit;
1150	FMax:=NewValue;
1151	If Position>FMax Then Position:=FMax;
1152	End;
1153
1154
1155	Procedure TUpDown.SetAlignButton(NewValue:TUDAlignButton);
1156	Begin
1157	FAlignButton:=NewValue;
1158	If Associate Is TControl Then
1159	Case AlignButton Of
1160	udRight: SetWindowPos(Associate.Left+Associate.Width,Associate.Bottom,
1161	Width,Height);
1162	udLeft: SetWindowPos(Associate.Left-Width,Associate.Bottom,
1163	Width,Height);
1164	udTop: SetWindowPos(Associate.Left,Associate.Bottom+Associate.Height,
1165	Width,Height);
1166	udBottom: SetWindowPos(Associate.Left,Associate.Bottom-Height,
1167	Width,Height);
1168	End;
1169	End;
1170
1171
1172	Function GetUpRightButton(UpDown:TUpDown):TSpeedButton;
1173	Begin
1174	Result:=UpDown.FUpRightButton;
1175	End;
1176
1177	Function GetDownLeftButton(UpDown:TUpDown):TSpeedButton;
1178	Begin
1179	Result:=UpDown.FDownLeftButton;
1180	End;
1181
1182	Procedure TUpDown.SetupComponent;
1183	Begin
1184	Inherited SetupComponent;
1185
1186	ParentColor:=True;
1187	FArrowKeys:=True;
1188	FIncrement:=1;
1189	FMin:=0;
1190	FMax:=10;
1191	FPosition:=0;
1192	FThousands:=True;
1193	FWrap:=False;
1194	Name:='UpDown';
1195	ParentColor:=True;
1196	PenColor:=clBlack;
1197	Width:=39;
1198	Height:=50;
1199	FAlignButton:=udNone;
1200	FOrientation:=udVertical;
1201
1202	FUpRightButton:=TUpDownBtn.Create(Self);
1203	TUpDownBtn(FUpRightButton).FUp:=True;
1204	TUpDownBtn(FUpRightButton).OnClick:=EvButtonClick;
1205	InsertControl(FUpRightButton);
1206	FDownLeftButton:=TUpDownBtn.Create(Self);
1207	TUpDownBtn(FDownLeftButton).OnClick:=EvButtonClick;
1208	InsertControl(FDownLeftButton);
1209	End;
1210
1211
1212	Procedure TUpDown.AlignButtons;
1213	Begin
1214	Case FOrientation Of
1215	udHorizontal:
1216	Begin
1217	FDownLeftButton.SetWindowPos(0,0,(Width Div 2),Height);
1218	FUpRightButton.SetWindowPos((Width Div 2),0,(Width Div 2),Height);
1219	End;
1220	udVertical:
1221	Begin
1222	FDownLeftButton.SetWindowPos(0,0,Width,(Height Div 2));
1223	FUpRightButton.SetWindowPos(0,(Height Div 2),Width,(Height Div 2));
1224	End;
1225	End;
1226	End;
1227
1228
1229	Procedure TUpDown.SetupShow;
1230	Begin
1231	Inherited SetupShow;
1232
1233	AlignButtons;
1234	End;
1235
1236
1237	Procedure TUpDown.Resize;
1238	Begin
1239	Inherited Resize;
1240
1241	AlignButtons;
1242	End;
1243
1244
1245	Procedure TUpDown.EvButtonClick(Sender:TObject);
1246	Begin
1247	If Not CanChange Then Exit;
1248
1249	If TBitBtn(Sender)=FUpRightButton Then
1250	Begin
1251	If Position=Max Then
1252	Begin
1253	If Not FWrap Then Exit;
1254	Position:=Min;
1255	End
1256	Else Position:=Position+1;
1257	Click(btNext);
1258	End
1259	Else
1260	Begin
1261	If Position=Min Then
1262	Begin
1263	If Not FWrap Then Exit;
1264	Position:=Max;
1265	End
1266	Else Position:=Position-1;
1267	Click(btPrev);
1268	End;
1269	End;
1270
1271
1272	Function TUpDown.CanChange:Boolean;
1273	Begin
1274	Result := True;
1275	If FOnChanging <> Nil Then FOnChanging(Self,Result);
1276	End;
1277
1278
1279	Procedure TUpDown.Click(Button:TUDBtnType);
1280	Begin
1281	If FOnClick <> Nil Then FOnClick(Self,Button);
1282	End;
1283
1284
1285	{
1286	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1287	º º
1288	º Speed-Pascal/2 Version 2.0 º
1289	º º
1290	º Speed-Pascal Component Classes (SPCC) º
1291	º º
1292	º This section: TTrackBar Class Implementation º
1293	º º
1294	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1295	º º
1296	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1297	}
1298
1299	Procedure TTrackBar.SetMax(NewValue:LongInt);
1300	Begin
1301	If NewValue<Min Then Exit;
1302	FMax:=NewValue;
1303	If Position>Max Then Position:=Max;
1304	End;
1305
1306	Procedure TTrackBar.SetMin(NewValue:LongInt);
1307	Begin
1308	If NewValue>Max Then Exit;
1309	FMin:=NewValue;
1310	If FSelMode=smAuto Then If FSelStart<>Min Then
1311	Begin
1312	FSelStart:=Min;
1313	FSelEnd:=FPosition;
1314	If Not FUpdating Then Invalidate;
1315	End;
1316	If Position<Min Then Position:=Min;
1317	End;
1318
1319	Procedure TTrackBar.SetOrientation(NewValue:TTrackBarOrientation);
1320	Begin
1321	If FOrientation=NewValue Then Exit;
1322	FOrientation:=NewValue;
1323	//Exchange Width And Height
1324	SetWindowPos(Left,Bottom,Height,Width)
1325	End;
1326
1327	Procedure TTrackBar.SetPosition(NewValue:LongInt);
1328	Begin
1329	If NewValue<Min Then NewValue:=Min;
1330	If NewValue>Max Then NewValue:=Max;
1331	If NewValue=Position Then Exit;
1332	FPosition:=NewValue;
1333	If FSelMode=smAuto Then
1334	Begin
1335	FSelStart:=Min;
1336	FSelEnd:=FPosition;
1337	End;
1338	UpdateSlider;
1339	Change;
1340	End;
1341
1342	Procedure TTrackBar.Change;
1343	Begin
1344	If OnChange<>Nil Then OnChange(Self);
1345	End;
1346
1347	Procedure TTrackBar.SetSelEnd(NewValue:LongInt);
1348	Begin
1349	If FSelMode<>smManual Then Exit;
1350	FSelEnd:=NewValue;
1351	If FSelEnd>FSelStart Then If Not FUpdating Then UpdateSlider;
1352	End;
1353
1354	Procedure TTrackBar.SetSelStart(NewValue:LongInt);
1355	Begin
1356	If FSelMode<>smManual Then Exit;
1357	FSelStart:=NewValue;
1358	If FSelStart<FSelEnd Then If Not FUpdating Then UpdateSlider;
1359	End;
1360
1361	Procedure TTrackBar.SetTickMarks(NewValue:TTickMarks);
1362	Begin
1363	FTickMarks:=NewValue;
1364	If NewValue=tmBoth Then FSliderShape:=tsBox
1365	Else FSliderShape:=tsArrow;
1366	If Not FUpdating Then Invalidate;
1367	End;
1368
1369	Procedure TTrackBar.SetTickStyle(NewValue:TTickStyle);
1370	Begin
1371	FTickStyle:=NewValue;
1372	If Not FUpdating Then Invalidate;
1373	End;
1374
1375	Procedure TTrackBar.SetFrequency(NewValue:LongInt);
1376	Begin
1377	If NewValue<1 Then NewValue:=1;
1378	If Min+NewValue>Max Then NewValue:=Max-Min;
1379	FFrequency:=NewValue;
1380	If Not FUpdating Then Invalidate;
1381	End;
1382
1383	Procedure TTrackBar.SetSelMode(NewMode:TTrackBarSelMode);
1384	Begin
1385	FSelMode:=NewMode;
1386	If FSelMode=smAuto Then
1387	Begin
1388	FSelStart:=Min;
1389	FSelEnd:=Position;
1390	End;
1391	If Not FUpdating Then Invalidate;
1392	End;
1393
1394	Procedure TTrackBar.SetupComponent;
1395	Begin
1396	Inherited SetupComponent;
1397
1398	Name:='TrackBar';
1399	ParentColor:=True;
1400	FShowFocusRect:=True;
1401	FPosition:=0;
1402	FLineSize:=1;
1403	FPageSize:=5;
1404	FMax:=10;
1405	FMin:=0;
1406	FOrientation:=trHorizontal;
1407	FSelEnd:=0;
1408	FSelStart:=0;
1409	FTickMarks:=tmBottomRight;
1410	FTickStyle:=tsAuto;
1411	FFrequency:=1;
1412	FSelMode:=smManual;
1413	FSliderShape:=tsArrow;
1414	Width:=200;
1415	Height:=50;
1416	FTrackTimer.Create(Self);
1417	Include(FTrackTimer.ComponentState, csDetail);
1418	FTrackTimer.Interval:=400;
1419	FTrackTimer.OnTimer:=EvTimer;
1420	FSliderSize:=tssAuto;
1421	End;
1422
1423	Destructor TTrackBar.Destroy;
1424	Begin
1425	If FTicks<>Nil Then FTicks.Destroy;
1426	Inherited Destroy;
1427	End;
1428
1429	Procedure TTrackBar.DrawSlider(SliderW,SliderH:LongInt);
1430	Var
1431	pts:Array[0..5] Of TPoint;
1432	Diff,Diff1:LongInt;
1433
1434	Procedure Draw;
1435	Begin
1436	Canvas.BeginPath;
1437	Canvas.PolyLine(pts);
1438	Canvas.EndPath;
1439	End;
1440
1441	Procedure Inflate;
1442	Begin
1443	If Orientation=trHorizontal Then
1444	Begin
1445	If FSliderShape=tsBox Then
1446	Begin
1447	Dec(pts[0].X);
1448	Dec(pts[0].Y);
1449
1450	Inc(pts[1].X);
1451	Dec(pts[1].Y);
1452
1453	Inc(pts[2].X);
1454	Inc(pts[2].Y);
1455
1456	Dec(pts[3].X);
1457	Inc(pts[3].Y);
1458
1459	pts[4]:=pts[0];
1460	pts[5]:=pts[0];
1461	End
1462	Else
1463	Begin
1464	Dec(pts[0].Y);
1465	Dec(pts[1].Y);
1466	Inc(pts[2].X);
1467	Inc(pts[3].X);
1468	Inc(pts[3].Y);
1469	Dec(pts[4].X);
1470	Inc(pts[4].Y);
1471	Dec(pts[5].X);
1472	End;
1473	End
1474	Else
1475	Begin
1476	If FSliderShape=tsBox Then
1477	Begin
1478	Dec(pts[0].X);
1479	Dec(pts[0].Y);
1480
1481	Inc(pts[1].X);
1482	Dec(pts[1].Y);
1483
1484	Inc(pts[2].X);
1485	Inc(pts[2].Y);
1486
1487	Dec(pts[3].X);
1488	Inc(pts[3].Y);
1489
1490	pts[4]:=pts[0];
1491	pts[5]:=pts[0];
1492	End
1493	Else
1494	Begin
1495	Dec(pts[0].Y);
1496	Inc(pts[1].Y);
1497	Inc(pts[2].X);
1498	Inc(pts[2].Y);
1499	Dec(pts[3].X);
1500	Inc(pts[3].Y);
1501	Dec(pts[4].X);
1502	Dec(pts[4].Y);
1503	Inc(pts[5].X);
1504	Dec(pts[5].Y);
1505	End;
1506	End;
1507	End;
1508
1509	Procedure DrawBoxL;
1510	Begin
1511	Canvas.PenPos:=pts[0];
1512	If FSliderShape=tsBox Then
1513	Begin
1514	Canvas.LineTo(pts[3].X,pts[3].Y);
1515	Canvas.LineTo(pts[2].X,pts[2].Y);
1516	End
1517	Else
1518	Begin
1519	Canvas.LineTo(pts[5].X,pts[5].Y);
1520	Canvas.LineTo(pts[4].X,pts[4].Y);
1521	Canvas.LineTo(pts[3].X,pts[3].Y);
1522	End;
1523	End;
1524
1525	Procedure DrawBoxR;
1526	Begin
1527	Canvas.PenPos:=pts[0];
1528	If FSliderShape=tsBox Then
1529	Begin
1530	Canvas.LineTo(pts[1].X,pts[1].Y);
1531	Canvas.LineTo(pts[2].X,pts[2].Y);
1532	End
1533	Else
1534	Begin
1535	Canvas.LineTo(pts[1].X,pts[1].Y);
1536	Canvas.LineTo(pts[2].X,pts[2].Y);
1537	Canvas.LineTo(pts[3].X,pts[3].Y);
1538	End;
1539	End;
1540
1541	Begin
1542	Canvas.Pen.color:=color;
1543
1544	If ((FTickMarks=tmBoth)Or(FTickMarks=tmTopLeft)) Then Diff:=20
1545	Else Diff:=2;
1546
1547	If Orientation=trHorizontal Then
1548	Begin
1549	If FSliderShape=tsBox Then
1550	Begin
1551	pts[0].X:=2+CoordFromPos(Position)-SliderW Div 2;
1552	pts[0].Y:=Height-Diff-SliderH+SliderH Div 6;
1553	pts[1].X:=pts[0].X+SliderW-5;
1554	pts[1].Y:=pts[0].Y;
1555	pts[2].X:=pts[1].X;
1556	pts[2].Y:=pts[0].Y+SliderH-2-SliderH Div 6;
1557	pts[3].X:=pts[0].X;
1558	pts[3].Y:=pts[2].Y;
1559	pts[4]:=pts[0];
1560	pts[5]:=pts[0];
1561	End
1562	Else
1563	Begin
1564	pts[0].X:=CoordFromPos(Position)-1;
1565	pts[0].Y:=Height-Diff-SliderH+2;
1566
1567	pts[1].X:=pts[0].X+2;
1568	pts[1].Y:=pts[0].Y;
1569
1570	pts[2].X:=pts[1].X+((SliderW-8) Div 2);
1571	pts[2].Y:=pts[1].Y+(SliderH Div 3);
1572
1573	pts[3].X:=pts[2].X;
1574	pts[3].Y:=pts[0].Y+SliderH-4;
1575
1576	pts[4].X:=pts[0].X-((SliderW-6) Div 2);
1577	pts[4].Y:=pts[3].Y;
1578
1579	pts[5].X:=pts[4].X;
1580	pts[5].Y:=pts[2].Y;
1581
1582	If TickMarks=tmTopLeft Then
1583	Begin
1584	Diff1:=pts[2].Y-pts[0].Y;
1585	pts[3].Y:=pts[0].Y;
1586	pts[0].Y:=pts[4].Y+SliderH Div 6;
1587	pts[4].Y:=pts[3].Y;
1588	pts[1].Y:=pts[0].Y;
1589	pts[5].Y:=pts[0].Y-Diff1;
1590	pts[2].Y:=pts[5].Y;
1591	End;
1592	End;
1593	End
1594	Else
1595	Begin
1596	If FSliderShape=tsBox Then
1597	Begin
1598	pts[0].X:=Diff+2;
1599	pts[0].Y:=2+CoordFromPos(Position)-SliderW Div 2;
1600	pts[1].X:=pts[0].X+SliderH-3-SliderH Div 6;
1601	pts[1].Y:=pts[0].Y;
1602	pts[2].Y:=pts[0].Y+SliderW-5;
1603	pts[2].X:=pts[1].X;
1604	pts[3].Y:=pts[2].Y;
1605	pts[3].X:=pts[0].X;
1606	pts[4]:=pts[0];
1607	pts[5]:=pts[0];
1608	End
1609	Else
1610	Begin
1611	pts[0].Y:=CoordFromPos(Position)-1;
1612	pts[0].X:=Diff+SliderH-1;
1613
1614	pts[1].Y:=pts[0].Y+2;
1615	pts[1].X:=pts[0].X;
1616
1617	pts[2].Y:=pts[1].Y+((SliderW-8) Div 2);
1618	pts[2].X:=pts[1].X-(SliderH Div 3);
1619
1620	pts[3].Y:=pts[2].Y;
1621	pts[3].X:=Diff+2;
1622
1623	pts[4].Y:=pts[0].Y-((SliderW-6) Div 2);
1624	pts[4].X:=pts[3].X;
1625
1626	pts[5].Y:=pts[4].Y;
1627	pts[5].X:=pts[2].X;
1628
1629	If TickMarks=tmTopLeft Then
1630	Begin
1631	Diff1:=pts[0].X-pts[2].X;
1632	pts[3].X:=pts[0].X;
1633	pts[0].X:=pts[4].X-SliderH Div 6;
1634	pts[4].X:=pts[3].X;
1635	pts[1].X:=pts[0].X;
1636	pts[5].X:=pts[0].X+Diff1;
1637	pts[2].X:=pts[5].X;
1638	End;
1639	End;
1640	End;
1641
1642	//Draw filled portion
1643	If FTracking Then
1644	Begin
1645	Canvas.Brush.color:=clWhite;
1646	Canvas.Brush.Style:=bsDiagCross;
1647	End;
1648	Draw;
1649	Canvas.FillPath;
1650	If FTracking Then
1651	Begin
1652	Canvas.Brush.Style:=bsSolid;
1653	Canvas.Brush.color:=color;
1654	End;
1655
1656	Inflate;
1657
1658	Canvas.Pen.color:=clBtnHighlight;
1659	DrawBoxL;
1660
1661	Canvas.Pen.color:=clBtnShadow;
1662	DrawBoxR;
1663
1664	Inflate;
1665
1666	Canvas.Pen.color:=clBtnHighlight;
1667	DrawBoxL;
1668
1669	Canvas.Pen.color:=clBtnDefault;
1670	DrawBoxR;
1671
1672	Draw;
1673	Canvas.PathToClipRegion(paDiff);
1674	End;
1675
1676	Procedure TTrackBar.DrawTrack(SliderW,SliderH:LongInt);
1677	Var rc,rc1:TRect;
1678	Diff:LongInt;
1679	Begin
1680	//Draw Slider
1681	DrawSlider(SliderW,SliderH);
1682
1683	If ((FTickMarks=tmBoth)Or(FTickMarks=tmTopLeft)) Then Diff:=20
1684	Else Diff:=2;
1685
1686	//Draw Box
1687	If Orientation=trHorizontal Then
1688	Begin
1689	rc.Left := 2;
1690	rc.Bottom := Height-Diff-(SliderH Div 3)*2 -1;
1691	rc.Right := Width-3;
1692	rc.Top := (Height-Diff-SliderH Div 6)-2 +1;
1693	End
1694	Else
1695	Begin
1696	rc.Left := Diff+2+(SliderH Div 6) -1;
1697	rc.Bottom := 2;
1698	rc.Right := rc.Left + (SliderH Div 6) + (SliderH Div 3);
1699	rc.Top := Height-3;
1700	End;
1701	DrawSystemBorder(Self,rc,bsSingle);
1702
1703	If FSelMode=smAuto Then
1704	Begin
1705	FSelStart:=Min;
1706	FSelEnd:=FPosition;
1707	End;
1708
1709	If FSelEnd>FSelStart Then
1710	Begin
1711	If Orientation=trHorizontal Then
1712	Begin
1713	rc1.Left:=CoordFromPos(FSelStart);
1714	rc1.Right:=CoordFromPos(FSelEnd);
1715	If rc.Top-rc.Bottom>6 Then //medium And large
1716	Begin
1717	rc1.Bottom:=rc.Bottom+2;
1718	rc1.Top:=rc.Top-2;
1719	End
1720	Else //small
1721	Begin
1722	rc1.Bottom:=rc.Bottom+1;
1723	rc1.Top:=rc.Top-1;
1724	End;
1725	Canvas.FillRect(rc1,clHighlight);
1726	Canvas.ExcludeClipRect(rc1);
1727	End
1728	Else
1729	Begin
1730	rc1.Bottom:=CoordFromPos(FSelStart);
1731	rc1.Top:=CoordFromPos(FSelEnd);
1732	If rc.Right-rc.Left>6 Then //medium And large
1733	Begin
1734	rc1.Left:=rc.Left+2;
1735	rc1.Right:=rc.Right-2;
1736	End
1737	Else //small
1738	Begin
1739	rc1.Left:=rc.Left+1;
1740	rc1.Right:=rc.Right-1;
1741	End;
1742	Canvas.FillRect(rc1,clHighlight);
1743	Canvas.ExcludeClipRect(rc1);
1744	End;
1745	End;
1746
1747	Canvas.FillRect(rc,clWhite);
1748	Forms.InflateRect(rc, 2, 2);
1749	Canvas.ExcludeClipRect(rc);
1750	End;
1751
1752	Procedure TTrackBar.Redraw(Const rec:TRect);
1753	Var SliderWidth,SliderHeight:LongInt;
1754	T:LongInt;
1755	X,Y,Diff:LongInt;
1756	rc:TRect;
1757
1758	Procedure DrawTick(X,Y,X1,y1:LongInt);
1759	Var rc:TRect;
1760	Begin
1761	rc.LeftBottom:=Point(X1,y1);
1762	rc.RightTop:=Point(X,Y);
1763	Canvas.BeginPath;
1764	Canvas.Rectangle(rc);
1765	Canvas.EndPath;
1766	Canvas.OutlinePath;
1767	Canvas.BeginPath;
1768	Canvas.Rectangle(rc);
1769	Canvas.EndPath;
1770	Canvas.PathToClipRegion(paDiff);
1771	End;
1772
1773	Procedure DrawLabelX;
1774	Begin
1775	If ((FTickMarks=tmBoth)Or(FTickMarks=tmBottomRight)) Then
1776	Begin
1777	DrawTick(X,Y,X,Y-FTickSize);
1778	End;
1779	If ((FTickMarks=tmBoth)Or(FTickMarks=tmTopLeft)) Then
1780	Begin
1781	DrawTick(X,Height-Diff+6,X,Height-Diff+6+FTickSize)
1782	End;
1783	End;
1784
1785	Procedure DrawLabelY;
1786	Begin
1787	If ((FTickMarks=tmBoth)Or(FTickMarks=tmBottomRight)) Then
1788	Begin
1789	If ((SliderHeight=45)Or(SliderHeight=38)) Then
1790	Begin
1791	If FSliderShape=tsBox Then
1792	DrawTick(Diff+SliderHeight,Y,Diff+SliderHeight+FTickSize,Y)
1793	Else
1794	DrawTick(Diff+SliderHeight+2,Y,Diff+SliderHeight+2+FTickSize,Y)
1795	End
1796	Else DrawTick(Diff+SliderHeight+2,Y,Diff+SliderHeight+2+FTickSize,Y)
1797	End;
1798	If ((FTickMarks=tmBoth)Or(FTickMarks=tmTopLeft)) Then
1799	Begin
1800	DrawTick(X,Y,X-FTickSize,Y);
1801	End;
1802	End;
1803	Begin
1804	GetSliderExtent(SliderWidth,SliderHeight);
1805
1806	//Draw Slider And Box
1807	DrawTrack(SliderWidth,SliderHeight);
1808
1809	//Draw Ticks
1810	If ((FTickMarks=tmBoth)Or(FTickMarks=tmTopLeft)) Then Diff:=20
1811	Else Diff:=2;
1812	If Orientation=trHorizontal Then
1813	Begin
1814	Case FTickStyle Of
1815	tsAuto:
1816	Begin
1817	Y:=Height-Diff-SliderHeight+2;
1818	Dec(Y,5);
1819
1820	Canvas.Pen.color:=clBlack;
1821	For T:=Min To Max Do
1822	Begin
1823	X:=CoordFromPos(T);
1824	DrawLabelX;
1825	Inc(T,FFrequency-1);
1826	End;
1827	End;
1828	tsManual,tsNone:
1829	Begin
1830	Y:=Height-Diff-SliderHeight+2;
1831	Dec(Y,5);
1832
1833	Canvas.Pen.color:=clBlack;
1834	If FTickStyle=tsManual Then
1835	Begin
1836	X:=CoordFromPos(Min);
1837	DrawLabelX;
1838
1839	X:=CoordFromPos(Max);
1840	DrawLabelX;
1841	End;
1842
1843	If FTicks<>Nil Then For T:=0 To FTicks.Count-1 Do
1844	Begin
1845	X:=CoordFromPos(LongInt(FTicks[T]));
1846	DrawLabelX;
1847	End;
1848	End;
1849	End; {Case}
1850	X:=CoordFromPos(Max); // always final tick
1851	DrawLabelX;
1852	End
1853	Else
1854	Begin
1855	Case FTickStyle Of
1856	tsAuto:
1857	Begin
1858	X:=Diff-5;
1859	If SliderHeight<>12 Then Dec(X,2);
1860
1861	Canvas.Pen.color:=clBlack;
1862	For T:=Min To Max Do
1863	Begin
1864	Y:=CoordFromPos(T);
1865	DrawLabelY;
1866	Inc(T,FFrequency-1);
1867	End;
1868	End;
1869	tsManual,tsNone:
1870	Begin
1871	X:=Diff-5;
1872	If SliderHeight<>12 Then Dec(X,2);
1873
1874	Canvas.Pen.color:=clBlack;
1875	If FTickStyle=tsManual Then
1876	Begin
1877	Y:=CoordFromPos(Min);
1878	DrawLabelY;
1879
1880	Y:=CoordFromPos(Max);
1881	DrawLabelY;
1882	End;
1883
1884	If FTicks<>Nil Then For T:=0 To FTicks.Count-1 Do
1885	Begin
1886	Y:=CoordFromPos(LongInt(FTicks[T]));
1887	DrawLabelY;
1888	End;
1889	End;
1890	End; {Case}
1891	Y:=CoordFromPos(Max); // always final tick
1892	DrawLabelY;
1893	End;
1894
1895	//Erase background
1896	If HasFocus Then
1897	Begin
1898	rc:=ClientRect;
1899	Forms.InflateRect(rc,-1,-1);
1900	End
1901	Else rc:=rec;
1902	Inherited Redraw(rc);
1903
1904	If HasFocus Then If ShowFocusRect Then
1905	Begin
1906	Canvas.DeleteClipRegion;
1907	rc:=ClientRect;
1908	Canvas.DrawFocusRect(rc);
1909	End;
1910	End;
1911
1912	Procedure TTrackBar.GetSliderExtent(Var SliderWidth,SliderHeight:LongInt);
1913	Var Extent,Diff:LongInt;
1914	Label vl,L,M,S;
1915	Begin
1916	Case SliderSize Of
1917	tssAuto:
1918	Begin
1919	If Orientation=trHorizontal Then Extent:=Height
1920	Else Extent:=Width;
1921	If TickMarks=tmBoth Then Diff:=44
1922	Else If TickMarks=tmTopLeft Then Diff:=24
1923	Else If TickMarks=tmBottomRight Then Diff:=24;
1924
1925	If Extent>35+Diff Then //super large Size
1926	Begin
1927	vl:
1928	SliderWidth:=24;
1929	SliderHeight:=45;
1930	FTickSize:=12;
1931	End
1932	Else If Extent>25+Diff Then //large Size
1933	Begin
1934	L:
1935	SliderWidth:=20;
1936	SliderHeight:=38;
1937	FTickSize:=8;
1938	End
1939	Else If Extent>20+Diff Then //medium Size
1940	Begin
1941	M:
1942	SliderWidth:=16;
1943	SliderHeight:=30;
1944	FTickSize:=6;
1945	End
1946	Else //small Size
1947	Begin
1948	S:
1949	SliderWidth:=6;
1950	SliderHeight:=12;
1951	FTickSize:=3;
1952	End;
1953	End;
1954	tssVeryLarge:Goto vl;
1955	tssLarge:Goto L;
1956	tssMedium:Goto M;
1957	tssSmall:Goto S;
1958	End; {Case}
1959	End;
1960
1961	Function TTrackBar.CoordFromPos(Position:LongInt):LongInt;
1962	Var
1963	Scale:Extended;
1964	WH:LongInt;
1965	SliderWidth,SliderHeight:LongInt;
1966	Begin
1967	GetSliderExtent(SliderWidth,SliderHeight);
1968	If Orientation=trHorizontal Then WH:=Width-2
1969	Else WH:=Height-2;
1970	Dec(WH,SliderWidth);
1971	Scale:=WH/(Max-Min);
1972	Result:=Round((Position-Min)*Scale);
1973	Inc(Result,1+SliderWidth Div 2)
1974	End;
1975
1976	Function TTrackBar.PosFromCoord(Coord:LongInt):LongInt;
1977	Var
1978	Scale:Extended;
1979	WH:LongInt;
1980	SliderWidth,SliderHeight:LongInt;
1981	Begin
1982	GetSliderExtent(SliderWidth,SliderHeight);
1983	If Orientation=trHorizontal Then WH:=Width-2
1984	Else WH:=Height-2;
1985	Dec(WH,SliderWidth Div 2);
1986	Scale:=WH/(Max-Min);
1987	Result:=Min+Round((Coord-1)/Scale);
1988	End;
1989
1990	Function TTrackBar.PosInsideSlider(X,Y:LongInt):Boolean;
1991	Var SliderW,SliderH,Diff:LongInt;
1992	pts:Array[0..3] Of TPoint;
1993	Begin
1994	GetSliderExtent(SliderW,SliderH);
1995	If ((FTickMarks=tmBoth)Or(FTickMarks=tmTopLeft)) Then Diff:=20
1996	Else Diff:=2;
1997
1998	If Orientation=trHorizontal Then
1999	Begin
2000	pts[0].X:=CoordFromPos(Position)-SliderW Div 2;
2001	pts[0].Y:=Height-Diff-SliderH+2;
2002	pts[1].X:=pts[0].X+SliderW;
2003	pts[1].Y:=Height-Diff;
2004
2005	Result:=((X>=pts[0].X)And(X<=pts[1].X)And(Y>=pts[0].Y)And(Y<=pts[1].Y));
2006	End
2007	Else
2008	Begin
2009	pts[0].Y:=CoordFromPos(Position)-SliderW Div 2;
2010	pts[0].X:=Diff+2;
2011	pts[1].Y:=pts[0].Y+SliderW;
2012	pts[1].X:=pts[0].X+SliderH;
2013
2014	Result:=((X>=pts[0].X)And(X<=pts[1].X)And(Y>=pts[0].Y)And(Y<=pts[1].Y));
2015	End;
2016	End;
2017
2018	Function TTrackBar.PosInsideTrack(X,Y:LongInt):Boolean;
2019	Var SliderW,SliderH,Diff:LongInt;
2020	pts:Array[0..3] Of TPoint;
2021	Begin
2022	GetSliderExtent(SliderW,SliderH);
2023	If ((FTickMarks=tmBoth)Or(FTickMarks=tmTopLeft)) Then Diff:=20
2024	Else Diff:=2;
2025
2026	If Orientation=trHorizontal Then
2027	Begin
2028	pts[0].X:=3;
2029	pts[0].Y:=Height-Diff-((SliderH Div 3)*2);
2030	pts[1].X:=Width-3;
2031	pts[1].Y:=Height-Diff-(SliderH Div 6);
2032
2033	Result:=((X>=pts[0].X)And(X<=pts[1].X)And(Y>=pts[0].Y)And(Y<=pts[1].Y));
2034	End
2035	Else
2036	Begin
2037	pts[0].Y:=3;
2038	pts[0].X:=Diff+SliderH Div 6;
2039	pts[1].Y:=Height-3;
2040	pts[1].X:=Diff+((SliderH Div 3)*2);
2041
2042	Result:=((X>=pts[0].X)And(X<=pts[1].X)And(Y>=pts[0].Y)And(Y<=pts[1].Y));
2043	End;
2044	End;
2045
2046	Procedure TTrackBar.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
2047	Begin
2048	Inherited MouseDown(Button,ShiftState,X,Y);
2049	If Button=mbLeft Then
2050	Begin
2051	Focus;
2052	If PosInsideSlider(X,Y) Then
2053	Begin
2054	MouseCapture:=True;
2055	FTracking:=True;
2056	UpdateSlider;
2057	End
2058	Else If PosInsideTrack(X,Y) Then
2059	Begin
2060	MouseCapture:=True;
2061	FTrackTimer.Start;
2062	End;
2063	End;
2064	End;
2065
2066	Procedure TTrackBar.MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
2067	Begin
2068	Inherited MouseUp(Button,ShiftState,X,Y);
2069	If Button=mbLeft Then
2070	Begin
2071	If FTracking Then
2072	Begin
2073	MouseCapture:=False;
2074	FTracking:=False;
2075	UpdateSlider;
2076	Change;
2077	End
2078	Else
2079	Begin
2080	MouseCapture:=False;
2081	FTrackTimer.Stop;
2082	End;
2083	End;
2084	End;
2085
2086	Procedure TTrackBar.UpdateSlider;
2087	Var rc,rc1:TRect;
2088	SliderWidth,SliderHeight:LongInt;
2089	Begin
2090	If Canvas<>Nil Then
2091	Begin
2092	rc:=ClientRect;
2093	Inc(rc.Right);
2094	Inc(rc.Top);
2095
2096	rc1:=rc;
2097	GetSliderExtent(SliderWidth,SliderHeight);
2098
2099	If Orientation=trHorizontal Then
2100	Begin
2101	If ((FTickMarks=tmBoth)Or(FTickMarks=tmTopLeft)) Then Dec(rc.Top,15);
2102	If ((FTickMarks=tmBoth)Or(FTickMarks=tmBottomRight)) Then
2103	Begin
2104	rc.Bottom:=rc.Top-SliderHeight-4;
2105	If SliderHeight=45 Then Inc(rc.Bottom);
2106	End;
2107	End
2108	Else
2109	Begin
2110	If ((FTickMarks=tmBoth)Or(FTickMarks=tmTopLeft)) Then Inc(rc.Left,15);
2111	If ((FTickMarks=tmBoth)Or(FTickMarks=tmBottomRight)) Then rc.Right:=rc.Left+SliderHeight+5;
2112	End;
2113
2114	If rc.Top=rc1.Top Then Dec(rc.Top);
2115	If rc.Right=rc1.Right Then Dec(rc.Right);
2116	If rc.Left=rc1.Left Then Inc(rc.Left);
2117	If rc.Bottom=rc1.Bottom Then Inc(rc.Bottom);
2118	Canvas.ClipRect:=rc;
2119	DrawTrack(SliderWidth,SliderHeight);
2120	{?????????+-1}
2121	Dec(rc.Right);
2122	Dec(rc.Top);
2123	Canvas.FillRect(rc,color);
2124	Canvas.DeleteClipRegion;
2125	End;
2126	End;
2127
2128	Procedure TTrackBar.MouseMove(ShiftState:TShiftState;X,Y:LongInt);
2129	Var NewPos:LongInt;
2130	Begin
2131	Inherited MouseMove(ShiftState,X,Y);
2132	If FTracking Then
2133	Begin
2134	If Orientation=trHorizontal Then NewPos:=PosFromCoord(X)
2135	Else NewPos:=PosFromCoord(Y);
2136	Position:=NewPos;
2137	End;
2138	End;
2139
2140	Procedure TTrackBar.MouseClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
2141	Var C:LongInt;
2142	Begin
2143	Inherited MouseClick(Button,ShiftState,X,Y);
2144	If Button=mbLeft Then
2145	Begin
2146	If Not PosInsideSlider(X,Y) Then //If PosInsideTrack(X,Y) Then
2147	Begin
2148	C:=CoordFromPos(Position);
2149	If Orientation=trHorizontal Then
2150	Begin
2151	If C<X Then Position:=Position+PageSize
2152	Else Position:=Position-PageSize;
2153	End
2154	Else
2155	Begin
2156	If C<Y Then Position:=Position+PageSize
2157	Else Position:=Position-PageSize;
2158	End;
2159	End;
2160	End;
2161	End;
2162
2163	Procedure TTrackBar.MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
2164	Begin
2165	MouseClick(Button,ShiftState,X,Y);
2166	End;
2167
2168	Procedure TTrackBar.EvTimer(Sender:TObject);
2169	Var MPos:Array[0..0] Of TPoint;
2170	C:LongInt;
2171	SliderW,SliderH:LongInt;
2172	Begin
2173	If Sender=FTrackTimer Then
2174	Begin
2175	GetSliderExtent(SliderW,SliderH);
2176	MPos[0]:=Screen.MousePos;
2177	Screen.MapPoints(Self,MPos);
2178	C:=CoordFromPos(Position);
2179	If Not PosInsideSlider(MPos[0].X,MPos[0].Y) Then
2180	Begin
2181	If Orientation=trHorizontal Then
2182	Begin
2183	If C+SliderW<MPos[0].X Then Position:=Position+PageSize
2184	Else If C>MPos[0].X+SliderW Then Position:=Position-PageSize;
2185	End
2186	Else
2187	Begin
2188	If C+SliderW Div 2<MPos[0].Y Then Position:=Position+PageSize
2189	Else If C>MPos[0].Y+SliderW Div 2 Then Position:=Position-PageSize;
2190	End;
2191	End;
2192	End;
2193	End;
2194
2195	Procedure TTrackBar.SetFocus;
2196	Begin
2197	Inherited SetFocus;
2198	Invalidate;
2199	End;
2200
2201	Procedure TTrackBar.KillFocus;
2202	Begin
2203	Inherited KillFocus;
2204	Invalidate;
2205	End;
2206
2207	Procedure TTrackBar.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
2208	Begin
2209	Case KeyCode Of
2210	kbCLeft:If Orientation=trHorizontal Then Position:=Position-LineSize;
2211	kbCRight:If Orientation=trHorizontal Then Position:=Position+LineSize;
2212	kbCUp:If Orientation=trVertical Then Position:=Position+LineSize;
2213	kbCDown:If Orientation=trVertical Then Position:=Position-LineSize;
2214	kbPageDown:Position:=Position-PageSize;
2215	kbPageUp:Position:=Position+PageSize;
2216	Else
2217	Begin
2218	Inherited ScanEvent(KeyCode,RepeatCount);
2219	exit;
2220	End;
2221	End; //Case
2222
2223	// had a match... swallow keypress
2224	KeyCode := kbNull;
2225	End;
2226
2227	Procedure TTrackBar.SetTick(Pos:LongInt);
2228	Begin
2229	If FTicks=Nil Then FTicks.Create;
2230	FTicks.Add(Pointer(Pos));
2231	End;
2232
2233	Procedure TTrackBar.ClearTicks;
2234	Begin
2235	If FTicks<>Nil Then FTicks.Clear;
2236	End;
2237
2238	Procedure TTrackBar.BeginUpdate;
2239	Begin
2240	FUpdating:=True;
2241	End;
2242
2243	Procedure TTrackBar.EndUpdate;
2244	Begin
2245	FUpdating:=False;
2246	Invalidate;
2247	End;
2248
2249	Procedure TTrackBar.SetSliderSize(NewSize:TTrackSliderSize);
2250	Begin
2251	FSliderSize:=NewSize;
2252	If Not FUpdating Then Invalidate;
2253	End;
2254
2255	{
2256	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2257	º º
2258	º Speed-Pascal/2 Version 2.0 º
2259	º º
2260	º Speed-Pascal Component Classes (SPCC) º
2261	º º
2262	º This section: TStatusPanel Class Implementation º
2263	º º
2264	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2265	º º
2266	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2267	}
2268
2269	Function TStatusPanel.GetText:String;
2270	Begin
2271	If FText<>Nil Then Result:=FText^
2272	Else Result:='';
2273	End;
2274
2275	Procedure TStatusPanel.SetText(Const NewValue:String);
2276	Begin
2277	If FText<>Nil Then
2278	Begin
2279	If NewValue=FText^ Then Exit;
2280	FreeMem(FText,Length(FText^)+1);
2281	End;
2282
2283	GetMem(FText,Length(NewValue)+1);
2284	FText^:=NewValue;
2285	changed(False);
2286	End;
2287
2288	Procedure TStatusPanel.SetWidth(NewValue:LongInt);
2289	Begin
2290	If NewValue=FWidth Then Exit;
2291	FWidth:=NewValue;
2292	changed(True);
2293	End;
2294
2295	Procedure TStatusPanel.SetAlignment(NewValue:TAlignment);
2296	Begin
2297	If NewValue=FAlignment Then Exit;
2298	FAlignment:=NewValue;
2299	changed(False);
2300	End;
2301
2302	Procedure TStatusPanel.SetBevel(NewValue:TStatusPanelBevel);
2303	Begin
2304	If NewValue=FBevel Then Exit;
2305	FBevel:=NewValue;
2306	changed(True);
2307	End;
2308
2309	Procedure TStatusPanel.SetStyle(NewValue:TStatusPanelStyle);
2310	Begin
2311	If NewValue=FStyle Then Exit;
2312	FStyle:=NewValue;
2313	changed(False);
2314	End;
2315
2316	Constructor TStatusPanel.Create(ACollection:TCollection);
2317	Begin
2318	FBevel:=pbLowered;
2319	FAlignment:=taLeftJustify;
2320	FStyle:=psText;
2321	FWidth:=100;
2322	Inherited Create(ACollection);
2323	End;
2324
2325	Destructor TStatusPanel.Destroy;
2326	Begin
2327	If FText<>Nil Then FreeMem(FText,Length(FText^)+1);
2328
2329	Inherited Destroy;
2330	End;
2331
2332	Procedure TStatusPanel.Assign(Source:TCollectionItem);
2333	Begin
2334	If Source Is TStatusPanel Then
2335	If Source<>Self Then
2336	Begin
2337	FBevel:=TStatusPanel(Source).Bevel;
2338	FStyle:=TStatusPanel(Source).Style;
2339	FAlignment:=TStatusPanel(Source).Alignment;
2340	Width:=TStatusPanel(Source).Width;
2341	Text:=TStatusPanel(Source).Text;
2342	End;
2343	End;
2344
2345	{
2346	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2347	º º
2348	º Speed-Pascal/2 Version 2.0 º
2349	º º
2350	º Speed-Pascal Component Classes (SPCC) º
2351	º º
2352	º This section: TStatusPanels Class Implementation º
2353	º º
2354	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2355	º º
2356	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2357	}
2358
2359
2360	Function TStatusPanels.GetItem(Index:LongInt):TStatusPanel;
2361	Var dummy:TCollectionItem;
2362	Begin
2363	dummy:=Inherited GetItem(Index);
2364	Result:=TStatusPanel(dummy);
2365	End;
2366
2367	Procedure TStatusPanels.SetItem(Index:LongInt;Value:TStatusPanel);
2368	Begin
2369	Inherited SetItem(Index,Value);
2370	End;
2371
2372	Procedure TStatusPanels.Update(Item:TCollectionItem);
2373	Begin
2374	If FStatusBar=Nil Then Exit;
2375	If Item=Nil Then FStatusBar.Invalidate
2376	Else FStatusBar.UpdatePanel(TStatusPanel(Item));
2377	End;
2378
2379	Procedure TStatusPanels.SetupComponent;
2380	Begin
2381	Inherited SetupComponent;
2382
2383	Name:='StatusPanels';
2384	If Owner Is TStatusBar Then FStatusBar:=TStatusBar(Owner);
2385	ItemClass:=TStatusPanel;
2386	End;
2387
2388	Function TStatusPanels.Add:TStatusPanel;
2389	Var dummy:TCollectionItem;
2390	Begin
2391	dummy:=Inherited Add;
2392	Result:=TStatusPanel(dummy);
2393	End;
2394
2395	{
2396	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2397	º º
2398	º Speed-Pascal/2 Version 2.0 º
2399	º º
2400	º Speed-Pascal Component Classes (SPCC) º
2401	º º
2402	º This section: TStatusBar Class Implementation º
2403	º º
2404	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2405	º º
2406	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2407	}
2408
2409	Procedure TStatusBar.UpdatePanel(Panel:TStatusPanel);
2410	Var rc:TRect;
2411	T:LongInt;
2412	Begin
2413	If FSimplePanel Then
2414	Begin
2415	Invalidate;
2416	Exit;
2417	End;
2418
2419	//Get Rectangle For the Panel
2420	rc:=ClientRect;
2421	For T:=0 To FPanels.Count-1 Do
2422	Begin
2423	If FPanels[T]=Panel Then break
2424	Else Inc(rc.Left,FPanels[T].Width+FSpacing);
2425	End;
2426
2427	rc.Right:=rc.Left+Panel.Width;
2428	InvalidateRect(rc);
2429	Update;
2430	End;
2431
2432	Procedure TStatusBar.SetSimpleText(Const NewText:String);
2433	Begin
2434	FSimpleText:=NewText;
2435	If FSimplePanel Then Invalidate;
2436	End;
2437
2438	Procedure TStatusBar.SetSimplePanel(NewValue:Boolean);
2439	Begin
2440	FSimplePanel:=NewValue;
2441	{If FSimplePanel Then} Invalidate;
2442	End;
2443
2444	Procedure TStatusBar.SetPanels(NewValue:TStatusPanels);
2445	Begin
2446	FPanels.Assign(NewValue);
2447	End;
2448
2449	Procedure TStatusBar.SetSizeGrip(NewValue:Boolean);
2450	Begin
2451	FSizeGrip:=NewValue;
2452	Invalidate;
2453	End;
2454
2455	Procedure TStatusBar.SetSpacing(NewValue:LongInt);
2456	Begin
2457	If FSpacing<0 Then FSpacing:=0;
2458	FSpacing:=NewValue;
2459	Invalidate;
2460	End;
2461
2462	Procedure TStatusBar.SetupComponent;
2463	Begin
2464	Inherited SetupComponent;
2465
2466	Align:=alBottom;
2467	Name:='StatusBar';
2468	FSizeGrip:=True;
2469	FPanels.Create(Self);
2470	Height:=35;
2471	FSpacing:=2;
2472	End;
2473
2474	Destructor TStatusBar.Destroy;
2475	Begin
2476	FPanels.Destroy;
2477	Inherited Destroy;
2478	End;
2479
2480	Procedure TStatusBar.DrawPanel(Panel:TStatusPanel;Const rc:TRect);
2481	Var
2482	Align:TAlignment;
2483	S:String;
2484	Bev:TStatusPanelBevel;
2485	CX,CY,H:LongInt;
2486	RaisedColor,LoweredColor:TColor;
2487	rec:TRect;
2488	Begin
2489	If Panel=Nil Then
2490	Begin
2491	Align:=taLeftJustify;
2492	S:=FSimpleText;
2493	If Style=bsLowered Then Bev:=pbLowered
2494	Else Bev:=pbRaised;
2495	End
2496	Else
2497	Begin
2498	Align:=Panel.Alignment;
2499	S:=Panel.Text;
2500	Bev:=Panel.Bevel;
2501	End;
2502
2503	Canvas.GetTextExtent(S,CX,CY);
2504
2505	Case Align Of
2506	taLeftJustify:rec.Left:=rc.Left+3;
2507	taRightJustify:rec.Left:=rc.Right-3-CX;
2508	Else //taCenter
2509	Begin
2510	H:=rc.Right-rc.Left;
2511	rec.Left:=rc.Left+((H-CX) Div 2);
2512	End;
2513	End; //Case
2514
2515	If rec.Left<rc.Left+3 Then rec.Left:=rc.Left+3;
2516	H:=rc.Top-rc.Bottom;
2517	rec.Bottom:=rc.Bottom+((H-CY) Div 2);
2518	If rec.Bottom<rc.Bottom+3 Then rec.Bottom:=rc.Bottom+3;
2519	rec.Right:=rec.Left+CX-1;
2520	rec.Top:=rec.Bottom+CY-1;
2521
2522	Canvas.TextOut(rec.Left,rec.Bottom,S);
2523
2524	Canvas.ExcludeClipRect(rec);
2525
2526	If Bev=pbNone Then Canvas.FillRect(rc,color)
2527	Else
2528	Begin
2529	If Bev=pbRaised Then
2530	Begin
2531	RaisedColor:=clWhite;
2532	LoweredColor:=clDkGray;
2533	End
2534	Else
2535	Begin
2536	RaisedColor:=clDkGray;
2537	LoweredColor:=clWhite;
2538	End;
2539
2540	Canvas.ShadowedBorder(rc,RaisedColor,LoweredColor);
2541	rec:=rc;
2542	Forms.InflateRect(rec,-1,-1);
2543	Canvas.FillRect(rec,color)
2544	End;
2545	End;
2546
2547	Procedure TStatusBar.Redraw(Const rec:TRect);
2548	Var T:LongInt;
2549	rc,rc2:TRect;
2550	Panel:TStatusPanel;
2551	Begin
2552	Canvas.ClipRect:=rec;
2553	Canvas.Pen.color:=PenColor;
2554	Canvas.Brush.color:=color;
2555
2556	If ((FSimplePanel)Or(FPanels.Count=0)) Then
2557	Begin
2558	rc:=ClientRect;
2559	DrawPanel(Nil,rc);
2560	End
2561	Else
2562	Begin
2563	rc:=ClientRect;
2564
2565	For T:=0 To FPanels.Count-1 Do
2566	Begin
2567	Panel:=FPanels[T];
2568	If T=FPanels.Count-1 Then rc.Right:=Width-1
2569	Else rc.Right:=rc.Left+Panel.Width;
2570	If rc.Right>Width-1 Then rc.Right:=Width-1;
2571
2572	rc2:=Forms.IntersectRect(rc,rec);
2573	If Not Forms.IsRectEmpty(rc2) Then
2574	Begin
2575	Canvas.ClipRect:=rc2;
2576
2577	If Panel.Style=psOwnerDraw Then
2578	Begin
2579	If OnDrawPanel<>Nil Then OnDrawPanel(Self,Panel,rc)
2580	Else DrawPanel(Panel,rc);
2581	End
2582	Else DrawPanel(Panel,rc);
2583	End;
2584	Inc(rc.Left,Panel.Width+FSpacing);
2585	End;
2586
2587	Canvas.ClipRect:=rec;
2588	rc:=ClientRect;
2589	For T:=0 To FPanels.Count-1 Do
2590	Begin
2591	Panel:=FPanels[T];
2592	If T=FPanels.Count-1 Then rc.Right:=Width-1
2593	Else rc.Right:=rc.Left+Panel.Width;
2594	If rc.Right>Width-1 Then rc.Right:=Width-1;
2595
2596	Canvas.ExcludeClipRect(rc);
2597	Inc(rc.Left,Panel.Width+FSpacing);
2598	End;
2599
2600	Canvas.FillRect(rec,color); //Delete rest
2601	End;
2602	Canvas.DeleteClipRegion;
2603
2604	If SizeGrip Then
2605	Begin
2606	For T:=0 To 12 Do
2607	Begin
2608	Canvas.Pen.color:=clLtGray;
2609	Canvas.Line(Width-T-1,0,Width-1,T);
2610	Inc(T);
2611	Canvas.Pen.color:=clDkGray;
2612	Canvas.Line(Width-T-1,0,Width-1,T);
2613	Inc(T);
2614	Canvas.Pen.color:=clWhite;
2615	Canvas.Line(Width-T-1,0,Width-1,T);
2616	End;
2617	End;
2618	End;
2619
2620	Type
2621	PPanelItem=^TPanelItem;
2622	TPanelItem=Record
2623	Style:TStatusPanelStyle;
2624	Bevel:TStatusPanelBevel;
2625	Width:LongInt;
2626	Alignment:TAlignment;
2627	End;
2628
2629	Procedure TStatusBar.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
2630	Var
2631	Count:^LongInt;
2632	Items:PPanelItem;
2633	Panel:TStatusPanel;
2634	T:LongInt;
2635	ps:^String;
2636	Begin
2637	If ResName = rnStatusPanels Then
2638	Begin
2639	Count:=@Data;
2640	Items:=@Data;
2641	Inc(Items,4);
2642	For T:=1 To Count^ Do
2643	Begin
2644	Panel:=FPanels.Add;
2645	ps:=Pointer(Items);
2646	Panel.Text:=ps^;
2647	Inc(Items,Length(ps^)+1);
2648	Panel.Bevel:=Items^.Bevel;
2649	Panel.Style:=Items^.Style;
2650	Panel.Alignment:=Items^.Alignment;
2651	Panel.Width:=Items^.Width;
2652	Inc(Items,SizeOf(TPanelItem));
2653	End;
2654	End
2655	Else Inherited ReadSCUResource(ResName,Data,DataLen);
2656	End;
2657
2658
2659	Function TStatusBar.WriteSCUResource(Stream:TResourceStream):Boolean;
2660	Var MemStream:TMemoryStream;
2661	T:LongInt;
2662	Item:TPanelItem;
2663	Panel:TStatusPanel;
2664	S:String;
2665	Begin
2666	Result := Inherited WriteSCUResource(Stream);
2667	If Not Result Then Exit;
2668
2669	If FPanels.Count>0 Then
2670	Begin
2671	MemStream.Create;
2672	T:=FPanels.Count;
2673	MemStream.Write(T,4);
2674	For T:=0 To FPanels.Count-1 Do
2675	Begin
2676	Panel:=FPanels[T];
2677	S:=Panel.Text;
2678	MemStream.Write(S,Length(S)+1);
2679	Item.Style:=Panel.Style;
2680	Item.Bevel:=Panel.Bevel;
2681	Item.Width:=Panel.Width;
2682	Item.Alignment:=Panel.Alignment;
2683	MemStream.Write(Item,SizeOf(TPanelItem));
2684	End;
2685
2686	Result:=Stream.NewResourceEntry(rnStatusPanels,MemStream.Memory^,MemStream.Size);
2687	MemStream.Destroy;
2688	End;
2689	End;
2690
2691	// Returns true if the given X,Y position is on the
2692	// sizing grip
2693	Function TStatusBar.IsPointOnSizeGrip(X,Y:longint):Boolean;
2694	Begin
2695	Result := false;
2696	if X < (Width-16) then
2697	exit;
2698	if Y > 16 then
2699	exit;
2700	if ( X - (Width-16) ) < Y then
2701	exit;
2702	Result := true;
2703	End;
2704
2705	Procedure TStatusBar.MouseDown(Button:TMouseButton;
2706	ShiftState:TShiftState;
2707	X,Y:LongInt);
2708	Begin
2709	inherited MouseDown(Button,ShiftState,X,Y);
2710	if not IsPointOnSizeGrip(X,Y) then
2711	exit;
2712	if not ( Parent is TForm ) then
2713	exit;
2714	// tell frame window to start tracking from this position.
2715	SendMsg( TForm( Parent ).Frame.Handle,
2716	WM_TRACKFRAME,
2717	TF_BOTTOM + TF_RIGHT, // size bottom and right sides
2718	0 );
2719	End;
2720
2721	Procedure TStatusBar.MouseMove(ShiftState:TShiftState;
2722	X,Y:LongInt);
2723	Begin
2724	inherited MouseMove(ShiftState,X,Y);
2725
2726	// if mouse is over size grip
2727	if IsPointOnSizeGrip(X,Y) then
2728	// change to a sizing cursor
2729	Cursor := crSizeNWSE
2730	else
2731	// it's not, back to normal cursor
2732	Cursor := crDefault;
2733	End;
2734
2735	{
2736	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2737	º º
2738	º Speed-Pascal/2 Version 2.0 º
2739	º º
2740	º Speed-Pascal Component Classes (SPCC) º
2741	º º
2742	º This section: THeaderControl Class Implementation º
2743	º º
2744	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2745	º º
2746	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2747	}
2748
2749	Function THeaderSection.GetText:String;
2750	Begin
2751	If FText<>Nil Then Result:=FText^
2752	Else Result:='';
2753	End;
2754
2755	Procedure THeaderSection.SetText(Const NewValue:String);
2756	Begin
2757	If FText<>Nil Then
2758	Begin
2759	If FText^=NewValue Then Exit;
2760	FreeMem(FText,Length(FText^)+1);
2761	End;
2762	GetMem(FText,Length(NewValue)+1);
2763	FText^:=NewValue;
2764	changed(False);
2765	End;
2766
2767	Procedure THeaderSection.SetWidth(NewValue:LongInt);
2768	Begin
2769	If NewValue<FMinWidth Then NewValue:=FMinWidth;
2770	If NewValue>FMaxWidth Then NewValue:=FMaxWidth;
2771	If NewValue=FWidth Then Exit;
2772	FWidth:=NewValue;
2773	changed(True);
2774	End;
2775
2776	Function THeaderSection.GetLeft:LongInt;
2777	Var T:LongInt;
2778	Sections:THeaderSections;
2779	Begin
2780	Result:=0;
2781	Sections:=THeaderSections(collection);
2782	If Sections<>Nil Then For T:=0 To Index-1 Do
2783	Begin
2784	Inc(Result,Sections[T].Width+1);
2785	If Sections.FHeaderControl<>Nil Then Inc(Result,Sections.FHeaderControl.FSpacing);
2786	End;
2787	End;
2788
2789	Function THeaderSection.GetRight:LongInt;
2790	Begin
2791	Result:=Left+Width;
2792	End;
2793
2794	Procedure THeaderSection.SetStyle(NewValue:THeaderSectionStyle);
2795	Begin
2796	If NewValue=FStyle Then Exit;
2797	FStyle:=NewValue;
2798	changed(False);
2799	End;
2800
2801	Procedure THeaderSection.SetAlignment(NewValue:TAlignment);
2802	Begin
2803	If NewValue=FAlignment Then Exit;
2804	FAlignment:=NewValue;
2805	changed(False);
2806	End;
2807
2808	Procedure THeaderSection.SetMaxWidth(NewValue:LongInt);
2809	Begin
2810	If NewValue>10000 Then NewValue:=10000;
2811	If NewValue<FMinWidth Then NewValue:=FMinWidth;
2812	FMaxWidth:=NewValue;
2813	Width:=FWidth; //Update
2814	End;
2815
2816	Procedure THeaderSection.SetMinWidth(NewValue:LongInt);
2817	Begin
2818	If NewValue<0 Then NewValue:=0;
2819	If NewValue>FMaxWidth Then NewValue:=FMaxWidth;
2820	FMinWidth:=NewValue;
2821	Width:=FWidth; //Update
2822	End;
2823
2824	Constructor THeaderSection.Create(ACollection:TCollection);
2825	Begin
2826	FWidth:=100;
2827	FMinWidth:=0;
2828	FMaxWidth:=10000;
2829	FAlignment:=taLeftJustify;
2830	FStyle:=hsText;
2831	FAllowClick:=True;
2832	FAllowSize:=True;
2833	Inherited Create(ACollection);
2834	End;
2835
2836	Destructor THeaderSection.Destroy;
2837	Begin
2838	If FText<>Nil Then FreeMem(FText,Length(FText^)+1);
2839
2840	Inherited Destroy;
2841	End;
2842
2843	Procedure THeaderSection.Assign(Source:TCollectionItem);
2844	Begin
2845	If Source Is THeaderSection Then
2846	If Source<>Self Then
2847	Begin
2848	FMinWidth:=THeaderSection(Source).MinWidth;
2849	FMaxWidth:=THeaderSection(Source).MaxWidth;
2850	FAlignment:=THeaderSection(Source).Alignment;
2851	FStyle:=THeaderSection(Source).Style;
2852	FAllowClick:=THeaderSection(Source).AllowClick;
2853	FAllowSize:=THeaderSection(Source).AllowSize;
2854	Width:=THeaderSection(Source).Width;
2855	Text:=THeaderSection(Source).Text;
2856	End;
2857	End;
2858
2859	{
2860	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2861	º º
2862	º Speed-Pascal/2 Version 2.0 º
2863	º º
2864	º Speed-Pascal Component Classes (SPCC) º
2865	º º
2866	º This section: THeaderSections Class Implementation º
2867	º º
2868	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2869	º º
2870	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2871	}
2872
2873	Function THeaderSections.GetItem(Index:LongInt):THeaderSection;
2874	Var dummy:TCollectionItem;
2875	Begin
2876	dummy:=Inherited GetItem(Index);
2877	Result:=THeaderSection(dummy);
2878	End;
2879
2880	Procedure THeaderSections.SetItem(Index:LongInt;NewValue:THeaderSection);
2881	Begin
2882	Inherited SetItem(Index,NewValue);
2883	End;
2884
2885	Procedure THeaderSections.Update(Item:TCollectionItem);
2886	Begin
2887	If FHeaderControl=Nil Then Exit;
2888	If Item=Nil Then FHeaderControl.Invalidate
2889	Else FHeaderControl.UpdateHeader(THeaderSection(Item));
2890	End;
2891
2892	Procedure THeaderSections.SetupComponent;
2893	Begin
2894	Inherited SetupComponent;
2895
2896	Name:='HeaderSections';
2897	If Owner Is THeaderControl Then FHeaderControl:=THeaderControl(Owner);
2898	ItemClass:=THeaderSection;
2899	End;
2900
2901	Function THeaderSections.Add:THeaderSection;
2902	Var dummy:TCollectionItem;
2903	Begin
2904	dummy:=Inherited Add;
2905	Result:=THeaderSection(dummy);
2906	End;
2907
2908	{
2909	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2910	º º
2911	º Speed-Pascal/2 Version 2.0 º
2912	º º
2913	º Speed-Pascal Component Classes (SPCC) º
2914	º º
2915	º This section: THeaderControl Class Implementation º
2916	º º
2917	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2918	º º
2919	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2920	}
2921
2922	Function THeaderControl.GetSections:THeaderSections;
2923	Begin
2924	If FSections=Nil Then FSections:=FSectionsClass.Create(Self);
2925	Result:=FSections;
2926	End;
2927
2928	Procedure THeaderControl.SetSections(NewValue:THeaderSections);
2929	Begin
2930	Sections.Assign(NewValue);
2931	End;
2932
2933	Procedure THeaderControl.UpdateHeader(Header:THeaderSection);
2934	Var T:LongInt;
2935	rc:TRect;
2936	Begin
2937	//Get Rectangle For the Panel
2938	rc:=ClientRect;
2939	If FSections<>Nil Then
2940	For T:=0 To FSections.Count-1 Do
2941	Begin
2942	If FSections[T]=Header Then break
2943	Else Inc(rc.Left,FSections[T].Width+FSpacing+1);
2944	End;
2945
2946	rc.Right:=rc.Left+Header.Width;
2947	InvalidateRect(rc);
2948	Update;
2949	End;
2950
2951	{$HINTS OFF}
2952	Procedure THeaderControl.DrawSection(section:THeaderSection;Const rc:TRect;Pressed:Boolean);
2953	Var
2954	Align:TAlignment;
2955	S:String;
2956	CX,CY,H:LongInt;
2957	rec:TRect;
2958	PointsArray:Array[0..5] Of TPoint;
2959	offs:LongInt;
2960	Begin
2961	Align:=section.Alignment;
2962	S:=section.Text;
2963
2964	Canvas.GetTextExtent(S,CX,CY);
2965
2966	Case Align Of
2967	taLeftJustify:rec.Left:=rc.Left+3;
2968	taRightJustify:rec.Left:=rc.Right-3-CX;
2969	Else //taCenter
2970	Begin
2971	H:=rc.Right-rc.Left;
2972	rec.Left:=rc.Left+((H-CX) Div 2);
2973	End;
2974	End; //Case
2975
2976	If rec.Left<rc.Left+3 Then rec.Left:=rc.Left+3;
2977	H:=rc.Top-rc.Bottom;
2978	rec.Bottom:=rc.Bottom+((H-CY) Div 2);
2979	If rec.Bottom<rc.Bottom+3 Then rec.Bottom:=rc.Bottom+3;
2980	rec.Right:=rec.Left+CX-1;
2981	rec.Top:=rec.Bottom+CY-1;
2982
2983	Canvas.TextOut(rec.Left,rec.Bottom,S);
2984
2985	Canvas.ExcludeClipRect(rec);
2986
2987	If BevelWidth > 1 Then
2988	Begin
2989	offs := BevelWidth-1;
2990	PointsArray[0] := Point(rc.Left,rc.Bottom);
2991	PointsArray[1] := Point(rc.Left+offs,rc.Bottom+offs);
2992	PointsArray[2] := Point(rc.Left+offs,rc.Top-offs);
2993	PointsArray[3] := Point(rc.Right-offs,rc.Top-offs);
2994	PointsArray[4] := Point(rc.Right,rc.Top);
2995	PointsArray[5] := Point(rc.Left,rc.Top);
2996	Canvas.Pen.color := clWhite;
2997	Canvas.Polygon(PointsArray);
2998	PointsArray[2] := Point(rc.Right-offs,rc.Bottom+offs);
2999	PointsArray[3] := Point(rc.Right-offs,rc.Top-offs);
3000	PointsArray[4] := Point(rc.Right,rc.Top);
3001	PointsArray[5] := Point(rc.Right,rc.Bottom);
3002	Canvas.Pen.color := clDkGray;
3003	Canvas.Polygon(PointsArray);
3004	Canvas.Pen.color:=PenColor;
3005	End
3006	Else Canvas.ShadowedBorder(rc,clWhite,clDkGray);
3007
3008	rec:=rc;
3009	Forms.InflateRect(rec,-BevelWidth,-BevelWidth);
3010	Canvas.FillRect(rec,color)
3011	End;
3012	{$HINTS ON}
3013
3014
3015	Procedure THeaderControl.Redraw(Const rec:TRect);
3016	Var T:LongInt;
3017	rc,rc2:TRect;
3018	section:THeaderSection;
3019	IsPressed:Boolean;
3020	PointsArray:Array[0..5] Of TPoint;
3021	offs:LongInt;
3022	Begin
3023	Canvas.Brush.color:=color;
3024	Canvas.Pen.color:=PenColor;
3025
3026	rc:=ClientRect;
3027	Inc(rc.Bottom);
3028	If FSections<>Nil Then For T:=0 To FSections.Count-1 Do
3029	Begin
3030	section:=FSections[T];
3031	rc.Right:=rc.Left+section.Width;
3032	If rc.Right>Width-1 Then rc.Right:=Width-1;
3033
3034	IsPressed:=section=FClickSection;
3035	If IsPressed Then
3036	Begin
3037	Inc(rc.Left);
3038	Inc(rc.Right);
3039	Dec(rc.Bottom);
3040	Dec(rc.Top);
3041	End;
3042
3043	rc2:=Forms.IntersectRect(rc,rec);
3044	If Not Forms.IsRectEmpty(rc2) Then
3045	Begin
3046	Canvas.ClipRect:=rc2;
3047
3048	If section.Style=hsOwnerDraw Then
3049	Begin
3050	If OnDrawSection<>Nil Then OnDrawSection(Self,section,rc,IsPressed)
3051	Else DrawSection(section,rc,IsPressed);
3052	End
3053	Else DrawSection(section,rc,IsPressed);
3054	End;
3055
3056	If IsPressed Then
3057	Begin
3058	Dec(rc.Left);
3059	Dec(rc.Right);
3060	Inc(rc.Bottom);
3061	Inc(rc.Top);
3062	End;
3063	Inc(rc.Left,section.Width+FSpacing+1);
3064	End;
3065
3066	//Draw rest Bevel
3067	If FSections<>Nil Then If ((rc.Left<Width)And(FSections.Count>0)) Then
3068	Begin
3069	rc.Right:=Width-1;
3070	rc2:=Forms.IntersectRect(rc,rec);
3071	If Not Forms.IsRectEmpty(rc2) Then
3072	Begin
3073	Canvas.ClipRect:=rc2;
3074
3075	If BevelWidth > 1 Then
3076	Begin
3077	offs := BevelWidth-1;
3078	PointsArray[0] := Point(rc.Left,rc.Bottom);
3079	PointsArray[1] := Point(rc.Left+offs,rc.Bottom+offs);
3080	PointsArray[2] := Point(rc.Left+offs,rc.Top-offs);
3081	PointsArray[3] := Point(rc.Right-offs,rc.Top-offs);
3082	PointsArray[4] := Point(rc.Right,rc.Top);
3083	PointsArray[5] := Point(rc.Left,rc.Top);
3084	Canvas.Pen.color := clWhite;
3085	Canvas.Polygon(PointsArray);
3086	PointsArray[2] := Point(rc.Right-offs,rc.Bottom+offs);
3087	PointsArray[3] := Point(rc.Right-offs,rc.Top-offs);
3088	PointsArray[4] := Point(rc.Right,rc.Top);
3089	PointsArray[5] := Point(rc.Right,rc.Bottom);
3090	Canvas.Pen.color := clDkGray;
3091	Canvas.Polygon(PointsArray);
3092	Canvas.Pen.color:=PenColor;
3093	End
3094	Else Canvas.ShadowedBorder(rc,clWhite,clDkGray);
3095
3096	Forms.InflateRect(rc,-BevelWidth,-BevelWidth);
3097	Canvas.FillRect(rc,color);
3098	End;
3099	End;
3100
3101	Canvas.ClipRect:=rec;
3102	rc:=ClientRect;
3103	Inc(rc.Bottom);
3104	If FSections<>Nil Then For T:=0 To FSections.Count-1 Do
3105	Begin
3106	section:=FSections[T];
3107	rc.Right:=rc.Left+section.Width;
3108	If rc.Right>Width-1 Then rc.Right:=Width-1;
3109
3110	IsPressed:=section=FClickSection;
3111	If IsPressed Then
3112	Begin
3113	Inc(rc.Left);
3114	Inc(rc.Right);
3115	Dec(rc.Bottom);
3116	Dec(rc.Top);
3117	End;
3118
3119	Canvas.ExcludeClipRect(rc);
3120	Inc(rc.Left,section.Width+FSpacing+1);
3121	End;
3122
3123	//Draw rest Bevel
3124	If FSections<>Nil Then If ((rc.Left<Width)And(FSections.Count>0)) Then
3125	Begin
3126	rc.Right:=Width-1;
3127	Canvas.ExcludeClipRect(rc);
3128	End;
3129
3130
3131	Canvas.FillRect(rec,color); //Delete rest
3132	Canvas.DeleteClipRegion;
3133	End;
3134
3135	Type
3136	PHeaderItem=^THeaderItem;
3137	THeaderItem=Record
3138	Style:THeaderSectionStyle;
3139	Width:LongInt;
3140	MinWidth,MaxWidth:LongInt;
3141	AllowClick,AllowSize:Boolean;
3142	Alignment:TAlignment;
3143	End;
3144
3145
3146	Procedure THeaderControl.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
3147	Var
3148	Count:^LongInt;
3149	Items:PHeaderItem;
3150	section:THeaderSection;
3151	T:LongInt;
3152	ps:^String;
3153	Begin
3154	If ResName = rnHeaders Then
3155	Begin
3156	Count:=@Data;
3157	Items:=@Data;
3158	Inc(Items,4);
3159	For T:=1 To Count^ Do
3160	Begin
3161	Section:=Sections.Add;
3162	ps:=Pointer(Items);
3163	section.Text:=ps^;
3164	Inc(Items,Length(ps^)+1);
3165	section.Style:=Items^.Style;
3166	section.Alignment:=Items^.Alignment;
3167	section.Width:=Items^.Width;
3168	section.MinWidth:=Items^.MinWidth;
3169	section.MaxWidth:=Items^.MaxWidth;
3170	section.AllowClick:=Items^.AllowClick;
3171	section.AllowSize:=Items^.AllowSize;
3172	Inc(Items,SizeOf(THeaderItem));
3173	End;
3174	End
3175	Else Inherited ReadSCUResource(ResName,Data,DataLen);
3176	End;
3177
3178
3179	Function THeaderControl.WriteSCUResource(Stream:TResourceStream):Boolean;
3180	Var MemStream:TMemoryStream;
3181	T:LongInt;
3182	Item:THeaderItem;
3183	section:THeaderSection;
3184	S:String;
3185	Begin
3186	Result := Inherited WriteSCUResource(Stream);
3187	If Not Result Then Exit;
3188
3189	If FSections<>Nil Then If FSections.Count>0 Then
3190	Begin
3191	MemStream.Create;
3192	T:=FSections.Count;
3193	MemStream.Write(T,4);
3194	For T:=0 To FSections.Count-1 Do
3195	Begin
3196	section:=FSections[T];
3197	S:=section.Text;
3198	MemStream.Write(S,Length(S)+1);
3199	Item.Style:=section.Style;
3200	Item.Width:=section.Width;
3201	Item.MinWidth:=section.MinWidth;
3202	Item.MaxWidth:=section.MaxWidth;
3203	Item.AllowClick:=section.AllowClick;
3204	Item.AllowSize:=section.AllowSize;
3205	Item.Alignment:=section.Alignment;
3206	MemStream.Write(Item,SizeOf(THeaderItem));
3207	End;
3208
3209	Result:=Stream.NewResourceEntry(rnHeaders,MemStream.Memory^,MemStream.Size);
3210	MemStream.Destroy;
3211	End;
3212	End;
3213
3214	Procedure THeaderControl.SectionClick(section:THeaderSection);
3215	Begin
3216	If FOnSectionClick<>Nil Then FOnSectionClick(Self,section);
3217	End;
3218
3219	Procedure THeaderControl.SectionResize(section:THeaderSection);
3220	Begin
3221	If FOnSectionResize<>Nil Then FOnSectionResize(Self,section);
3222	End;
3223
3224	Procedure THeaderControl.SectionTrack(section:THeaderSection;Width:LongInt;State:TSectionTrackState);
3225	Begin
3226	If FOnSectionTrack<>Nil Then FOnSectionTrack(Self,section,Width,State);
3227	End;
3228
3229	Procedure THeaderControl.SetSpacing(NewValue:LongInt);
3230	Begin
3231	If NewValue<0 Then NewValue:=0;
3232	FSpacing:=NewValue;
3233	Invalidate;
3234	End;
3235
3236	Procedure THeaderControl.SetBevelWidth(NewValue:LongInt);
3237	Begin
3238	If NewValue<1 Then NewValue:=1;
3239	If NewValue>20 Then NewValue:=20;
3240	FBevelWidth:=NewValue;
3241	Invalidate;
3242	End;
3243
3244	Procedure THeaderControl.SetupComponent;
3245	Begin
3246	Inherited SetupComponent;
3247
3248	Align:=alTop;
3249	color:=clDlgWindow;
3250	Name:='HeaderControl';
3251	FSectionsClass:=THeaderSections;
3252	Height:=50;
3253	FSpacing:=1;
3254	FSectionTrackState:=tsTrackEnd;
3255	FBevelWidth:=1;
3256	HandlesDesignMouse:=True;
3257	Include(ComponentState,csAcceptsControls);
3258	FShape:=crDefault;
3259	End;
3260
3261	Destructor THeaderControl.Destroy;
3262	Begin
3263	If FSections<>Nil Then FSections.Destroy;
3264	Inherited Destroy;
3265	End;
3266
3267	Procedure THeaderControl.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
3268	Var T:LongInt;
3269	section:THeaderSection;
3270	Begin
3271	Inherited MouseDown(Button,ShiftState,X,Y);
3272
3273	If Button <> mbLeft Then Exit;
3274
3275	If FSections<>Nil Then For T:=0 To FSections.Count-1 Do
3276	Begin
3277	section:=FSections[T];
3278	If ((section.AllowSize)And(X>section.Right-2)And(X<section.Right+2)) Then
3279	Begin
3280	Cursor:=crHSplit;
3281	FShape:=crHSplit;
3282	LastMsg.Handled:=True; {dont pass To Form Editor}
3283	Canvas.Pen.Mode:=pmNot;
3284	Canvas.Pen.color:=clBlack;
3285	FSizeSection:=section;
3286	FSizeStartX:=section.Right;
3287	FSizeX:=FSizeStartX;
3288	Canvas.Line(FSizeX,0,FSizeX,Height);
3289	MouseCapture:=True;
3290	Canvas.Pen.Mode:=pmCopy;
3291	FSectionTrackState:=tsTrackBegin;
3292	If OnSectionTrack<>Nil Then OnSectionTrack(Self,FSizeSection,FSizeX-FSizeSection.Left,
3293	FSectionTrackState);
3294	Exit;
3295	End;
3296	End;
3297
3298	If Designed Then Exit;
3299
3300	//Test Press
3301	section:=GetMouseHeader(X,Y);
3302	If section<>Nil Then If section.AllowClick Then
3303	Begin
3304	FClickBase:=section;
3305	FClickSection:=section;
3306	UpdateHeader(section);
3307	MouseCapture:=True;
3308	End;
3309	End;
3310
3311	Function THeaderControl.GetMouseHeader(X,Y:LongInt):THeaderSection;
3312	Var T:LongInt;
3313	section:THeaderSection;
3314	Begin
3315	Result:=Nil;
3316	If FSections<>Nil Then For T:=0 To FSections.Count-1 Do
3317	Begin
3318	section:=FSections[T];
3319	If ((Y>1)And(Y<Height-1)And(X>section.Left+1)And(X<section.Right-1)) Then
3320	Begin
3321	Result:=section;
3322	Exit;
3323	End;
3324	End;
3325	End;
3326
3327	Procedure THeaderControl.MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
3328	Var section:THeaderSection;
3329	Begin
3330	Inherited MouseDblClick(Button,ShiftState,X,Y);
3331
3332	If Button=mbLeft Then
3333	Begin
3334	section:=GetMouseHeader(X,Y);
3335	If section<>Nil Then If section.AllowClick Then
3336	Begin
3337	FClickSection:=section;
3338	UpdateHeader(section);
3339	Delay(20);
3340	FClickSection:=Nil;
3341	UpdateHeader(section);
3342	If OnSectionClick<>Nil Then OnSectionClick(Self,section);
3343	End;
3344	End;
3345	End;
3346
3347	Procedure THeaderControl.MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
3348	Var ClickHeader:THeaderSection;
3349	Begin
3350	Inherited MouseUp(Button,ShiftState,X,Y);
3351
3352	If Button <> mbLeft Then Exit;
3353
3354	If FSectionTrackState In [tsTrackBegin,tsTrackMove] Then
3355	Begin
3356	LastMsg.Handled:=True; {dont pass To Form Editor}
3357	Canvas.Pen.Mode:=pmNot;
3358	Canvas.Pen.color:=clBlack;
3359	{Delete old rubberline}
3360	Canvas.Line(FSizeX,0,FSizeX,Height);
3361	MouseCapture:=False;
3362	Cursor:=crDefault;
3363	FShape:=crDefault;
3364	Canvas.Pen.Mode:=pmCopy;
3365
3366	If FSizeX<FSizeSection.Left Then FSizeX:=FSizeSection.Left;
3367
3368	FSizeSection.Width:=FSizeX-FSizeSection.Left;
3369
3370	FSectionTrackState:=tsTrackEnd;
3371	If OnSectionTrack<>Nil Then OnSectionTrack(Self,FSizeSection,FSizeSection.Width,
3372	FSectionTrackState);
3373	FSizeSection:=Nil;
3374	End;
3375
3376	If FClickBase<>Nil Then
3377	Begin
3378	ClickHeader:=GetMouseHeader(X,Y);
3379	MouseCapture:=False;
3380	If ClickHeader=FClickBase Then //clicked
3381	Begin
3382	FClickSection:=Nil;
3383	FClickBase:=Nil;
3384	UpdateHeader(ClickHeader);
3385	If OnSectionClick<>Nil Then OnSectionClick(Self,ClickHeader);
3386	End
3387	Else
3388	Begin
3389	ClickHeader:=FClickBase;
3390	FClickSection:=Nil;
3391	FClickBase:=Nil;
3392	UpdateHeader(ClickHeader);
3393	End;
3394	End;
3395	End;
3396
3397	Procedure THeaderControl.MouseMove(ShiftState:TShiftState;X,Y:LongInt);
3398	Var T:LongInt;
3399	section:THeaderSection;
3400	Begin
3401	Inherited MouseMove(ShiftState,X,Y);
3402
3403	If FSectionTrackState In [tsTrackBegin,tsTrackMove] Then
3404	Begin
3405	LastMsg.Handled:=True; {dont pass To Form Editor}
3406	Canvas.Pen.Mode:=pmNot;
3407	Canvas.Pen.color:=clBlack;
3408	{Delete old rubberline}
3409	Canvas.Line(FSizeX,0,FSizeX,Height);
3410	{Draw New Line}
3411	FSizeX:=X;
3412	If FSizeX<FSizeSection.Left Then FSizeX:=FSizeSection.Left;
3413	If FSizeX>=Width Then FSizeX:=Width;
3414	Canvas.Line(FSizeX,0,FSizeX,Height);
3415	Canvas.Pen.Mode:=pmCopy;
3416
3417	FSectionTrackState:=tsTrackMove;
3418	If OnSectionTrack<>Nil Then OnSectionTrack(Self,FSizeSection,FSizeX-FSizeSection.Left,
3419	FSectionTrackState);
3420	Exit;
3421	End
3422	Else
3423	Begin
3424	If FClickBase<>Nil Then
3425	Begin
3426	section:=GetMouseHeader(X,Y);
3427	If section<>FClickSection Then
3428	Begin
3429	If FClickSection<>Nil Then
3430	Begin
3431	section:=FClickSection;
3432	FClickSection:=Nil;
3433	If section<>Nil Then UpdateHeader(section);
3434	End
3435	Else
3436	Begin
3437	If section=FClickBase Then
3438	Begin
3439	FClickSection:=section;
3440	If FClickSection<>Nil Then UpdateHeader(FClickSection);
3441	End;
3442	End;
3443	End;
3444	End
3445	Else
3446	Begin
3447	If FSections<>Nil Then For T:=0 To FSections.Count-1 Do
3448	Begin
3449	section:=FSections[T];
3450	If ((section.AllowSize)And(X>section.Right-2)And(X<section.Right+2)) Then
3451	Begin
3452	FShape:=crHSplit;
3453	{$IFDEF OS2}
3454	WinSetPointer(HWND_DESKTOP,Screen.Cursors[FShape]);
3455	{$ENDIF}
3456	{$IFDEF Win95}
3457	SetClassWord(Handle,-12{GCW_HCURSOR},0);
3458	SetCursor(Screen.Cursors[FShape]);
3459	{$ENDIF}
3460	LastMsg.Handled:=True; {dont pass To Form Editor}
3461	Exit;
3462	End;
3463	End;
3464	End;
3465	End;
3466
3467	If FShape<>crDefault Then
3468	Begin
3469	FShape:=crDefault;
3470
3471	{$IFDEF OS2}
3472	WinSetPointer(HWND_DESKTOP,Screen.Cursors[FShape]);
3473	{$ENDIF}
3474	{$IFDEF Win95}
3475	SetClassWord(Handle,-12{GCW_HCURSOR},0);
3476	SetCursor(Screen.Cursors[FShape]);
3477	{$ENDIF}
3478	End;
3479	End;
3480
3481	Function THeader.GetSectionWidth(Index:LongInt):LongInt;
3482	Begin
3483	Result:=Sections.Items[Index].Width;
3484	End;
3485
3486	Procedure THeader.SetSectionWidth(Index:LongInt;NewValue:LongInt);
3487	Begin
3488	Sections.Items[Index].Width:=NewValue;
3489	End;
3490
3491	Begin
3492	End.
3493
3494
3495

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format