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