source: branches/2.20_branch/Sibyl/Addon/LED.PAS

Last change on this file was 7, checked in by RBRi, 19 years ago

+ sibyl staff

  • Property svn:eol-style set to native
File size: 3.5 KB
Line 
1{ ********************************* }
2{ * Sibyl Component * }
3{ * TLed * }
4{ * * }
5{ * written by Michael Kroll * }
6{ * 25.11.1996 * }
7{ * * }
8{ * Fido: 2:2448/136.16 * }
9{ ********************************* }
10
11Unit LED;
12
13InterFace
14
15{$r Led}
16
17Uses
18 Classes, StdCtrls, Graphics, Forms;
19
20{$M+}
21
22Type
23 TLedColor = (lRed, lGreen, lYellow, lBlue);
24
25{$M-}
26
27Type
28 TLed = Class (TControl)
29 Private
30 FCondition: Boolean;
31 FLedColor: TLedColor;
32 FBitmaps: Array [0..7] of TBitmap;
33
34 Procedure SetCondition (Condition: Boolean);
35 Procedure SetLedColor (LedColor: TLedColor);
36
37 Public
38 Destructor Destroy; Override;
39
40 Procedure Redraw (Const Rec: TRect); Override;
41 Procedure SetupComponent; Override;
42 Procedure Show; Override;
43
44 Published
45 Property LedCondition: Boolean Read FCondition Write SetCondition;
46 Property LedColor: TLedColor Read FLedColor Write SetLedColor;
47 End;
48
49Implementation
50
51Destructor TLed.Destroy;
52Var
53 I: Integer;
54Begin
55 For I := 0 to 7 do FBitMaps[I].Free;
56 Inherited Destroy;
57End;
58
59Procedure TLed.SetCondition (Condition: Boolean);
60Begin
61 FCondition := Condition;
62 Invalidate;
63End;
64
65Procedure TLed.SetLedColor (LedColor: TLedColor);
66Begin
67 FLedColor := LedColor;
68 Invalidate;
69End;
70
71Procedure TLed.SetupComponent;
72Begin
73 Inherited SetupComponent;
74 Caption := 'Led';
75 Name := Caption;
76 Width := 15;
77 Height := 15;
78 FBitMaps[0].Create;
79 FBitmaps[0].LoadFromResourceName ('RedOn');
80 FBitMaps[1].Create;
81 FBitmaps[1].LoadFromResourceName ('RedOff');
82 FBitMaps[2].Create;
83 FBitmaps[2].LoadFromResourceName ('GrOn');
84 FBitMaps[3].Create;
85 FBitmaps[3].LoadFromResourceName ('GrOff');
86 FBitMaps[4].Create;
87 FBitmaps[4].LoadFromResourceName ('YwOn');
88 FBitMaps[5].Create;
89 FBitmaps[5].LoadFromResourceName ('YwOff');
90 FBitMaps[6].Create;
91 FBitmaps[6].LoadFromResourceName ('BlOn');
92 FBitMaps[7].Create;
93 FBitmaps[7].LoadFromResourceName ('BlOff');
94End;
95
96Procedure TLed.Show;
97Begin
98 Inherited Show;
99 If FCondition = True then
100 Begin
101 If FLedColor = lRed then FBitMaps[0].RealizePalette (Canvas);
102 If FLedColor = lGreen then FBitMaps[2].RealizePalette (Canvas);
103 If FLedColor = lYellow then FBitMaps[4].RealizePalette (Canvas);
104 If FLedColor = lBlue then FBitMaps[6].RealizePalette (Canvas);
105 End
106 Else If FCondition = False then
107 Begin
108 If FLedColor = lRed then FBitMaps[1].RealizePalette (Canvas);
109 If FLedColor = lGreen then FBitMaps[3].RealizePalette (Canvas);
110 If FLedColor = lYellow then FBitMaps[5].RealizePalette (Canvas);
111 If FLedColor = lBlue then FBitMaps[7].RealizePalette (Canvas);
112 End;
113End;
114
115Procedure TLed.Redraw;
116Begin
117 If FCondition = True then
118 Begin
119 If FLedColor = lRed then Canvas.StretchDraw (0, 0, Width, Height, FBitmaps[0]);
120 If FLedColor = lGreen then Canvas.StretchDraw (0, 0, Width, Height, FBitmaps[2]);
121 If FLedColor = lYellow then Canvas.StretchDraw (0, 0, Width, Height, FBitmaps[4]);
122 If FLedColor = lBlue then Canvas.StretchDraw (0, 0, Width, Height, FBitmaps[6]);
123 End
124 Else
125 Begin
126 If FLedColor = lRed then Canvas.StretchDraw (0, 0, Width, Height, FBitmaps[1]);
127 If FLedColor = lGreen then Canvas.StretchDraw (0, 0, Width, Height, FBitmaps[3]);
128 If FLedColor = lYellow then Canvas.StretchDraw (0, 0, Width, Height, FBitmaps[5]);
129 If FLedColor = lBlue then Canvas.StretchDraw (0, 0, Width, Height, FBitmaps[7]);
130 End;
131End;
132
133Begin
134 RegisterClasses ([TLed]);
135End.
Note: See TracBrowser for help on using the repository browser.