Class TWBar (unit Wbar)

Inherits from

TCustomControl

Constructors


constructor Create(AOwner: TComponent);



Functions

procedure CopyToClipboard;

******************* Public Procedures & Functions

destructor Destroy;

To avoid the flicker on repaint

function GetSeriesColor(Series: Integer): TColor;


function GetSeriesName(Series: Integer): String;


function GetSeriesWeight(Series: Integer): Integer;


function GetTop: Integer;

Lets the person know how many points to offset the top of the WBar to get the top of the painted bar

procedure SetExactWeight(Series: Integer; Value: Integer);

No check to confirm series sum=1000, use with caution, - always setting all series so that sum=1000.

procedure SetSeriesColor(Series: Integer; Color: TColor);

Execute the OnWeightChange event - only if the total is correctly summed

procedure SetSeriesName(Series: Integer; Name: String);


procedure SetSeriesWeight(Series: Integer; Value: Integer);

Sets the weight of one series and adjusts the rest propotionately to make series sum = 1000

function CalculatePoint(y:Integer): Integer;

Provides vertical back point in perspective given the front of the trapezoid} {Assumes a vanishing point of Width points to the NE of the top of the bar

procedure delay(milliseconds: integer);

*************************** Utility Functions

procedure FDisplayNames(Display: Boolean);


procedure FDisplayPercent(Display: Boolean);

Adjust for rounding errors

procedure FSetBackGroundColor(Color: TColor);


procedure FSetDepthDivisor(Value: Integer);

******************* Property Setting Procedures

procedure FSetSelected(Series: Integer);


procedure FSetSeriesCount(Value: Integer);


function GetNextSeries(Direction: Boolean):Integer;


procedure IncreaseBtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

*************************** Button Procedures

procedure IncreaseBtnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

If button is still down - keep executing until button comes up - like a keyboard key

procedure paint;

************************* Drawing Procedures

procedure PaintBars(Bar: TBitmap);

The nasty painting of the bars proc

procedure PaintLabels(Bar: TBitmap; ypos, SeriesHeight,x: Integer);

Draw the 3d part Note: Calculatepoint proc provides the adjustment for perspective

procedure ShowWBarDlg;

******************* Dialog Section

procedure WMKeyDown(var Key: TWMKey);

Execute the Arrow key Commands

procedure WMKeyUp(var Key: TWMKey);

Stop the arrow key commands

procedure WMLButtonDown(var WMMouse: TWMMouse);

Select the correct series

procedure WMMouseMove(var WMMouse: TWMMouse);

Set the cursor

procedure WMRButtonDown(var WMMouse: TWMMouse);

Open the WBar Dialog

procedure WMSetCursor(var ACursor: TWMSetCursor);


procedure WMSize(var WMSize: TWMSize);

*************************** Message Handlers *******************************} {Position the buttons

procedure WM_GetDlgCode(var code: TWMGetDlgCode);

Allow Component to capture the Arrow key key presses

Properties

property BackgroundColor : TColor


property Cursor :


property DepthDivisor : Integer


property DragMode :


property Enabled :


property Font :


property HelpContext :


property ParentFont :


property Selected : Integer


property SeriesCount : Integer


property ShowHint :


property ShowPercent : Boolean


property ShowSeriesNames : Boolean


property TabStop :


property Tag :


property Visible :


Events

event OnBtnDown : TNotifyEvent


event OnBtnUp : TNotifyEvent


event OnClick :


event OnDragDrop :


event OnDragOver :


event OnEndDrag :


event OnEnter :


event OnExit :


event OnKeyPress :


event OnMouseDown :


event OnMouseMove :


event OnMouseUp :


event OnSelect : TSelect


event OnWeightChange : TWeightChange


Variables

BtnDown : boolean;


CopyClip : Boolean;


Data : PData;


DecreaseBtn : TBitBtn;


FBackgroundColor : TColor;


FDepthDivisor : Integer;


FOnBtnDown : TNotifyEvent;


FOnBtnUp : TNotifyEvent;


FOnSelect : TSelect;


FOnWeightChange : TWeightChange;


FSelected : Integer;


FSeriesCount : Integer;


FShowPercent : Boolean;


FShowSeriesNames : Boolean;


IncreaseBtn : TBitBtn;


KeyDelay : integer;


KeyRepeat : integer;


WBarCursor : TCursor;



Constructors


constructor Create(AOwner: TComponent);


Functions


procedure CopyToClipboard;

******************* Public Procedures & Functions


destructor Destroy;

To avoid the flicker on repaint


function GetSeriesColor(Series: Integer): TColor;


function GetSeriesName(Series: Integer): String;


function GetSeriesWeight(Series: Integer): Integer;


function GetTop: Integer;

Lets the person know how many points to offset the top of the WBar to get the top of the painted bar


procedure SetExactWeight(Series: Integer; Value: Integer);

No check to confirm series sum=1000, use with caution, - always setting all series so that sum=1000. Used to set multiple series at once


procedure SetSeriesColor(Series: Integer; Color: TColor);

Execute the OnWeightChange event - only if the total is correctly summed


procedure SetSeriesName(Series: Integer; Name: String);


procedure SetSeriesWeight(Series: Integer; Value: Integer);

Sets the weight of one series and adjusts the rest propotionately to make series sum = 1000


function CalculatePoint(y:Integer): Integer;

Provides vertical back point in perspective given the front of the trapezoid} {Assumes a vanishing point of Width points to the NE of the top of the bar


procedure delay(milliseconds: integer);

*************************** Utility Functions


procedure FDisplayNames(Display: Boolean);


procedure FDisplayPercent(Display: Boolean);

Adjust for rounding errors


procedure FSetBackGroundColor(Color: TColor);


procedure FSetDepthDivisor(Value: Integer);

******************* Property Setting Procedures


procedure FSetSelected(Series: Integer);


procedure FSetSeriesCount(Value: Integer);


function GetNextSeries(Direction: Boolean):Integer;


procedure IncreaseBtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

*************************** Button Procedures


procedure IncreaseBtnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

If button is still down - keep executing until button comes up - like a keyboard key


procedure paint;

************************* Drawing Procedures


procedure PaintBars(Bar: TBitmap);

The nasty painting of the bars proc


procedure PaintLabels(Bar: TBitmap; ypos, SeriesHeight,x: Integer);

Draw the 3d part Note: Calculatepoint proc provides the adjustment for perspective


procedure ShowWBarDlg;

******************* Dialog Section


procedure WMKeyDown(var Key: TWMKey);

Execute the Arrow key Commands


procedure WMKeyUp(var Key: TWMKey);

Stop the arrow key commands


procedure WMLButtonDown(var WMMouse: TWMMouse);

Select the correct series


procedure WMMouseMove(var WMMouse: TWMMouse);

Set the cursor


procedure WMRButtonDown(var WMMouse: TWMMouse);

Open the WBar Dialog


procedure WMSetCursor(var ACursor: TWMSetCursor);


procedure WMSize(var WMSize: TWMSize);

*************************** Message Handlers *******************************} {Position the buttons


procedure WM_GetDlgCode(var code: TWMGetDlgCode);

Allow Component to capture the Arrow key key presses


Properties


property BackgroundColor : TColor


property Cursor :


property DepthDivisor : Integer


property DragMode :


property Enabled :


property Font :


property HelpContext :


property ParentFont :


property Selected : Integer


property SeriesCount : Integer


property ShowHint :


property ShowPercent : Boolean


property ShowSeriesNames : Boolean


property TabStop :


property Tag :


property Visible :


Events


event OnBtnDown : TNotifyEvent


event OnBtnUp : TNotifyEvent


event OnClick :


event OnDragDrop :


event OnDragOver :


event OnEndDrag :


event OnEnter :


event OnExit :


event OnKeyPress :


event OnMouseDown :


event OnMouseMove :


event OnMouseUp :


event OnSelect : TSelect


event OnWeightChange : TWeightChange


Variables


BtnDown : boolean;


CopyClip : Boolean;


Data : PData;


DecreaseBtn : TBitBtn;


FBackgroundColor : TColor;


FDepthDivisor : Integer;


FOnBtnDown : TNotifyEvent;


FOnBtnUp : TNotifyEvent;


FOnSelect : TSelect;


FOnWeightChange : TWeightChange;


FSelected : Integer;


FSeriesCount : Integer;


FShowPercent : Boolean;


FShowSeriesNames : Boolean;


IncreaseBtn : TBitBtn;


KeyDelay : integer;


KeyRepeat : integer;


WBarCursor : TCursor;