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