-
Notifications
You must be signed in to change notification settings - Fork 17
/
customgauge.pas
119 lines (107 loc) · 3.23 KB
/
customgauge.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
{
This unit defines a custom Gauge descendant which improves the visibility
of the background. The background is what tells the end user the state
of the test run.
Copyright (c) 2011 by Graeme Geldenhuys
All rights reserved.
}
unit CustomGauge;
{$mode objfpc}{$H+}
interface
uses
fpg_base, fpg_main, fpg_gauge;
type
TGUIRunnerGauge = class(TfpgBaseGauge)
protected
procedure BarDraw; override;
procedure BackgroundDraw; override;
published
property Align;
property Anchors;
property BorderStyle;
property Color;
property Enabled;
property FirstColor;
property Hint;
property Kind;
property MaxValue;
property MinValue;
property ParentShowHint;
property Progress;
property SecondColor;
property ShowHint;
property ShowText;
property Visible;
property OnShowHint;
end;
implementation
{ TGUIRunnerGauge }
procedure TGUIRunnerGauge.BarDraw;
var
BarLength: Longint;
SavedRect: TfpgRect;
begin
SavedRect := FClientRect; // save client rect for text !!
with FClientRect do
begin
case FKind of
gkHorizontalBar:
begin
{ now paint as normal }
BarLength := Longint(Trunc( (Width * Percentage) / 100.0 ) );
if BarLength > 0 then
begin
if BarLength > Width then
BarLength := Width;
Width := BarLength;
// left top
Canvas.SetColor(fpgLighter(Color, 45));
Canvas.DrawLine(Left, Bottom, Left, Top); // left
Canvas.DrawLine(Left, Top, Right, Top); // top
// right bottom
Canvas.SetColor(fpgDarker(Color, 45));
Canvas.DrawLine(Right, Top, Right, Bottom); // right
Canvas.DrawLine(Right, Bottom, Left, Bottom); // bottom
// inside gradient fill
InflateRect(FClientRect, -1, -1);
Canvas.GradientFill(FClientRect, Color, fpgLighter(Color, 45), gdVertical);
end; { if }
FClientRect := SavedRect;
end;
gkVerticalBar:
begin
inherited BarDraw;
end;
end; { case }
end; { FClientRect }
end;
procedure TGUIRunnerGauge.BackgroundDraw;
begin
FClientRect.SetRect(0, 0, Width, Height);
with FClientRect do
begin
{ Kind specific Bacground }
case FKind of
{ Currently Text doesn't require additional Bacground }
{ And so horizontal and vertical bar - Unless style requires it}
gkHorizontalBar:
begin
{Client area is Widget area, to start with}
Canvas.ClearClipRect;
Canvas.Clear(TfpgColor($c4c4c4));
{ This must be adjusted according the selected style }
Canvas.SetColor(TfpgColor($999999));
Canvas.SetLineStyle(1, lsSolid);
Canvas.DrawRectangle(FClientRect);
{ This must be completed and adjusted with border style }
InflateRect(FClientRect, -1, -1);
Canvas.SetLineStyle(1, lsSolid); // just in case background changed that
end;
else
begin
inherited BackgroundDraw;
end;
end;
end; { with }
end;
end.