home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d12456 / LCD99.ZIP / Lcd99 / Lcd99.pas < prev   
Pascal/Delphi Source File  |  2001-08-12  |  31KB  |  939 lines
  1. unit Lcd99;
  2.  
  3. {  LCD display component written by Jonathan Hosking, August 2001.
  4.  
  5.    Get future component updates from the following address
  6.    Website: http://www.the-hoskings.freeserve.co.uk/
  7.  
  8.    Send any bugs, suggestions, etc to the following Email
  9.    Email: jonathan@the-hoskings.freeserve.co.uk
  10.  
  11.    Thanks to Jean Pierre for helping with the drawing routines
  12.    Email: jean-pierre.cocatrix@vx.cit.alcatel.fr
  13.  
  14.    Thanks to Daniel Szasz for implementing support for colon characters
  15.    Email: daniel@mindcti.com
  16.  
  17.    Thanks to Alan Warriner for implementing double buffering, the
  18.    animation preview feature, and improving the animation delays
  19.    Email: alan.warriner@bigfoot.com
  20.  
  21.    Thanks to Mike Heydon for implementing the numeric value routines
  22.    and OnChange event.
  23.    Email: mheydon@eoh.co.za  }
  24.  
  25. interface
  26.  
  27. uses
  28.   {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  29.   Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  30.   Menus;
  31.  
  32. type
  33.   TLCDScale = 1..100;
  34.   TLCDAnimation = (anNone, anSpiral, anUp, anDown, anLeft, anRight, anRandom);
  35.   TLCDAbout = (abNone,abAbout);
  36.   TLCDChangeProc = procedure(Sender: TObject; OldValue, NewValue: string) of object;
  37.   TLCD99 = class(TCustomControl)
  38.   private
  39.     { Private declarations }
  40.     fAbout: TLCDAbout;
  41.     fAnimation: TLCDAnimation;
  42.     fAnimationDelay: Integer;
  43.     fBufferBM: TBitmap;
  44.     fDigitNum: Integer;
  45.     fDigitSpacing: Integer;
  46.     fDoBuffer:Boolean;
  47.     fDotDisplay: Boolean;
  48.     fDotSpacing: Integer;
  49.     fDoubleBuffer: Boolean;
  50.     fGapX: Integer;
  51.     fGapY: Integer;
  52.     fIsChanging: Boolean;
  53.     fIsPainting: Boolean;
  54.     fOffColor: TColor;
  55.     fOldValue: String;
  56.     fOnChange: TLCDChangeProc;
  57.     fOnColor: TColor;
  58.     fPaintDuration: {$IFDEF WIN32}DWord{$ELSE}Longint{$ENDIF};
  59.     fPreview: Boolean;
  60.     fSegmentSize: Integer;
  61.     fValue: String;
  62.     fWorkCanvas: TCanvas;
  63.     procedure SetAnimation(Val: TLCDAnimation);
  64.     procedure SetAnimationDelay(Val: Integer);
  65.     procedure SetDigitNum(Val: Integer);
  66.     procedure SetDigitSpacing(Val: Integer);
  67.     procedure SetDotDisplay(Val: Boolean);
  68.     procedure SetDotSpacing(Val: Integer);
  69.     procedure SetDoubleBuffer(Val: Boolean);
  70.     procedure SetGapX(Val: Integer);
  71.     procedure SetGapY(Val: Integer);
  72.     procedure SetOffColor(Val: TColor);
  73.     procedure SetOnColor(Val: TColor);
  74.     procedure SetSegmentSize(Val: Integer);
  75.     procedure SetPreview(Val: Boolean);
  76.     procedure SetValue(Val: String);
  77.     procedure ShowAbout(Val: TLCDAbout);
  78.     procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message wm_EraseBkgnd;
  79.   protected
  80.     { Protected declarations }
  81.     procedure Paint; override;
  82.   public
  83.     { Public declarations }
  84.     constructor Create(AOwner: TComponent); override;
  85.     procedure SetNumericValue(NewValue: Integer);
  86.     function GetNumericValue: Integer;
  87.   published
  88.     { Published declarations }
  89.     property About: TLCDAbout read fAbout write ShowAbout default abNone;
  90.     property Align;
  91.     property Animation: TLCDAnimation read fAnimation write SetAnimation default anNone;
  92.     property AnimationDelay: Integer read fAnimationDelay write SetAnimationDelay default 0;
  93.     property Color;
  94.     property DigitNum: Integer read fDigitNum write SetDigitNum default 1;
  95.     property DigitSpacing: Integer read fDigitSpacing write SetDigitSpacing default 5;
  96.     property DotDisplay: Boolean read fDotDisplay write SetDotDisplay default False;
  97.     property DotSpacing: Integer read fDotSpacing write SetDotSpacing default 2;
  98.     property DoubleBuffer: Boolean read fDoubleBuffer write SetDoubleBuffer default True;
  99.     property DragCursor;
  100.     property DragMode;
  101.     property Enabled;
  102.     property GapX: Integer read fGapX write SetGapX default 2;
  103.     property GapY: Integer read fGapY write SetGapY default 2;
  104.     property IsPainting: Boolean read fIsPainting;
  105.     property OffColor: TColor read fOffColor write SetOffColor default clBlack;
  106.     property OnColor: TColor read fOnColor write SetOnColor default clLime;
  107.     property PaintDuration: {$IFDEF WIN32}DWord{$ELSE}Longint{$ENDIF} read fPaintDuration;
  108.     property ParentShowHint;
  109.     property PopupMenu;
  110.     property Preview: Boolean read fPreview write SetPreview default False;
  111.     property SegmentSize: Integer read fSegmentSize write SetSegmentSize default 2;
  112.     property ShowHint;
  113.     property Value: String read fValue write SetValue;
  114.     property Visible;
  115.     property OnChange: TLCDChangeProc read fOnChange write fOnChange;
  116.     property OnClick;
  117.     property OnDblClick;
  118.     property OnDragDrop;
  119.     property OnDragOver;
  120.     property OnEndDrag;
  121.     property OnMouseDown;
  122.     property OnMouseMove;
  123.     property OnMouseUp;
  124.   end;
  125.  
  126. procedure Register;
  127.  
  128. implementation
  129.  
  130. { TLCD99 }
  131.  
  132. const
  133.   CopyRightStr: PChar = 'TLCD Component v1.81 (12/08/2001)'+#13+#13+
  134.     'By Jonathan Hosking'+#13+#13+
  135.     'Compiled in '+
  136.     {$IFDEF VER80}  'Delphi 1.0' {$ENDIF}
  137.     {$IFDEF VER90}  'Delphi 2.0' {$ENDIF}
  138.     {$IFDEF VER100} 'Delphi 3.0' {$ENDIF}
  139.     {$IFDEF VER120} 'Delphi 4.0' {$ENDIF}
  140.     {$IFDEF VER130} 'Delphi 5.0' {$ENDIF}
  141.     {$IFDEF VER140} 'Delphi 6.0' {$ENDIF}
  142.     {$IFDEF VER93}  'C++Builder 1.0' {$ENDIF}
  143.     {$IFDEF VER110} 'C++Builder 3.0' {$ENDIF}
  144.     {$IFDEF VER125} 'C++Builder 4.0' {$ENDIF};
  145.  
  146.   { ---1---    This next array stores the digits (0 - 36)
  147.     |     |    and the segments (1 - 7).  The diagram on
  148.     2  8  3    the left shows the layout of the segments.
  149.     |     |    A 1 enables the segment, while a 0 will
  150.     ---4---    turn the segment off.  An 8 will display
  151.     |     |    a colon.
  152.     5  8  6
  153.     |     |
  154.     ---7--- }
  155.  
  156.   LCDDisplayData: Array[0..37,1..8] of integer =
  157.                     { Numbers, minus sign and colon }
  158.                     ((1,1,1,0,1,1,1,0),(0,0,1,0,0,1,0,0),(1,0,1,1,1,0,1,0),
  159.                     (1,0,1,1,0,1,1,0),(0,1,1,1,0,1,0,0),(1,1,0,1,0,1,1,0),
  160.                     (1,1,0,1,1,1,1,0),(1,0,1,0,0,1,0,0),(1,1,1,1,1,1,1,0),
  161.                     (1,1,1,1,0,1,1,0),(0,0,0,1,0,0,0,0),(0,0,0,0,0,0,0,1),
  162.                     { Letters of the alphabet }
  163.                     (1,1,1,1,1,1,0,0),(0,1,0,1,1,1,1,0),(1,1,0,0,1,0,1,0),
  164.                     (0,0,1,1,1,1,1,0),(1,1,0,1,1,0,1,0),(1,1,0,1,1,0,0,0),
  165.                     (1,1,0,1,1,1,1,0),(0,1,0,1,1,1,0,0),(0,0,1,0,0,1,0,0),
  166.                     (0,0,1,0,0,1,1,0),(0,1,1,1,1,1,0,0),(0,1,0,0,1,0,1,0),
  167.                     (0,0,0,1,1,1,0,0),(0,0,0,1,1,1,0,0),(0,0,0,1,1,1,1,0),
  168.                     (1,1,1,1,1,0,0,0),(1,1,1,1,0,1,0,0),(0,0,0,1,1,0,0,0),
  169.                     (1,1,0,1,0,1,1,0),(0,1,0,1,1,0,0,0),(0,1,1,0,1,1,1,0),
  170.                     (0,1,1,0,1,1,1,0),(0,1,1,0,1,1,1,0),(0,1,1,1,1,1,0,0),
  171.                     (0,1,1,1,0,1,0,0),(1,0,1,1,1,0,1,0));
  172.  
  173.   { This array stores the animation details, starting at anSpiral }
  174.   LCDAnimationData: Array[1..5,1..8] of integer =
  175.                       ((8,4,2,1,3,6,7,5),(7,6,5,8,4,3,2,1),
  176.                       (1,2,3,8,4,5,6,7),(6,3,7,8,4,1,5,2),
  177.                       (2,5,1,8,4,7,3,6));
  178.  
  179. var
  180.   CopyRightPtr: Pointer;
  181.  
  182. { Thanks to Mike Heydon for this routine }
  183. procedure TLCD99.SetNumericValue(NewValue: Integer);
  184. begin
  185.   Value := IntToStr(NewValue);
  186.   Invalidate;
  187. end;
  188.  
  189. { Thanks to Mike Heydon for this routine }
  190. function TLCD99.GetNumericValue: Integer;
  191. begin
  192.   Result := StrToIntDef(Value, 0);
  193. end;
  194.  
  195. constructor TLCD99.Create(AOwner: TComponent);
  196. begin
  197.   { Setup the control }
  198.   Inherited Create(AOwner);
  199.   ControlStyle:=ControlStyle+[csOpaque];
  200.   CopyRightPtr := @CopyRightStr;
  201.   Color := clBlack;
  202.   fAbout := abNone;
  203.   fAnimation := anNone;
  204.   fAnimationDelay := 0;
  205.   fBufferBM := nil;
  206.   fDigitNum := 4;
  207.   fDigitSpacing := 5;
  208.   fDotDisplay := False;
  209.   fDotSpacing := 2;
  210.   fDoubleBuffer := True;
  211.   fGapX := 2;
  212.   fGapY := 2;
  213.   fIsChanging := False;
  214.   fIsPainting := False;
  215.   fOffColor := clBlack;
  216.   fOnColor := clLime;
  217.   fPaintDuration := 0;
  218.   fPreview := False;
  219.   fSegmentSize := 2;
  220.   fOldValue := '';
  221.   fValue := '';
  222.   Width := 92;
  223.   Height := 34;
  224. end;
  225.  
  226. procedure TLCD99.SetAnimation(Val: TLCDAnimation);
  227. begin
  228.   { The control doesn't need updating here }
  229.   if fAnimation <> Val then
  230.     fAnimation := Val;
  231. end;
  232.  
  233. procedure TLCD99.SetAnimationDelay(Val: Integer);
  234. begin
  235.   { The control doesn't need updating here }
  236.   if fAnimationDelay <> Val then
  237.     fAnimationDelay := Val;
  238. end;
  239.  
  240. procedure TLCD99.SetDigitNum(Val: Integer);
  241. begin
  242.   if fDigitNum <> Val then
  243.   begin
  244.     fDigitNum := Val;
  245.     Invalidate;
  246.   end;
  247. end;
  248.  
  249. procedure TLCD99.SetDigitSpacing(Val: Integer);
  250. begin
  251.   if fDigitSpacing <> Val then
  252.   begin
  253.     fDigitSpacing := Val;
  254.     Invalidate;
  255.   end;
  256. end;
  257.  
  258. procedure TLCD99.SetDotDisplay(Val: Boolean);
  259. begin
  260.   if fDotDisplay <> Val then
  261.   begin
  262.     fDotDisplay := Val;
  263.     Invalidate;
  264.   end;
  265. end;
  266.  
  267. procedure TLCD99.SetDotSpacing(Val: Integer);
  268. begin
  269.   if fDotSpacing <> Val then
  270.   begin
  271.     fDotSpacing := Val;
  272.     Invalidate;
  273.   end;
  274. end;
  275.  
  276. procedure TLCD99.SetDoubleBuffer(Val: Boolean);
  277. begin
  278.   if fDoubleBuffer <> Val then
  279.   begin
  280.     fDoubleBuffer := Val;
  281.     Invalidate;
  282.   end;
  283. end;
  284.  
  285. procedure TLCD99.SetGapX(Val: Integer);
  286. begin
  287.   if fGapX <> Val then
  288.   begin
  289.     fGapX := Val;
  290.     Invalidate;
  291.   end;
  292. end;
  293.  
  294. procedure TLCD99.SetGapY(Val: Integer);
  295. begin
  296.   if fGapY <> Val then
  297.   begin
  298.     fGapY := Val;
  299.     Invalidate;
  300.   end;
  301. end;
  302.  
  303. procedure TLCD99.SetOffColor(Val: TColor);
  304. begin
  305.   if fOffColor <> Val then
  306.   begin
  307.     fOffColor := Val;
  308.     Invalidate;
  309.   end;
  310. end;
  311.  
  312. procedure TLCD99.SetOnColor(Val: TColor);
  313. begin
  314.   if fOnColor <> Val then
  315.   begin
  316.     fOnColor := Val;
  317.     Invalidate;
  318.   end;
  319. end;
  320.  
  321. procedure TLCD99.SetSegmentSize(Val: Integer);
  322. begin
  323.   if fSegmentSize <> Val then
  324.   begin
  325.     fSegmentSize := Val;
  326.     Invalidate;
  327.   end;
  328. end;
  329.  
  330. procedure TLCD99.SetPreview(Val: Boolean);
  331. begin
  332.   if fPreview <> Val then
  333.   begin
  334.     fPreview := Val;
  335.     Invalidate;
  336.   end;
  337. end;
  338.  
  339. { Thanks to Mike Heydon for the OnChange event code }
  340. procedure TLCD99.SetValue(Val: String);
  341. var
  342.   Count: Integer;
  343.   Invalid: Boolean;
  344. begin
  345.   if fValue <> Val then
  346.   begin
  347.     { For this bit, we check the validity of the string }
  348.     Invalid := False;
  349.     if Val <> '' then
  350.       for Count := 1 to length(Val) do
  351.       begin
  352.         Val[Count] := Upcase(Val[Count]);
  353.         if not(((Val[Count] >= '0') and (Val[Count] <= '9')) or
  354.           (Val[Count] = '-') or (Val[Count] = ' ') or (Val[Count] = '.') or
  355.           ((Val[Count] >= 'A') and (Val[Count] <= 'Z')) or
  356.           (Val[Count] = ':')) then
  357.             Invalid := True;
  358.       end;
  359.     if Invalid then Val := '';
  360.     { We don't allow decimal points on the end of the value }
  361.     if (Val <> '') and (Val[length(Val)] = '.') then Delete(Val,length(Val),1);
  362.     fValue := Val;
  363.     { Trigger on change event }
  364.     if Assigned(fOnChange) then fOnChange(Self, fValue, Val);
  365.     { Turn on animation }
  366.     fIsChanging:=true;
  367.     Invalidate;
  368.   end;
  369. end;
  370.  
  371. procedure TLCD99.ShowAbout(Val: TLCDAbout);
  372. begin
  373.   if fAbout <> Val then
  374.   begin
  375.     if Val = abNone then fAbout := Val else
  376.     begin
  377.       fAbout := abNone;
  378.       MessageDlg(StrPas(CopyRightStr), mtInformation, [mbOk], 0);
  379.     end;
  380.     Invalidate;
  381.   end;
  382. end;
  383.  
  384. procedure TLCD99.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  385. begin
  386.    Message.Result := 1;
  387. end;
  388.  
  389. { Thanks to Alan Warriner for adding double buffering, animation
  390.   previews, and improved animation delays }
  391. procedure TLCD99.Paint;
  392. var
  393.   AnimationNo, SegmentNo: Byte;
  394.   tmp,tmp2,tmp3,tmp4: string;
  395.   PaintStart,FirstTickCount:{$IFDEF WIN32}DWord{$ELSE}Longint{$ENDIF};
  396.   AValue, HG, HH, HW, Spacing, tmpDelay, VG, VH, VW: Integer;
  397.  
  398. { Draw a vertical segment - Thanks to Jean Pierre for his help }
  399. procedure DrawVerticalSegment(StartX,StartY,XSpace,YSpace: Integer; SColor:TColor);
  400. var
  401.   BeginAt,Count,HalfY,NextAt,TheSpace: Integer;
  402.   DotOk: Boolean;
  403.   Seg: Integer;
  404.   SegData: Array[0..7] of Integer;
  405. begin
  406.   with fWorkCanvas do
  407.   begin
  408.     Brush.Color := SColor;
  409.     Pen.Color := SColor;
  410.     if fDotDisplay then
  411.     begin
  412.       { Draw a dotted segment }
  413.       for Count := 0 to 7 do SegData[Count] := LCDDisplayData[AValue,Count];
  414.       Seg := SegData[SegmentNo];
  415.       TheSpace := fSegmentSize;
  416.       if YSpace < 0 then
  417.         TheSpace := -(TheSpace);
  418.       BeginAt := StartX;
  419.       while BeginAt < (StartX + XSpace) do
  420.       begin
  421.         { Some dots may be shared by segments, so we shouldn't overwrite them
  422.           by accident }
  423.         DotOk := True;
  424.         NextAt := BeginAt + fSegmentSize + fDotSpacing;
  425.         if Seg = 0 then
  426.           case SegmentNo of
  427.             1: if ((BeginAt = StartX) and (SegData[2] = 1)) or
  428.                  ((NextAt >= StartX + XSpace) and (SegData[3] = 1))
  429.                    then DotOk := False;
  430.             7: if ((BeginAt = StartX) and (SegData[5] = 1)) or
  431.                  ((NextAt >= StartX + XSpace) and (SegData[6] = 1))
  432.                    then DotOk := False;
  433.         end;
  434.         { Draw the dot }
  435.         if DotOk then Ellipse(BeginAt,StartY,BeginAt+fSegmentSize,StartY+TheSpace);
  436.         Inc(BeginAt,fSegmentSize + fDotSpacing);
  437.       end;
  438.     end
  439.     else
  440.     begin
  441.       { Draw a normal segment }
  442.       HalfY := StartY + round(YSpace/4);
  443.       Polygon([Point(StartX,HalfY),
  444.                Point(StartX+(HW div 2),StartY),
  445.                Point((StartX+XSpace)-(HW div 2),StartY),
  446.                Point(StartX+XSpace,HalfY),
  447.                Point((StartX+XSpace)-HW,StartY+YSpace),
  448.                Point(StartX+HW,StartY+YSpace),
  449.                Point(StartX,HalfY)]);
  450.     end;
  451.   end;
  452. end;
  453.  
  454. { Draw the centre segment }
  455. procedure DrawCenterSegment(StartX,StartY,XSpace,YSpace: Integer; SColor:TColor);
  456. var
  457.   BeginAt,Count,HalfY,NextAt: Integer;
  458.   DotOk: Boolean;
  459.   Seg: Integer;
  460.   SegData: Array[0..7] of Integer;
  461. begin
  462.   with fWorkCanvas do
  463.   begin
  464.     Brush.Color := SColor;
  465.     Pen.Color := SColor;
  466.     if fDotDisplay then
  467.     begin
  468.       { Draw a dotted segment }
  469.       for Count := 0 to 7 do SegData[Count] := LCDDisplayData[AValue,Count];
  470.       Seg := SegData[SegmentNo];
  471.       BeginAt := StartX;
  472.       while BeginAt < (StartX + XSpace) do
  473.       begin
  474.         { Some dots may be shared by segments, so we shouldn't overwrite them
  475.           by accident }
  476.         DotOk := True;
  477.         NextAt := BeginAt + fSegmentSize + fDotSpacing;
  478.         if (Seg = 0) and (((BeginAt = StartX) and ((SegData[2] = 1) or (SegData[5] = 1))) or
  479.           ((NextAt >= StartX + XSpace) and ((SegData[3] = 1) or (SegData[6] = 1))))
  480.             then DotOk := False;
  481.         { Draw the dot }
  482.         if DotOk then Ellipse(BeginAt,StartY,BeginAt+fSegmentSize,StartY+fSegmentSize);
  483.         Inc(BeginAt,fSegmentSize + fDotSpacing);
  484.       end;
  485.     end
  486.     else
  487.     begin
  488.       { Draw a normal segment }
  489.       HalfY := StartY + round(YSpace/2);
  490.       Polygon([Point(StartX,HalfY),
  491.                Point(StartX+HW,StartY),
  492.                Point((StartX+XSpace)-HW,StartY),
  493.                Point(StartX+XSpace,HalfY),
  494.                Point((StartX+XSpace)-HW,StartY+YSpace),
  495.                Point(StartX+HW,StartY+YSpace),
  496.                Point(StartX,HalfY)]);
  497.     end;
  498.   end;
  499. end;
  500.  
  501. { Draw a horizontal segment - Thanks to Jean Pierre for his help }
  502. procedure DrawHorizontalSegment(StartX,StartY,XSpace,YSpace: Integer; SColor:TColor);
  503. var
  504.   BeginAt,Count,HalfX,NextAt,TheSpace: Integer;
  505.   DotOk: Boolean;
  506.   Seg: Integer;
  507.   SegData: Array[0..7] of Integer;
  508. begin
  509.   with fWorkCanvas do
  510.   begin
  511.     Brush.Color := SColor;
  512.     Pen.Color := SColor;
  513.     if fDotDisplay then
  514.     begin
  515.       { Draw a dotted segment }
  516.       for Count := 0 to 7 do SegData[Count] := LCDDisplayData[AValue,Count];
  517.       Seg := SegData[SegmentNo];
  518.       TheSpace := fSegmentSize;
  519.       if XSpace < 0 then
  520.         TheSpace := -(TheSpace);
  521.       BeginAt := StartY;
  522.       while BeginAt < (StartY + YSpace) do
  523.       begin
  524.         { Some dots may be shared by segments, so we shouldn't overwrite them
  525.           by accident }
  526.         DotOk := True;
  527.         NextAt := BeginAt + fSegmentSize + fDotSpacing;
  528.         if Seg = 0 then
  529.           case SegmentNo of
  530.             2: if ((BeginAt = StartY) and (SegData[1] = 1)) or
  531.                  ((NextAt >= StartY + YSpace) and ((SegData[4] = 1) or (SegData[5] = 1)))
  532.                    then DotOk := False;
  533.             3: if ((BeginAt = StartY) and (SegData[1] = 1)) or
  534.                  ((NextAt >= StartY + YSpace) and ((SegData[4] = 1) or (SegData[6] = 1)))
  535.                    then DotOk := False;
  536.             5: if ((BeginAt = StartY) and ((SegData[2] = 1) or (SegData[4] = 1))) or
  537.                  ((NextAt >= StartY + YSpace) and (SegData[7] = 1))
  538.                    then DotOk := False;
  539.             6: if ((BeginAt = StartY) and ((SegData[3] = 1) or (SegData[4] = 1))) or
  540.                  ((NextAt >= StartY + YSpace) and (SegData[7] = 1))
  541.                    then DotOk := False;
  542.         end;
  543.         { Draw the dot }
  544.         if DotOk then Ellipse(StartX,BeginAt,StartX+TheSpace,BeginAt+fSegmentSize);
  545.         Inc(BeginAt,fSegmentSize + fDotSpacing);
  546.       end;
  547.     end
  548.     else
  549.     begin
  550.       { Draw a normal segment }
  551.       HalfX := StartX + round(XSpace/4);
  552.       Polygon([Point(HalfX,StartY),
  553.                Point(StartX,StartY+(VH div 2)),
  554.                Point(StartX,(StartY+YSpace)-(VH div 2)),
  555.                Point(HalfX,StartY+YSpace),
  556.                Point(StartX+XSpace,(StartY+YSpace)-VH),
  557.                Point(StartX+XSpace,StartY+VH),
  558.                Point(HalfX,StartY)]);
  559.     end;
  560.   end;
  561. end;
  562.  
  563. { Draw a colon - Thanks to Daniel Szasz for his help }
  564. procedure DrawColon(StartX1,StartY1,StartX2,StartY2,XSpace,YSpace: Integer; SColor:TColor);
  565. begin
  566.   with fWorkCanvas do
  567.   begin
  568.     Brush.Color := SColor;
  569.     Pen.Color := SColor;
  570.     Ellipse(StartX1,StartY1,StartX1+XSpace,StartY1+YSpace);
  571.     Ellipse(StartX2,StartY2,StartX2+XSpace,StartY2+YSpace);
  572.   end;
  573. end;
  574.  
  575. { And here's the clever procedure that draws the digits WITHOUT using
  576.   bitmaps! }
  577. procedure DrawDigit(Animation, Speed: Integer;SkipSome:Boolean);
  578. var
  579.   AnimationCount: Byte;
  580.   CH, CW, DelayCorrection, DigitNumber, DrawX, DrawY, SegmentSpaceX,
  581.     SegmentSpaceY, Temp: Integer;
  582.   SColor: TColor;
  583.   DigitOn: Boolean;
  584.   SegmentDelay,DelayTicks,FirstSegmentTickCount:{$IFDEF WIN32}DWord{$ELSE}Longint{$ENDIF};
  585. begin
  586.   with fWorkCanvas do
  587.   begin
  588.     { We start counting the whole delay here, as time can be wasted
  589.       drawing the display.  A delay of 1000 MUST last around 1 second }
  590.     { Work out segment sizes }
  591.     Spacing := fDigitSpacing + Integer(Not fDotDisplay);
  592.     { Just to ensure that everything is drawn.  The canvas doesn't always
  593.       draw along the edges, rather irritatingly.  We also need to give an
  594.       extra space for the left decimal point }
  595.     CH := Height - 1;
  596.     CW := Width - 1 - Spacing;
  597.     { Prepare to draw }
  598.     Brush.Style := bsSolid;
  599.     AnimationCount := 0;
  600.     if fDotDisplay then
  601.     begin
  602.       { Each dotted segments must contain the same number of dots horizontally
  603.         and vertically as the other segments.  So here we do some (very)
  604.         mind-boggling calculations - how I achieved this I will never know!!! }
  605.       Temp := (((CW + Spacing) div fDigitNum) - Spacing + fDotSpacing)
  606.         div (fSegmentSize + fDotSpacing);
  607.       SegmentSpaceX := Temp * (fSegmentSize + fDotSpacing) - fDotSpacing;
  608.       Temp := ((CH - fSegmentSize) div 2) div (fSegmentSize + fDotSpacing);
  609.       SegmentSpaceY := ((Temp * (fSegmentSize + fDotSpacing)) * 2) + fSegmentSize;
  610.     end
  611.     else
  612.     begin
  613.       { Normal segments aren't dotted, so we do a simple divide }
  614.       SegmentSpaceX := (CW - (fDigitNum * Spacing)) div fDigitNum;
  615.       SegmentSpaceY := CH;
  616.     end;
  617.     { Each segment needs a corner gap.  We use this to work out the segment
  618.       height and width.  These next variables are named as follows: -
  619.  
  620.       H- = Horizontal Segment, V- = Vertical Segment
  621.       -G = Corner gap, -H = Height, -W = Width }
  622.     if fDotDisplay then
  623.     begin
  624.       { Dotted segments don't use gaps }
  625.       HG := 0;
  626.       VG := 0;
  627.     end
  628.     else
  629.     begin
  630.       { Normal segments do use gaps }
  631.       HG := fGapY;
  632.       VG := fGapX;
  633.     end;
  634.     VH := fSegmentSize;
  635.     HW := fSegmentSize;
  636.     VW := SegmentSpaceX - (2 * VG);
  637.     HH := (SegmentSpaceY div 2) - (2 * HG);
  638.     { Draw the decimal points }
  639.     for DigitNumber := 1 to fDigitNum do
  640.       if (tmp3[DigitNumber] <> tmp4[DigitNumber]) or (not SkipSome) then
  641.       begin
  642.         if tmp3[DigitNumber] = '.' then
  643.         begin
  644.           Brush.Color := fOnColor;
  645.           Pen.Color := fOnColor;
  646.         end
  647.         else
  648.         begin
  649.           Brush.Color := fOffColor;
  650.           Pen.Color := fOffColor;
  651.         end;
  652.         { Make sure the decimal point size matches the segment size }
  653.         if fSegmentSize > (Spacing - 2) then Temp := Spacing - 2
  654.           else Temp := fSegmentSize;
  655.         DrawX := (((DigitNumber - 1) * (SegmentSpaceX + Spacing)) + Spacing)
  656.           - ((Spacing + Temp) div 2);
  657.         if fDotDisplay then
  658.           Ellipse(DrawX,SegmentSpaceY - Temp,DrawX + Temp,SegmentSpaceY)
  659.         else
  660.           Rectangle(DrawX,SegmentSpaceY - Temp,DrawX + Temp,SegmentSpaceY);
  661.       end;
  662.     { Here we see how much delay time is left }
  663.     Speed := (Speed - Integer(GetTickCount - FirstTickCount)) div 7;
  664.     if Speed < 0 then Speed := 0;
  665.     DelayCorrection := 0;
  666.     repeat
  667.       { Now we start the delay count.  The reason for this is that some
  668.         of the delay time can be spent updating the actual segments, so
  669.         a delay of 1000 MUST last 1 second.  The delay is equally divided
  670.         by 8, as there are 8 segments to update }
  671.       FirstSegmentTickCount := GetTickCount;
  672.       { Continue the animation }
  673.       Inc(AnimationCount);
  674.       if Animation <> 0 then
  675.         SegmentNo := LCDAnimationData[Animation,AnimationCount]
  676.       else
  677.         SegmentNo := LCDAnimationData[3,AnimationCount];
  678.       for DigitNumber := 1 to fDigitNum do
  679.         if (tmp[DigitNumber] <> tmp2[DigitNumber]) or (not SkipSome) then
  680.         begin
  681.           { Reset the digit index }
  682.           AValue := 8;
  683.           { Get the current digit details }
  684.           if tmp[DigitNumber] = ' ' then
  685.           begin
  686.             AValue := 8;
  687.             DigitOn := False;
  688.           end
  689.           else
  690.           begin
  691.             { Convert the letters, numbers and minus sign
  692.               to the correct digit index }
  693.             case tmp[DigitNumber] of
  694.               '-': AValue := 10;
  695.               ':': AValue := 11;
  696.               '0'..'9': AValue := StrToInt(tmp[DigitNumber]);
  697.               'A'..'Z': AValue := Ord(tmp[DigitNumber]) - 53;
  698.             end;
  699.             DigitOn := true;
  700.           end;
  701.           { Set the color }
  702.           if (DigitOn) and (LCDDisplayData[AValue,SegmentNo] = 1) then
  703.             SColor := fOnColor
  704.           else
  705.             SColor := fOffColor;
  706.           { Now we set the positions and draw the segment }
  707.           DrawX := Spacing + ((DigitNumber - 1) * (SegmentSpaceX + Spacing));
  708.           case SegmentNo of
  709.             1,7: begin
  710.                    { Top and bottom segments }
  711.                    Inc(DrawX,VG);
  712.                    if SegmentNo = 1 then
  713.                    begin
  714.                      DrawY := 0;
  715.                      DrawVerticalSegment(DrawX,DrawY,VW,VH,SColor);
  716.                    end
  717.                    else
  718.                    begin
  719.                      DrawY := SegmentSpaceY;
  720.                      DrawVerticalSegment(DrawX,DrawY,VW,-(VH),SColor);
  721.                    end;
  722.                  end;
  723.             4: begin
  724.                  { Centre segment }
  725.                  Inc(DrawX,VG);
  726.                  DrawY := (SegmentSpaceY div 2) - (VH div 2);
  727.                  DrawCenterSegment(DrawX,DrawY,VW,VH,SColor);
  728.                end;
  729.             2,5: begin
  730.                    { Left segments }
  731.                    if SegmentNo = 2 then DrawY := HG else
  732.                    begin
  733.                      if fDotDisplay then
  734.                        DrawY := (SegmentSpaceY div 2) - (VH div 2)
  735.                      else
  736.                        DrawY := (SegmentSpaceY div 2) + HG;
  737.                    end;
  738.                    DrawHorizontalSegment(DrawX,DrawY,HW,HH,SColor);
  739.                  end;
  740.             3,6: begin
  741.                    { Right segments }
  742.                    Inc(DrawX,SegmentSpaceX);
  743.                    if SegmentNo = 3 then DrawY := HG else
  744.                    begin
  745.                      if fDotDisplay then
  746.                        DrawY := (SegmentSpaceY div 2) - (VH div 2)
  747.                      else
  748.                        DrawY := (SegmentSpaceY div 2) + HG;
  749.                    end;
  750.                    DrawHorizontalSegment(DrawX,DrawY,-(HW),HH,SColor);
  751.                  end;
  752.             8: begin
  753.                  { Colon }
  754.                  Inc(DrawX,(SegmentSpaceX - (VW div 3)) div 2);
  755.                  DrawColon(DrawX,(SegmentSpaceY div 2)-((HH div 3) * 2),
  756.                              DrawX,(SegmentSpaceY div 2)+(HH div 3),
  757.                              (VW div 3),(HH div 3),SColor);
  758.                end;
  759.           end;
  760.         end;
  761.       { Now we wait for the rest of the delay to complete if there is
  762.         an animation }
  763.       if (Animation <> 0) and (Speed>0) then
  764.         begin
  765.          { Draw what we've achieved so far if double buffering }
  766.          if fDoBuffer then
  767.            Canvas.CopyRect(ClientRect,fWorkCanvas,ClientRect);
  768.          { Delay & process messages up until last segment }
  769.          if AnimationCount < 8 then
  770.          begin
  771.            SegmentDelay:= Speed - DelayCorrection;
  772.            repeat
  773.              { Process messages if not in design mode }
  774.              if not (csDesigning in ComponentState) then
  775.                Application.ProcessMessages;
  776.              DelayTicks := GetTickCount - FirstSegmentTickCount;
  777.            until DelayTicks >= SegmentDelay;
  778.            { Trim back delay speed to compensate for over long delays }
  779.            DelayCorrection := DelayTicks-SegmentDelay;
  780.            if DelayCorrection > Speed then
  781.               DelayCorrection := Speed;
  782.           end;
  783.         end
  784.     until AnimationCount = 8;
  785.   end;
  786. end;
  787.  
  788. procedure SplitValue(AValue: String; var Value, Dots: String);
  789. var
  790.   Count: Integer;
  791.   Dot: Boolean;
  792. begin
  793.   Count := 1;
  794.   Value := '';
  795.   Dots := '';
  796.   Dot := False;
  797.   while Count <= length(AValue) do
  798.   begin
  799.     if AValue[Count] <> '.' then
  800.     begin
  801.       if not Dot then
  802.         Dots := Dots + ' '
  803.       else
  804.         Dot := False;
  805.       Value := Value + AValue[Count];
  806.     end
  807.     else
  808.     begin
  809.       Dots := Dots + '.';
  810.       if Dot then
  811.         Value := Value + ' '
  812.       else
  813.         Dot := True;
  814.     end;
  815.     Inc(Count);
  816.   end;
  817. end;
  818.  
  819. begin
  820.   { Exit if the control is already painting }
  821.   if fIsPainting then Exit;
  822.   { Set the painting flag }
  823.   fIsPainting := True;
  824.   FirstTickCount := GetTickCount;
  825.   PaintStart := GetTickCount;
  826.   { Set working canvas to default; }
  827.   fWorkCanvas := Canvas;
  828.   { Get double buffer status }
  829.   fDoBuffer := fDoubleBuffer;
  830.   { Disable animation in design mode if preview off }
  831.   if csDesigning in ComponentState then
  832.     fIsChanging:=fPreview;
  833.   { Attempt to create bitmap for double buffer if required }
  834.   if fDoBuffer then
  835.   begin
  836.     try
  837.       if fBufferBM = nil then
  838.         fBufferBM := TBitMap.Create;
  839.       { Set working canvas to bitmap }
  840.       fWorkCanvas := fBufferBM.Canvas;
  841.       { Set bitmap size to match client area }
  842.       fBufferBM.Width := ClientWidth;
  843.       fBufferBM.Height := ClientHeight;
  844.     except
  845.       { Set to normal draw if an error occurs }
  846.       fBufferBM.Free;
  847.       fBufferBM := nil;
  848.       fDoBuffer := False;
  849.       fWorkCanvas := Canvas;
  850.     end;
  851.   end;
  852.   with fWorkCanvas do
  853.   begin
  854.     { Fill control background }
  855.     Brush.Color := Color;
  856.     Brush.Style := bsSolid;
  857.     FillRect(ClientRect);
  858.     { Select the animation to use }
  859.     AnimationNo := 0;
  860.     case fAnimation of
  861.       anSpiral: AnimationNo := 1;
  862.       anUp: AnimationNo := 2;
  863.       anDown: AnimationNo := 3;
  864.       anLeft: AnimationNo := 4;
  865.       anRight: AnimationNo := 5;
  866.       anRandom: AnimationNo := Random(5)+1;
  867.     end;
  868.     { Update the display.  Tmp is the used string, which is
  869.       compared with tmp2 }
  870.     if fValue = '' then
  871.     begin
  872.       { Clear the display }
  873.       SplitValue('',tmp,tmp3);
  874.       SplitValue(fOldValue,tmp2,tmp4);
  875.       while length(tmp) < fDigitNum do tmp := ' ' + tmp;
  876.       while length(tmp2) < fDigitNum do tmp2 := ' ' + tmp2;
  877.       while length(tmp3) < fDigitNum do tmp3 := ' ' + tmp3;
  878.       while length(tmp4) < fDigitNum do tmp4 := ' ' + tmp4;
  879.       if fIsChanging then
  880.         DrawDigit(AnimationNo,fAnimationDelay,False)
  881.       else
  882.         DrawDigit(0,0,False);
  883.     end
  884.     else
  885.     begin
  886.       { We start counting the whole delay here, as time can be wasted
  887.         drawing the display.  A delay of 1000 MUST last around 1 second }
  888.       { Here, we draw over the old value, but first we need
  889.         to quickly redraw the old value incase the component
  890.         is blank and is using an animation }
  891.       SplitValue(fOldValue,tmp,tmp3);
  892.       SplitValue('',tmp2,tmp4);
  893.       while length(tmp) < fDigitNum do tmp := ' ' + tmp;
  894.       while length(tmp2) < fDigitNum do tmp2 := ' ' + tmp2;
  895.       while length(tmp3) < fDigitNum do tmp3 := ' ' + tmp3;
  896.       while length(tmp4) < fDigitNum do tmp4 := ' ' + tmp4;
  897.       DrawDigit(0,0,False);
  898.       { Now draw the new value }
  899.       SplitValue(fValue,tmp,tmp3);
  900.       SplitValue(fOldValue,tmp2,tmp4);
  901.       while length(tmp) < fDigitNum do tmp := ' ' + tmp;
  902.       while length(tmp2) < fDigitNum do tmp2 := ' ' + tmp2;
  903.       while length(tmp3) < fDigitNum do tmp3 := ' ' + tmp3;
  904.       while length(tmp4) < fDigitNum do tmp4 := ' ' + tmp4;
  905.       { Here we see how much delay time is left }
  906.       tmpDelay := fAnimationDelay - Integer(GetTickCount-FirstTickCount);
  907.       if tmpDelay < 0 then tmpDelay := 0;
  908.       if fIsChanging then
  909.         DrawDigit(AnimationNo,tmpDelay,True)
  910.       else
  911.         DrawDigit(0,0,True);
  912.     end;
  913.     { Store the value that we just used }
  914.     if fValue = '' then fOldValue := '' else
  915.       fOldValue := fValue;
  916.   end;
  917.   { Copy from buffer to screen & free memory if double buffering }
  918.   if fDoBuffer then
  919.   begin
  920.      Canvas.CopyRect(ClientRect,fWorkCanvas,ClientRect);
  921.      { Get rid of bitmap }
  922.      fBufferBM.Free;
  923.      fBufferBM := nil;
  924.   end;
  925.   { Disable animation }
  926.   fIsChanging:=false;
  927.   { Allow drawing }
  928.   fIsPainting:=false;
  929.   { Set paint duration value }
  930.   fPaintDuration:=GetTickCount - PaintStart;
  931. end;
  932.  
  933. procedure Register;
  934. begin
  935.   RegisterComponents('Standard', [TLCD99]);
  936. end;
  937.  
  938. end.
  939.