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 |
|
---|
11 | Unit LED;
|
---|
12 |
|
---|
13 | InterFace
|
---|
14 |
|
---|
15 | {$r Led}
|
---|
16 |
|
---|
17 | Uses
|
---|
18 | Classes, StdCtrls, Graphics, Forms;
|
---|
19 |
|
---|
20 | {$M+}
|
---|
21 |
|
---|
22 | Type
|
---|
23 | TLedColor = (lRed, lGreen, lYellow, lBlue);
|
---|
24 |
|
---|
25 | {$M-}
|
---|
26 |
|
---|
27 | Type
|
---|
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 |
|
---|
49 | Implementation
|
---|
50 |
|
---|
51 | Destructor TLed.Destroy;
|
---|
52 | Var
|
---|
53 | I: Integer;
|
---|
54 | Begin
|
---|
55 | For I := 0 to 7 do FBitMaps[I].Free;
|
---|
56 | Inherited Destroy;
|
---|
57 | End;
|
---|
58 |
|
---|
59 | Procedure TLed.SetCondition (Condition: Boolean);
|
---|
60 | Begin
|
---|
61 | FCondition := Condition;
|
---|
62 | Invalidate;
|
---|
63 | End;
|
---|
64 |
|
---|
65 | Procedure TLed.SetLedColor (LedColor: TLedColor);
|
---|
66 | Begin
|
---|
67 | FLedColor := LedColor;
|
---|
68 | Invalidate;
|
---|
69 | End;
|
---|
70 |
|
---|
71 | Procedure TLed.SetupComponent;
|
---|
72 | Begin
|
---|
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');
|
---|
94 | End;
|
---|
95 |
|
---|
96 | Procedure TLed.Show;
|
---|
97 | Begin
|
---|
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;
|
---|
113 | End;
|
---|
114 |
|
---|
115 | Procedure TLed.Redraw;
|
---|
116 | Begin
|
---|
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;
|
---|
131 | End;
|
---|
132 |
|
---|
133 | Begin
|
---|
134 | RegisterClasses ([TLed]);
|
---|
135 | End.
|
---|