[7] | 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.
|
---|