home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibylft1.zip / SAMPLES.DAT / SAMPLES / SEVENSEG / SEVEN.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-17  |  2KB  |  97 lines
  1. unit Seven;
  2. {***********************************************************************************
  3.  *                                                                                 *
  4.  * SpeedSoft Sibyl sample component "SevenSeg"                                     *
  5.  *                                                                                 *
  6.  * This addon component implements a seven segment control.                        *
  7.  * After compilation you can add this component using Component|Install from       *
  8.  * the main menu. Note that the resource script must also be compiled.             *
  9.  * This component was written by Joerg Pleumann                                    *
  10.  *                                                                                 *
  11.  ***********************************************************************************}
  12.  
  13. interface
  14.  
  15. {$r Seven}
  16.  
  17. uses
  18.   Classes, Forms, Buttons, StdCtrls, Graphics;
  19.  
  20. type
  21.   TSevenSegDisplay = class(TControl)
  22.   private
  23.     FDigit: Byte;
  24.     FBitmaps: array[0..9] of TBitmap;
  25.  
  26.     procedure SetDigit(NewDigit: Byte);
  27.  
  28.   public
  29.     destructor Destroy; override;
  30.  
  31.     procedure Redraw(const rec: TRect); override;
  32.     procedure SetupComponent; override;
  33.     procedure Show; override;
  34.  
  35.   published
  36.  
  37.     property Digit: Byte read FDigit write SetDigit;
  38.   end;
  39.  
  40. exports
  41.   TSevenSegDisplay, 'User', 'Seven.Bmp';
  42.  
  43. implementation
  44.  
  45. destructor TSevenSegDisplay.Destroy;
  46. var
  47.   N: Integer;
  48. begin
  49.   for N := 0 to 9 do FBitmaps[N].Free;
  50.   inherited Destroy;
  51. end;
  52.  
  53. procedure TSevenSegDisplay.SetDigit(NewDigit: Byte);
  54. begin
  55.   if (NewDigit >= 0) and (NewDigit <= 9) then
  56.   begin
  57.     FDigit := NewDigit;
  58.     Invalidate;
  59.   end;
  60. end;
  61.  
  62. procedure TSevenSegDisplay.SetupComponent;
  63. var
  64.   N: Integer;
  65. begin
  66.   inherited SetupComponent;
  67.  
  68.   Caption := 'SevenSegDisplay';
  69.   Name := Caption;
  70.   Width := 16;
  71.   Height := 24;
  72.  
  73.   for N := 0 to 9 do
  74.   begin
  75.     FBitmaps[N].Create(Self);
  76.     FBitmaps[N].LoadFromResourceName('Digit'+tostr(N));
  77.   end;
  78. end;
  79.  
  80. procedure TSevenSegDisplay.Show;
  81. begin
  82.   FBitmaps[FDigit].RealizePalette(Canvas);
  83.   inherited Show;
  84. end;
  85.  
  86. {$HINTS OFF}
  87. procedure TSevenSegDisplay.Redraw(const rec: TRect);
  88. begin
  89.   if (FDigit >= 0) and (FDigit <= 9) then
  90.     Canvas.StretchDraw(0, 0, Width, Height, FBitmaps[FDigit]);
  91. end;
  92. {$HINTS ON}
  93.  
  94. begin
  95.   RegisterClasses([TSevenSegDisplay]);
  96. end.
  97.