开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
VrMatrix.pas
资源名称：varian_led_studio_3.34.rar　[点击查看]
上传用户：hbszzs
上传日期：2008-08-20
资源大小：628k
文件大小：40k
源码类别：

Delphi控件源码

开发平台：

Delphi

VrMatrix.pas：源码内容
  1. {*****************************************************}
  2. {                                                     }
  3. {     Varian Component Workshop                       }
  4. {                                                     }
  5. {     Varian Software NL (c) 1996-2000                }
  6. {     All Rights Reserved                             }
  7. {                                                     }
  8. {*****************************************************}
  10. unit VrMatrix;
  12. {$I VRLIB.INC}
  14. interface
  16. uses
  17.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  18.   VrConst, VrTypes, VrClasses, VrControls, VrSysUtils, VrThreads;
  20. type
  21.   TVrMatrixTextStyle = (tsUpperCase, tsLowerCase, tsAsIs, tsProperCase);
  23.   TVrMatrixData = class
  24.   private
  25.     FOrigin: string;
  26.     FData: string;
  27.     FColors: string;
  28.     FCurrColor: Char;
  29.     FStyle: TVrMatrixTextStyle;
  30.     procedure DecodeColorCode(var S: string);
  31.     procedure InsertChar(var S: string);
  32.   public
  33.     constructor Create;
  34.     procedure Decode(S: string);
  35.     procedure SetStyle(Value: TVrMatrixTextStyle);
  36.     procedure MoveLeft;
  37.     procedure MoveRight;
  38.     procedure Reset;
  39.     property Data: string read FData;
  40.     property Colors: string read FColors;
  41.   end;
  43.   TVrMatrixScrollDirection = (msdRightToLeft, msdLeftToRight);
  44.   TVrMatrixLedStyle = (ls9x13, ls14x20, ls19x27);
  46.   TVrMatrix = class(TVrGraphicImageControl)
  47.   private
  48.     FLeds: Integer;
  49.     FSpacing: Integer;
  50.     FAlignment: TAlignment;
  51.     FPalette: TVrPalette;
  52.     FTextStyle: TVrMatrixTextStyle;
  53.     FAutoScroll: Boolean;
  54.     FBevel: TVrBevel;
  55.     FScrollDirection: TVrMatrixScrollDirection;
  56.     FLedStyle: TVrMatrixLedStyle;
  57.     FLedsVisible: Boolean;
  58.     FThreaded: Boolean;
  59.     FOrientation: TVrOrientation;
  60.     FCharIndex: Integer;
  61.     FOnScrollDone: TNotifyEvent;
  62.     Bitmap: TBitMap;
  63.     FTimer: TVrTimer;
  64.     ScrollInit: Boolean;
  65.     Initialized: Boolean;
  66.     FStartLed: Integer;
  67.     FImageRect: TRect;
  68.     FString: TVrMatrixData;
  69.     function GetTimeInterval: Integer;
  70.     procedure SetLeds(Value: Integer);
  71.     procedure SetSpacing(Value: Integer);
  72.     procedure SetAlignment(Value: TAlignment);
  73.     procedure SetTextStyle(Value: TVrMatrixTextStyle);
  74.     procedure SetAutoScroll(Value: Boolean);
  75.     procedure SetTimeInterval(Value: Integer);
  76.     procedure SetLedStyle(Value: TVrMatrixLedStyle);
  77.     procedure SetLedsVisible(Value: Boolean);
  78.     procedure SetPalette(Value: TVrPalette);
  79.     procedure SetBevel(Value: TVrBevel);
  80.     procedure SetThreaded(Value: Boolean);
  81.     procedure SetOrientation(Value: TVrOrientation);
  82.     procedure PaletteModified(Sender: TObject);
  83.     procedure BevelChanged(Sender: TObject);
  84.     procedure TimerEvent(Sender: TObject);
  85.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  86.   protected
  87.     procedure LoadBitmaps; virtual;
  88.     procedure DestroyBitmaps;
  89.     procedure UpdateLed(Index: Integer; Ch: Char; Color: TColor);
  90.     procedure UpdateLeds(Redraw: Boolean);
  91.     procedure Paint; override;
  92.     procedure Loaded; override;
  93.     procedure GetItemRect(Index: Integer; var R: TRect);
  94.     procedure CalcPaintParams;
  95.     procedure FormatText(Value: string);
  96.   public
  97.     constructor Create(AOwner: TComponent); override;
  98.     destructor Destroy; override;
  99.   published
  100.     property Threaded: Boolean read FThreaded write SetThreaded default True;
  101.     property Leds: Integer read FLeds write SetLeds default 15;
  102.     property Spacing: Integer read FSpacing write SetSpacing default 2;
  103.     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  104.     property Palette: TVrPalette read FPalette write SetPalette;
  105.     property Bevel: TVrBevel read FBevel write SetBevel;
  106.     property TextStyle: TVrMatrixTextStyle read FTextStyle write SetTextStyle default tsUpperCase;
  107.     property AutoScroll: Boolean read FAutoScroll write SetAutoScroll default false;
  108.     property TimeInterval: Integer read GetTimeInterval write SetTimeInterval default 500;
  109.     property ScrollDirection: TVrMatrixScrollDirection read FScrollDirection write FScrollDirection default msdRightToLeft;
  110.     property LedStyle: TVrMatrixLedStyle read FLedStyle write SetLedStyle default ls14x20;
  111.     property LedsVisible: Boolean read FLedsVisible write SetLedsVisible default True;
  112.     property Orientation: TVrOrientation read FOrientation write SetOrientation default voHorizontal;
  113.     property OnScrollDone: TNotifyEvent read FOnScrollDone write FOnScrollDone;
  114. {$IFDEF VER110}
  115.     property Anchors;
  116.     property Constraints;
  117. {$ENDIF}
  118.     property Color;
  119.     property DragCursor;
  120. {$IFDEF VER110}
  121.     property DragKind;
  122. {$ENDIF}
  123.     property DragMode;
  124.     property Hint;
  125.     property ParentColor;
  126.     property ParentShowHint;
  127.     property PopupMenu;
  128.     property ShowHint;
  129.     property Text;
  130.     property Visible;
  131.     property OnClick;
  132. {$IFDEF VER130}
  133.     property OnContextPopup;
  134. {$ENDIF}
  135.     property OnDblClick;
  136.     property OnDragDrop;
  137.     property OnDragOver;
  138. {$IFDEF VER110}
  139.     property OnEndDock;
  140. {$ENDIF}
  141.     property OnEndDrag;
  142.     property OnMouseDown;
  143.     property OnMouseMove;
  144.     property OnMouseUp;
  145. {$IFDEF VER110}
  146.     property OnStartDock;
  147. {$ENDIF}
  148.     property OnStartDrag;
  149.   end;
  151.   TVrMatrixGroup = class(TVrGraphicImageControl)
  152.   private
  153.     FCols: TVrColInt;
  154.     FRows: TVrRowInt;
  155.     FAutoScroll: Boolean;
  156.     FPalette: TVrPalette;
  157.     FBevel: TVrBevel;
  158.     FCharSpacing: Integer;
  159.     FLineSpacing: Integer;
  160.     FPixelSize: Integer;
  161.     FPixelSpacing: Integer;
  162.     FLines: TStrings;
  163.     FTimer: TVrTimer;
  164.     FThreaded: Boolean;
  165.     FLedImage: TBitmap;
  166.     FMatrixImage: TBitmap;
  167.     FColorChanged: Boolean;
  168.     FScrollDirection: TVrScrollDirection;
  169.     FViewPort: TRect;
  170.     FAlignment: TAlignment;
  171.     FTextStyle: TVrMatrixTextStyle;
  172.     FInitialized: Boolean;
  173.     FList: TList;
  174.     function GetTimeInterval: Integer;
  175.     procedure SetCols(Value: TVrColInt);
  176.     procedure SetRows(Value: TVrRowInt);
  177.     procedure SetCharSpacing(Value: Integer);
  178.     procedure SetLineSpacing(Value: Integer);
  179.     procedure SetPixelSize(Value: Integer);
  180.     procedure SetPixelSpacing(Value: Integer);
  181.     procedure SetLines(Value: TStrings);
  182.     procedure SetPalette(Value: TVrPalette);
  183.     procedure SetBevel(Value: TVrBevel);
  184.     procedure SetThreaded(Value: Boolean);
  185.     procedure SetAutoScroll(Value: Boolean);
  186.     procedure SetAlignment(Value: TAlignment);
  187.     procedure SetTextStyle(Value: TVrMatrixTextStyle);
  188.     procedure SetTimeInterval(Value: Integer);
  189.     procedure PaletteModified(Sender: TObject);
  190.     procedure BevelChanged(Sender: TObject);
  191.     procedure LinesChanged(Sender: TObject);
  192.     procedure TimerEvent(Sender: TObject);
  193.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  194.   protected
  195.     procedure Paint; override;
  196.     procedure CalcPaintParams;
  197.     procedure Loaded; override;
  198.     procedure CreateLedImage;
  199.     procedure UpdateLed(Index: Integer; Ch: Char; Color: TColor);
  200.     procedure UpdateRow(ARow: Integer);
  201.     procedure FormatStrings;
  202.     function GetItemRect(Index: Integer): TRect;
  203.     procedure CreateDataList;
  204.     procedure ClearDataList(FreeList: Boolean);
  205.   public
  206.     constructor Create(AOwner: TComponent); override;
  207.     destructor Destroy; override;
  208.     procedure Reset;
  209.   published
  210.     property Threaded: Boolean read FThreaded write SetThreaded default True;
  211.     property Cols: TVrColInt read FCols write SetCols default 15;
  212.     property Rows: TVrRowInt read FRows write SetRows default 7;
  213.     property AutoScroll: Boolean read FAutoScroll write SetAutoScroll default false;
  214.     property CharSpacing: Integer read FCharSpacing write SetCharSpacing default 1;
  215.     property LineSpacing: Integer read FLineSpacing write SetLineSpacing default 1;
  216.     property PixelSize: Integer read FPixelSize write SetPixelSize default 1;
  217.     property PixelSpacing: Integer read FPixelSpacing write SetPixelSpacing default 1;
  218.     property Lines: TStrings read FLines write SetLines;
  219.     property ScrollDirection: TVrScrollDirection read FScrollDirection write FScrollDirection default sdRightToLeft;
  220.     property Palette: TVrPalette read FPalette write SetPalette;
  221.     property Bevel: TVrBevel read FBevel write SetBevel;
  222.     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  223.     property TextStyle: TVrMatrixTextStyle read FTextStyle write SetTextStyle default tsUpperCase;
  224.     property TimeInterval: Integer read GetTimeInterval write SetTimeInterval default 500;
  225. {$IFDEF VER110}
  226.     property Anchors;
  227.     property Constraints;
  228. {$ENDIF}
  229.     property Color default clBlack;
  230.     property DragCursor;
  231. {$IFDEF VER110}
  232.     property DragKind;
  233. {$ENDIF}
  234.     property DragMode;
  235.     property Hint;
  236.     property ParentColor default false;
  237.     property ParentShowHint;
  238.     property PopupMenu;
  239.     property ShowHint;
  240.     property Text;
  241.     property Visible;
  242.     property OnClick;
  243. {$IFDEF VER130}
  244.     property OnContextPopup;
  245. {$ENDIF}
  246.     property OnDblClick;
  247.     property OnDragDrop;
  248.     property OnDragOver;
  249. {$IFDEF VER110}
  250.     property OnEndDock;
  251. {$ENDIF}
  252.     property OnEndDrag;
  253.     property OnMouseDown;
  254.     property OnMouseMove;
  255.     property OnMouseUp;
  256. {$IFDEF VER110}
  257.     property OnStartDock;
  258. {$ENDIF}
  259.     property OnStartDrag;
  260.   end;
  263. implementation
  265. {$R VRMATRIX.D32}
  267. const
  268.   CharState: array[0..895] of byte = { all ASCII according to Hewlett Packard HDSP 2470 }
  269.               ($02, $06, $0e, $1e, $0e, $06, $02,     { NUL }
  270.                $04, $00, $04, $08, $11, $11, $0e,     { SOH }
  271.                $1f, $00, $11, $0a, $04, $0a, $11,     { STX }
  272.                $1f, $00, $11, $19, $15, $13, $11,     { ETX }
  273.                $1f, $00, $16, $19, $11, $11, $11,     { EOT }
  274.                $00, $00, $0d, $12, $12, $12, $0d,     { ENQ }
  275.                $1c, $12, $12, $16, $11, $16, $10,     { ACK }
  276.                $06, $08, $04, $0e, $11, $11, $0e,     { BEL }
  277.                $00, $00, $00, $04, $0a, $11, $1f,     { BS }
  278.                $00, $10, $1c, $12, $12, $02, $01,     { HT }
  279.                $0e, $11, $11, $1f, $11, $11, $0e,     { LF }
  280.                $00, $10, $08, $04, $0a, $11, $11,     { VT }
  281.                $00, $00, $09, $09, $09, $0e, $10,     { FF }
  282.                $00, $01, $0e, $1a, $0a, $0a, $0a,     { CR }
  283.                $00, $00, $0f, $12, $12, $12, $0c,     { SO }
  284.                $1f, $08, $04, $02, $04, $08, $1f,     { SI }
  285.                $00, $00, $01, $0e, $14, $04, $04,     { DLE }
  286.                $00, $04, $0e, $15, $15, $0e, $04,     { DC1 }
  287.                $0e, $11, $11, $11, $11, $0a, $1b,     { DC2 }
  288.                $04, $00, $0e, $11, $1f, $11, $11,     { DC3 }
  289.                $04, $00, $0e, $12, $12, $12, $0d,     { DC4 }
  290.                $0a, $00, $0e, $11, $1f, $11, $11,     { NAK }
  291.                $0a, $00, $0e, $12, $12, $12, $0d,     { SYN }
  292.                $0a, $0e, $11, $11, $11, $11, $0e,     { ETB }
  293.                $0a, $00, $0e, $11, $11, $11, $0e,     { CAN }
  294.                $0a, $00, $11, $11, $11, $11, $0e,     { EM }
  295.                $00, $0a, $00, $11, $11, $11, $0e,     { SUB }
  296.                $00, $04, $02, $1f, $02, $04, $00,     { ESC }
  297.                $00, $0f, $08, $08, $08, $18, $08,     { FS }
  298.                $0c, $12, $04, $08, $1e, $00, $00,     { GS }
  299.                $06, $09, $08, $1c, $08, $08, $1f,     { RS }
  300.                $11, $0a, $04, $04, $0e, $04, $04,     { US }
  301.                $00, $00, $00, $00, $00, $00, $00,     { Space }
  302.                $08, $08, $08, $08, $08, $00, $08,     { ! }
  303.                $0a, $0a, $00, $00, $00, $00, $00,     { " }
  304.                $0a, $0a, $1f, $0a, $1f, $0a, $0a,     { # }
  305.                $04, $0f, $14, $0e, $05, $1e, $04,     { $ }
  306.                $18, $19, $02, $04, $08, $13, $03,     { % }
  307.                $08, $14, $14, $08, $15, $12, $0d,     { & }
  308.                $0c, $0c, $04, $08, $00, $00, $00,     { ' }
  309.                $02, $04, $04, $04, $04, $04, $02,     { ( }
  310.                $08, $04, $04, $04, $04, $04, $08,     { ) }
  311.                $00, $0a, $04, $1f, $04, $0a, $00,     { * }
  312.                $00, $04, $04, $1f, $04, $04, $00,     { + }
  313.                $00, $00, $00, $0c, $0c, $04, $08,     { , }
  314.                $00, $00, $00, $1f, $00, $00, $00,     { - }
  315.                $00, $00, $00, $00, $0c, $0c, $00,     { . }
  316.                $00, $01, $02, $04, $08, $10, $00,     { / }
  317.                $0e, $11, $13, $15, $19, $11, $0e,     { 0 }
  318.                $04, $0c, $04, $04, $04, $04, $0e,     { 1 }
  319.                $0e, $11, $01, $06, $08, $10, $1f,     { 2 }
  320.                $0e, $11, $01, $06, $01, $11, $0e,     { 3 }
  321.                $02, $06, $0a, $12, $1f, $02, $02,     { 4 }
  322.                $1f, $10, $1e, $01, $01, $11, $0e,     { 5 }
  323.                $06, $08, $10, $1e, $11, $11, $0e,     { 6 }
  324.                $1f, $01, $02, $04, $08, $08, $08,     { 7 }
  325.                $0e, $11, $11, $0e, $11, $11, $0e,     { 8 }
  326.                $0e, $11, $11, $0f, $01, $02, $0c,     { 9 }
  327.                $00, $0c, $0c, $00, $0c, $0c, $00,     { : }
  328.                $0c, $0c, $00, $0c, $0c, $04, $08,     { ; }
  329.                $01, $02, $04, $08, $04, $02, $01,     { < }
  330.                $00, $00, $1f, $00, $1f, $00, $00,     { = }
  331.                $10, $08, $04, $02, $04, $08, $10,     { > }
  332.                $0e, $11, $01, $02, $04, $00, $04,     { ? }
  333.                $0e, $11, $17, $15, $17, $10, $0e,     { @ }
  334.                $0e, $11, $11, $1f, $11, $11, $11,     { A }
  335.                $1e, $11, $11, $1e, $11, $11, $1e,     { B }
  336.                $0e, $11, $10, $10, $10, $11, $0e,     { C }
  337.                $1e, $11, $11, $11, $11, $11, $1e,     { D }
  338.                $1f, $10, $10, $1e, $10, $10, $1f,     { E }
  339.                $1f, $10, $10, $1e, $10, $10, $10,     { F }
  340.                $0e, $11, $10, $10, $13, $11, $0f,     { G }
  341.                $11, $11, $11, $1f, $11, $11, $11,     { H }
  342.                $0e, $04, $04, $04, $04, $04, $0e,     { I }
  343.                $01, $01, $01, $01, $01, $11, $0e,     { J }
  344.                $11, $12, $14, $18, $14, $12, $11,     { K }
  345.                $10, $10, $10, $10, $10, $10, $1f,     { L }
  346.                $11, $1b, $15, $15, $11, $11, $11,     { M }
  347.                $11, $11, $19, $15, $13, $11, $11,     { N }
  348.                $0e, $11, $11, $11, $11, $11, $0e,     { O }
  349.                $1e, $11, $11, $1e, $10, $10, $10,     { P }
  350.                $0e, $11, $11, $11, $15, $12, $0d,     { Q }
  351.                $1e, $11, $11, $1e, $14, $12, $11,     { R }
  352.                $0e, $11, $10, $0e, $01, $11, $0e,     { S }
  353.                $1f, $04, $04, $04, $04, $04, $04,     { T }
  354.                $11, $11, $11, $11, $11, $11, $0e,     { U }
  355.                $11, $11, $11, $11, $11, $0a, $04,     { V }
  356.                $11, $11, $11, $15, $15, $1b, $11,     { W }
  357.                $11, $11, $0a, $04, $0a, $11, $11,     { X }
  358.                $11, $11, $0a, $04, $04, $04, $04,     { Y }
  359.                $1f, $01, $02, $04, $08, $10, $1f,     { Z }
  360.                $07, $04, $04, $04, $04, $04, $07,     { [ }
  361.                $00, $10, $08, $04, $02, $01, $00,     {  }
  362.                $1c, $04, $04, $04, $04, $04, $1c,     { ] }
  363.                $04, $0e, $15, $04, $04, $04, $04,     { ^ }
  364.                $00, $00, $00, $00, $00, $00, $1f,     { _ }
  365.                $0c, $0c, $08, $04, $00, $00, $00,     { ` }
  366.                $00, $00, $0e, $12, $12, $12, $0d,     { a }
  367.                $10, $10, $16, $19, $11, $11, $1e,     { b }
  368.                $00, $00, $0e, $10, $10, $11, $0e,     { c }
  369.                $01, $01, $0d, $13, $11, $11, $0f,     { d }
  370.                $00, $00, $0e, $11, $1e, $10, $0e,     { e }
  371.                $04, $0a, $08, $1c, $08, $08, $08,     { f }
  372.                $00, $00, $0f, $11, $0f, $01, $06,     { g }
  373.                $10, $10, $16, $19, $11, $11, $11,     { h }
  374.                $04, $00, $0c, $04, $04, $04, $0e,     { i }
  375.                $02, $00, $06, $02, $02, $12, $0c,     { j }
  376.                $08, $08, $09, $0a, $0c, $0a, $09,     { k }
  377.                $0c, $04, $04, $04, $04, $04, $0e,     { l }
  378.                $00, $00, $0a, $15, $15, $11, $11,     { m }
  379.                $00, $00, $16, $19, $11, $11, $11,     { n }
  380.                $00, $00, $0e, $11, $11, $11, $0e,     { o }
  381.                $00, $00, $1e, $11, $19, $16, $10,     { p }
  382.                $00, $00, $0e, $12, $16, $0a, $03,     { q }
  383.                $00, $00, $0b, $0c, $08, $08, $08,     { r }
  384.                $00, $00, $0e, $10, $0e, $01, $1e,     { s }
  385.                $00, $08, $1c, $08, $08, $0a, $04,     { t }
  386.                $00, $00, $11, $11, $11, $13, $0d,     { u }
  387.                $00, $00, $11, $11, $11, $0a, $04,     { v }
  388.                $00, $00, $11, $11, $15, $15, $0a,     { w }
  389.                $00, $00, $11, $0a, $04, $0a, $11,     { x }
  390.                $00, $00, $11, $0a, $04, $04, $08,     { y }
  391.                $00, $00, $1f, $02, $04, $08, $1f,     { z }
  392.                $02, $04, $04, $08, $04, $04, $02,     (* { *)
  393.                $04, $04, $04, $00, $04, $04, $04,     { | }
  394.                $08, $04, $04, $02, $04, $04, $08,     (* } *)
  395.                $00, $00, $08, $15, $02, $00, $00,     { ~ }
  396.                $0a, $15, $0a, $15, $0a, $15, $0a);    { DEL }
  398.   SegSize: array[TVrMatrixLedStyle] of Integer = (1, 2, 3);
  400.   SegX = 5;
  401.   SegY = 7;
  402.   ColorCmd = '%';
  404.   ColorArray: array[1..16] of TColor = (
  405.     clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple,
  406.     clTeal, clGray, clSilver, clRed, clLime, clYellow,
  407.     clBlue, clFuchsia, clAqua, clWhite);
  409.   //Each color code is made out of a percentage charater and a combination
  410.   //of a digit or a letter: for example "%CHello" will display all characters in clYellow.
  411.   //Combinations are also possible: %CH%0ello. This will only display the
  412.   //"H" in a different color.
  414.   //Codes are as follows:
  415.   //1 = clBlack       A = clRed
  416.   //2 = clMaroon      B = clLime
  417.   //3 = clGreen       C = clYellow
  418.   //4 = clOlive       D = clBlue
  419.   //5 = clNavy        E = clFuchsia
  420.   //6 = clPurple      F = clAqua
  421.   //7 = clTeal        G = clWhite
  422.   //8 = clGray
  423.   //9 = clSilver
  425.   //Note: in order to reset to the default palette color use "%0", or
  426.   //to display a % character use %%.
  428. function CountChars(const S: string): Integer;
  429. var
  430.   I: Integer;
  431. begin
  432.   I := 1;
  433.   Result := 0;
  434.   while I <= Length(S) do
  435.   begin
  436.     if S[I] = ColorCmd then
  437.     begin
  438.       Inc(I);
  439.       if (I <= Length(S)) and (S[I] = ColorCmd) then
  440.       begin
  441.         Inc(Result);
  442.         Inc(I);
  443.       end else Inc(I);
  444.     end
  445.     else
  446.     begin
  447.       Inc(Result);
  448.       Inc(I);
  449.     end;
  450.   end;
  451. end;
  453. { TVrMatrixData }
  455. constructor TVrMatrixData.Create;
  456. begin
  457.   inherited Create;
  458.   FStyle := tsAsIs;
  459. end;
  461. procedure TVrMatrixData.DecodeColorCode(var S: string);
  462. begin
  463.   FCurrColor := '-';
  464.   if S <> '' then
  465.   begin
  466.     if Upcase(S[1]) in ['0'..'9', 'A'..'G'] then
  467.       FCurrColor := S[1];
  468.     Delete(S, 1, 1);
  469.   end;
  470. end;
  472. procedure TVrMatrixData.InsertChar(var S: string);
  473. begin
  474.   if S <> '' then
  475.   begin
  476.     FData := FData + S[1];
  477.     FColors := FColors + FCurrColor;
  478.     Delete(S, 1, 1);
  479.   end;
  480. end;
  482. procedure TVrMatrixData.Decode(S: string);
  483. begin
  484.   FOrigin := S;
  485.   FData := '';
  486.   FColors := '';
  487.   FCurrColor := '-';
  488.   while Length(S) > 0 do
  489.   begin
  490.     if S[1] = ColorCmd then
  491.     begin
  492.       Delete(S, 1, 1);
  493.       if (S <> '') and (S[1] = ColorCmd) then
  494.         InsertChar(S)
  495.       else DecodeColorCode(S);
  496.     end else InsertChar(S);
  497.   end;
  498. end;
  500. procedure TVrMatrixData.MoveLeft;
  501. begin
  502.   FData := Copy(FData, 2, Length(FData) - 1) + Copy(FData, 1, 1);
  503.   FColors := Copy(FColors, 2, Length(FColors) - 1) + Copy(FColors, 1, 1);
  504. end;
  506. procedure TVrMatrixData.MoveRight;
  507. begin
  508.   FData := Copy(FData, Length(FData), 1) + Copy(FData, 0, Length(FData) - 1);
  509.   FColors := Copy(FColors, Length(FColors), 1) + Copy(FColors, 0, Length(FColors) - 1);
  510. end;
  512. procedure TVrMatrixData.Reset;
  513. begin
  514.   Decode(FOrigin);
  515.   SetStyle(FStyle);
  516. end;
  518. procedure TVrMatrixData.SetStyle(Value: TVrMatrixTextStyle);
  519. begin
  520.   FStyle := Value;
  521.   case FStyle of
  522.     tsUpperCase: FData := AnsiUpperCase(FData);
  523.     tsLowerCase: FData := AnsiLowerCase(FData);
  524.     tsProperCase:
  525.       begin
  526.         FData := AnsiLowerCase(FData);
  527.         if FData <> '' then
  528.           FData[1] := Upcase(FData[1]);
  529.       end;
  530.     tsAsIs:; //do nothing
  531.   end;
  532. end;
  534. {TVrMatrix}
  536. constructor TVrMatrix.Create(AOwner: TComponent);
  537. begin
  538.   inherited Create(AOwner);
  539.   ControlStyle := ControlStyle + [csOpaque] - [csSetCaption];
  540.   Width := 245;
  541.   Height := 30;
  542.   ParentColor := false;
  543.   Color := clBlack;
  544.   FLeds := 15;
  545.   FSpacing := 2;
  546.   FAlignment := taLeftjustify;
  547.   FTextStyle := tsUpperCase;
  548.   FAutoScroll := false;
  549.   FCharIndex := 1;
  550.   FScrollDirection := msdRightToLeft;
  551.   FLedStyle := ls14x20;
  552.   FLedsVisible := True;
  553.   FOrientation := voHorizontal;
  554.   FPalette := TVrPalette.Create;
  555.   FPalette.OnChange := PaletteModified;
  556.   FBevel := TVrBevel.Create;
  557.   with FBevel do
  558.   begin
  559.     InnerStyle := bsLowered;
  560.     InnerWidth := 2;
  561.     InnerColor := clBlack;
  562.     OnChange := BevelChanged;
  563.   end;
  564.   Bitmap := TBitMap.Create;
  565.   LoadBitmaps;
  566.   FThreaded := True;
  567.   FTimer := TVrTimer.Create(Self);
  568.   FTimer.Enabled := false;
  569.   FTimer.Interval := 500;
  570.   FTimer.OnTimer := TimerEvent;
  571.   FString := TVrMatrixData.Create;
  572. end;
  574. destructor TVrMatrix.Destroy;
  575. begin
  576.   DestroyBitmaps;
  577.   FString.Free;
  578.   FBevel.Free;
  579.   FPalette.Free;
  580.   FTimer.Free;
  581.   inherited Destroy;
  582. end;
  584. procedure TVrMatrix.Loaded;
  585. begin
  586.   inherited Loaded;
  587.   CalcPaintParams;
  588. end;
  590. procedure TVrMatrix.LoadBitmaps;
  591. const
  592.   ResNames: array[TVrMatrixLedStyle] of PChar =
  593.     ('9x13', '14x20', '19x27');
  594. begin
  595.   Bitmap.Handle := LoadBitmap(hInstance, PChar('VRMATRIXLED' + ResNames[FLedStyle]));
  596.   FPalette.ToBMP(Bitmap, ResColorLow, ResColorHigh);
  597.   FImageRect := Bounds(0, 0, Bitmap.Width, Bitmap.Height);
  598. end;
  600. procedure TVrMatrix.DestroyBitmaps;
  601. begin
  602.   Bitmap.Free;
  603. end;
  605. procedure TVrMatrix.PaletteModified(Sender: TObject);
  606. begin
  607.   LoadBitmaps;
  608.   UpdateControlCanvas;
  609. end;
  611. procedure TVrMatrix.BevelChanged(Sender: TObject);
  612. begin
  613.   UpdateControlCanvas;
  614. end;
  616. procedure TVrMatrix.SetLeds(Value: Integer);
  617. begin
  618.   if FLeds <> Value then
  619.   begin
  620.     FLeds := Value;
  621.     FormatText(Text);
  622.     UpdateControlCanvas;
  623.   end;
  624. end;
  626. procedure TVrMatrix.SetSpacing(Value: Integer);
  627. begin
  628.   if FSpacing <> Value then
  629.   begin
  630.     FSpacing := Value;
  631.     UpdateControlCanvas;
  632.   end;
  633. end;
  635. procedure TVrMatrix.FormatText(Value: string);
  636. begin
  637.   FString.Decode(Value);
  638.   FString.SetStyle(FTextStyle);
  639. end;
  641. procedure TVrMatrix.SetTextStyle(Value: TVrMatrixTextStyle);
  642. begin
  643.   if FTextStyle <> Value then
  644.   begin
  645.     FTextStyle := Value;
  646.     FormatText(Text);
  647.     UpdateLeds(True);
  648.   end;
  649. end;
  651. procedure TVrMatrix.SetAlignment(Value: TAlignment);
  652. begin
  653.   if FAlignment <> Value then
  654.   begin
  655.     FAlignment := Value;
  656.     if (Designing) or (not FAutoScroll) then
  657.       UpdateControlCanvas;
  658.   end;
  659. end;
  661. procedure TVrMatrix.SetAutoScroll(Value: Boolean);
  662. begin
  663.   if FAutoScroll <> Value then
  664.   begin
  665.     FAutoScroll := Value;
  666.     FCharIndex := 1;
  667.     UpdateControlCanvas;
  668.     if not (Designing or Loading) then
  669.     begin
  670.       ScrollInit := True;
  671.       FTimer.Enabled := Value;
  672.     end;
  673.   end;
  674. end;
  676. procedure TVrMatrix.SetLedStyle(Value: TVrMatrixLedStyle);
  677. begin
  678.   if FLedStyle <> Value then
  679.   begin
  680.     FLedStyle := Value;
  681.     LoadBitmaps;
  682.     UpdateControlCanvas;
  683.   end;
  684. end;
  686. procedure TVrMatrix.SetLedsVisible(Value: Boolean);
  687. begin
  688.   if FLedsVisible <> Value then
  689.   begin
  690.     FLedsVisible := Value;
  691.     UpdateControlCanvas;
  692.   end;
  693. end;
  695. procedure TVrMatrix.SetThreaded(Value: Boolean);
  696. begin
  697.   if FThreaded <> Value then
  698.   begin
  699.     FThreaded := Value;
  700.     if Value then FTimer.TimerType := ttThread
  701.     else FTimer.TimerType := ttSystem;
  702.   end;
  703. end;
  705. procedure TVrMatrix.SetOrientation(Value: TVrOrientation);
  706. begin
  707.   if FOrientation <> Value then
  708.   begin
  709.     FOrientation := Value;
  710.     UpdateControlCanvas;
  711.   end;
  712. end;
  714. procedure TVrMatrix.SetTimeInterval(Value: Integer);
  715. begin
  716.   FTimer.Interval := Value;
  717. end;
  719. function TVrMatrix.GetTimeInterval: Integer;
  720. begin
  721.   Result := FTimer.Interval;
  722. end;
  724. procedure TVrMatrix.SetPalette(Value: TVrPalette);
  725. begin
  726.   FPalette.Assign(Value);
  727. end;
  729. procedure TVrMatrix.SetBevel(Value: TVrBevel);
  730. begin
  731.   FBevel.Assign(Value);
  732. end;
  734. procedure TVrMatrix.CMTextChanged(var Message: TMessage);
  735. begin
  736.   inherited;
  737.   FormatText(Text);
  738.   UpdateControlCanvas;
  739. end;
  741. procedure TVrMatrix.UpdateLed(Index: Integer; Ch: Char; Color: TColor);
  742. var
  743.   R, ItemRect: TRect;
  744.   I, J, Idx, W: Integer;
  745. begin
  746.   with BitmapCanvas do
  747.   begin
  748.     GetItemRect(Index, ItemRect);
  749.     Brush.Style := bsSolid;
  750.     Brush.Color := Self.Color;
  751.     FillRect(ItemRect);
  752.     if FLedsVisible then
  753.     begin
  754.       Brush.Style := bsClear;
  755.       BrushCopy(ItemRect, Bitmap, FImageRect, clBlack);
  756.     end;
  758.     if Ch = #32 then Exit;
  760.     Brush.Color := Color;
  761.     Idx := ord(Ch) * 7;
  762.     for I := 0 to 6 do
  763.       for J := 0 to 4 do
  764.       begin
  765.         if CharState[Idx + I] and (1 shl J) > 0 then
  766.         begin
  767.           W := SegSize[FLedStyle];
  768.           R := Bounds(ItemRect.Left + Bitmap.Width - W - (J * Succ(W)),
  769.                       ItemRect.Top + (I * Succ(W)), W, W);
  770.           FillRect(R);
  771.         end;
  772.       end;
  773.   end;
  774. end;
  776. procedure TVrMatrix.UpdateLeds(Redraw: Boolean);
  777. var
  778.   I: Integer;
  779.   Data, Colors: string;
  780.   Idx: Integer;
  781.   Color: TColor;
  783.   function GetColorValue(Ch: Char): TColor;
  784.   var
  785.     ColorIndex: Integer;
  786.   begin
  787.     ColorIndex := 0;
  788.     case Upcase(Ch) of
  789.       '0'..'9' : ColorIndex := ord(Ch) - 48;    // 48 = ord('0')
  790.       'A'..'G' : ColorIndex := ord(Ch) - 55;   // 'A' = 41h = 65d  ; minus 10 = 55d
  791.     end;
  792.     if (ColorIndex < 1) or (ColorIndex > 16) then
  793.          Result := FPalette.High
  794.       else Result := ColorArray[ColorIndex];
  795.   end;
  797. begin
  798.   for I := 0 to FLeds - 1 do
  799.     UpdateLed(I, #32, FPalette.High);
  801.   Data := FString.Data;
  802.   Colors := FString.Colors;
  803.   Idx := FStartLed;
  804.   for I := FCharIndex to Length(Data) do
  805.   begin
  806.     Color := GetColorValue(Colors[I]);
  807.     UpdateLed(Idx, Data[I], Color);
  808.     Inc(Idx);
  809.     if Idx >= FLeds then Break;
  810.   end;
  811.   if not Loading then
  812.     if Redraw then inherited Paint;
  813. end;
  815. procedure TVrMatrix.Paint;
  816. var
  817.   R: TRect;
  818. begin
  819.   CalcPaintParams;
  820.   ClearBitmapCanvas;
  821.   R := ClientRect;
  822.   FBevel.Paint(BitmapCanvas, R);
  823.   FCharIndex := 1;
  824.   case FAlignment of
  825.     taCenter: FStartLed := MaxIntVal(0, ((FLeds - Length(FString.Data)) div 2));
  826.     taRightJustify: FStartLed := MaxIntVal(0, (FLeds - Length(FString.Data)));
  827.     else FStartLed := 0;
  828.   end;
  830.   UpdateLeds(True);
  832.   //Make sure we first display the control
  833.   if (not Initialized) and (AutoScroll) then
  834.   begin
  835.     Initialized := True;
  836.     ScrollInit := True;
  837.     FTimer.Enabled := True;
  838.   end;
  839. end;
  841. procedure TVrMatrix.CalcPaintParams;
  842. var
  843.   R: TRect;
  844.   Gap, NewWidth, NewHeight: Integer;
  845. begin
  846.   R := ClientRect;
  847.   FBevel.GetVisibleArea(R);
  848.   Gap := (FLeds - 1) * FSpacing;
  850.   if Orientation = voHorizontal then
  851.   begin
  852.     NewWidth := (R.Left * 2) + Gap + (FLeds * Bitmap.Width);
  853.     NewHeight := (R.Top * 2) + Bitmap.Height;
  854.   end
  855.   else
  856.   begin
  857.     NewWidth := (R.Left * 2) + Bitmap.Width;
  858.     NewHeight := (R.Top * 2) + Gap + (FLeds * Bitmap.Height);
  859.   end;
  860.   BoundsRect := Bounds(Left, Top, NewWidth, NewHeight);
  861. end;
  863. procedure TVrMatrix.GetItemRect(Index: Integer; var R: TRect);
  864. var
  865.   X, Y: Integer;
  866. begin
  867.   R := ClientRect;
  868.   FBevel.GetVisibleArea(R);
  869.   X := R.Left;
  870.   Y := R.Top;
  871.   if Orientation = voHorizontal then
  872.     X := X + (Index * Bitmap.Width) + (Index * FSpacing)
  873.   else Y := Y + (Index * Bitmap.Height) + (Index * FSpacing);
  874.   R := Bounds(X, Y, Bitmap.Width, Bitmap.Height);
  875. end;
  877. procedure TVrMatrix.TimerEvent(Sender: TObject);
  878. begin
  879.   if (ScrollInit) then
  880.   begin
  881.     FCharIndex := 1;
  882.     ScrollInit := false;
  883.   end;
  885.   if FScrollDirection = msdRightToLeft then
  886.   begin
  887.     if FStartLed > 0 then Dec(FStartLed)
  888.     else if FCharIndex <= Length(FString.Data) then Inc(FCharIndex)
  889.     else
  890.     begin
  891.       if Assigned(FOnScrollDone) then
  892.         FOnScrollDone(Self);
  893.       FCharIndex := 1;
  894.       FStartLed := FLeds - 1;
  895.     end;
  896.   end
  897.   else
  898.   begin
  899.     if (FCharIndex = 1) and (FStartLed < FLeds-1) then Inc(FStartLed)
  900.     else
  901.     if FCharIndex > 1 then
  902.     begin
  903.       Dec(FCharIndex);
  904.       FStartLed := 0;
  905.     end
  906.     else
  907.     begin
  908.       if Assigned(FOnScrollDone) then
  909.         FOnScrollDone(Self);
  910.       FCharIndex := Length(FString.Data);
  911.       FStartLed := 0;
  912.     end;
  913.   end;
  915.   UpdateLeds(True);
  916. end;
  918. { TVrMatrixGroup }
  920. constructor TVrMatrixGroup.Create(AOwner: TComponent);
  921. begin
  922.   inherited Create(AOwner);
  923.   ControlStyle := ControlStyle + [csOpaque];
  924.   Width := 200;
  925.   Height := 100;
  926.   Color := clBlack;
  927.   ParentColor := false;
  928.   FCols := 15;
  929.   FRows := 7;
  930.   FCharSpacing := 1;
  931.   FLineSpacing := 1;
  932.   FPixelSize := 1;
  933.   FPixelSpacing := 1;
  934.   FScrollDirection := sdRightToLeft;
  935.   FAutoScroll := false;
  936.   FAlignment := taLeftjustify;
  937.   FTextStyle := tsUpperCase;
  938.   FPalette := TVrPalette.Create;
  939.   FPalette.OnChange := PaletteModified;
  940.   FBevel := TVrBevel.Create;
  941.   with FBevel do
  942.   begin
  943.     InnerStyle := bsLowered;
  944.     InnerWidth := 2;
  945.     InnerColor := clBlack;
  946.     OnChange := BevelChanged;
  947.   end;
  948.   FThreaded := True;
  949.   FTimer := TVrTimer.Create(Self);
  950.   with FTimer do
  951.   begin
  952.     FTimer.Enabled := false;
  953.     FTimer.Interval := 500;
  954.     FTimer.OnTimer := TimerEvent;
  955.   end;
  956.   FLines := TStringList.Create;
  957.   TStringList(FLines).OnChange := LinesChanged;
  958.   FLedImage := TBitmap.Create;
  959.   FLedImage.Transparent := false;
  960.   FMatrixImage := TBitmap.Create;
  961.   FMatrixImage.Transparent := false;
  962.   CreateLedImage;
  963.   CreateDataList;
  964. end;
  966. destructor TVrMatrixGroup.Destroy;
  967. begin
  968.   ClearDataList(True);
  969.   FBevel.Free;
  970.   FPalette.Free;
  971.   FTimer.Free;
  972.   FLines.Free;
  973.   FLedImage.Free;
  974.   FMatrixImage.Free;
  975.   inherited Destroy;
  976. end;
  978. procedure TVrMatrixGroup.Loaded;
  979. begin
  980.   inherited Loaded;
  981.   FColorChanged := True;
  982.   CreateLedImage;
  983. end;
  985. procedure TVrMatrixGroup.CreateDataList;
  986. var
  987.   I: Integer;
  988. begin
  989.   if not Assigned(FList) then
  990.     FList := TList.Create;
  991.   ClearDataList(false);
  992.   for I := 0 to (Rows * 2) - 1 do
  993.     FList.Add(TVrMatrixData.Create);
  994. end;
  996. procedure TVrMatrixGroup.ClearDataList(FreeList: Boolean);
  997. var
  998.   I: Integer;
  999. begin
  1000.   for I := 0 to FList.Count - 1 do
  1001.     TVrMatrixData(FList[I]).Free;
  1002.   FList.Clear;
  1003.   if FreeList then
  1004.     FList.Free;
  1005. end;
  1007. procedure TVrMatrixGroup.Reset;
  1008. var
  1009.   I: Integer;
  1010. begin
  1011.   AutoScroll := false;
  1012.   for I := 0 to FList.Count - 1 do
  1013.     TVrMatrixData(FList[I]).Reset;
  1014.   UpdateControlCanvas;
  1015. end;
  1017. procedure TVrMatrixGroup.CreateLedImage;
  1018. var
  1019.   R: TRect;
  1020.   X, Y: Integer;
  1021. begin
  1022.   with FLedImage do
  1023.   begin
  1024.     Width := ((PixelSize + PixelSpacing) * SegX) - PixelSpacing;
  1025.     Height := ((PixelSize + PixelSpacing) * SegY) - PixelSpacing;
  1026.     Canvas.Brush.Color := Self.Color;
  1027.     Canvas.FillRect(Bounds(0, 0, Width, Height));
  1029.     X := 0;
  1030.     while X <= Width do
  1031.     begin
  1032.       Y := 0;
  1033.       while Y <= Height do
  1034.       begin
  1035.         R := Bounds(X, Y, PixelSize, PixelSize);
  1036.         Canvas.Brush.Color := FPalette.Colors[0];
  1037.         Canvas.FillRect(R);
  1038.         Inc(Y, PixelSize + PixelSpacing);
  1039.       end;
  1040.       Inc(X, PixelSize + PixelSpacing);
  1041.     end;
  1042.   end;
  1044.   with FMatrixImage do
  1045.   begin
  1046.     Width := ((FLedImage.Width + FCharSpacing + 1) * FCols) - FCharSpacing;
  1047.     Height := ((FLedImage.Height + FLineSpacing + 1) * FRows) - FLineSpacing;
  1048.     Canvas.Brush.Color := Self.Color;
  1049.     Canvas.FillRect(Bounds(0, 0, Width, Height));
  1051.     X := 0;
  1052.     while X <= Width do
  1053.     begin
  1054.       Y := 0;
  1055.       while Y <= Height do
  1056.       begin
  1057.         Canvas.Draw(X, Y, FLedImage);
  1058.         Inc(Y, FLedImage.Height + LineSpacing + 1);
  1059.       end;
  1060.       Inc(X, FLedImage.Width + CharSpacing + 1);
  1061.     end;
  1062.   end;
  1063. end;
  1065. function TVrMatrixGroup.GetItemRect(Index: Integer): TRect;
  1066. var
  1067.   X, Y: Integer;
  1068. begin
  1069.   X := (Index mod FCols) * (FLedImage.Width + CharSpacing + 1);
  1070.   Y := (Index div FCols) * (FLedImage.Height + LineSpacing + 1);
  1071.   Result := Bounds(FViewPort.Left + X, FViewPort.Top + Y, FLedImage.Width, FLedImage.Height);
  1072. end;
  1074. procedure TVrMatrixGroup.UpdateLed(Index: Integer; Ch: Char; Color: TColor);
  1075. var
  1076.   R, ItemRect: TRect;
  1077.   I, J, Idx, W: Integer;
  1078. begin
  1079.   if Ch = #32 then Exit;
  1080.   with BitmapCanvas do
  1081.   begin
  1082.     ItemRect := GetItemRect(Index);
  1083.     Brush.Color := Color;
  1084.     Idx := ord(Ch) * 7;
  1085.     W := PixelSize;
  1086.     for I := 0 to SegY - 1 do
  1087.       for J := 0 to SegX - 1 do
  1088.       begin
  1089.         if CharState[Idx + I] and (1 shl J) > 0 then
  1090.         begin
  1091.           R := Bounds(ItemRect.Left + FLedImage.Width - W - (J * Succ(PixelSpacing)),
  1092.                       ItemRect.Top + (I * Succ(PixelSpacing)), W, W);
  1093.           FillRect(R);
  1094.         end;
  1095.       end;
  1096.   end;
  1097. end;
  1099. procedure TVrMatrixGroup.UpdateRow(ARow: Integer);
  1100. var
  1101.   Idx, I: Integer;
  1102.   Color: TColor;
  1103.   Data, Colors: string;
  1105.   function GetColorValue(Ch: Char): TColor;
  1106.   var
  1107.     ColorIndex: Integer;
  1108.   begin
  1109.     ColorIndex := 0;
  1110.     case Upcase(Ch) of
  1111.       '0'..'9' : ColorIndex := ord(Ch) - 48;    // 48 = ord('0')
  1112.       'A'..'G' : ColorIndex := ord(Ch) - 55;   // 'A' = 41h = 65d  ; minus 10 = 55d
  1113.     end;
  1114.     if (ColorIndex < 1) or (ColorIndex > 16) then
  1115.          Result := FPalette.High
  1116.       else Result := ColorArray[ColorIndex];
  1117.   end;
  1119. begin
  1120.   if ARow > Rows - 1 then
  1121.     Exit;
  1122.   Data := TVrMatrixData(FList[ARow]).Data;
  1123.   Colors := TVrMatrixData(FList[ARow]).Colors;
  1124.   Idx := ARow * Cols;
  1125.   for I := 1 to Length(Data) do
  1126.   begin
  1127.     Color := GetColorValue(Colors[I]);
  1128.     UpdateLed(Idx, Data[I], Color);
  1129.     Inc(Idx);
  1130.     if Idx >= (ARow * FCols) + FCols then Break;
  1131.   end;
  1132. end;
  1134. procedure TVrMatrixGroup.Paint;
  1135. var
  1136.   I: Integer;
  1137. begin
  1138.   CalcPaintParams;
  1139.   FViewPort := ClientRect;
  1140.   FBevel.Paint(BitmapCanvas, FViewPort);
  1141.   with BitmapCanvas do
  1142.     Draw(FViewPort.Left, FViewPort.Top, FMatrixImage);
  1143.   for I := 0 to Rows - 1 do UpdateRow(I);
  1144.   inherited Paint;
  1145.   //Make sure we first display the control
  1146.   if (not FInitialized) and (AutoScroll) then
  1147.   begin
  1148.     FInitialized := True;
  1149.     FTimer.Enabled := True;
  1150.   end;
  1151. end;
  1153. procedure TVrMatrixGroup.CalcPaintParams;
  1154. var
  1155.   R: TRect;
  1156.   NewWidth, NewHeight: Integer;
  1157. begin
  1158.   R := ClientRect;
  1159.   Bevel.GetVisibleArea(R);
  1160.   NewWidth := FMatrixImage.Width + (R.Left * 2);
  1161.   NewHeight := FMatrixImage.Height + (R.Top * 2);
  1162.   BoundsRect := Bounds(Left, Top, NewWidth, NewHeight);
  1163. end;
  1165. procedure TVrMatrixGroup.TimerEvent(Sender: TObject);
  1166. var
  1167.   I: Integer;
  1168. begin
  1169.   if (FScrollDirection in [sdRightToLeft, sdLeftToRight]) then
  1170.   begin
  1171.     for I := 0 to Rows - 1 do
  1172.         case FScrollDirection of
  1173.           sdRightToLeft: TVrMatrixData(FList[I]).MoveLeft;
  1174.           sdLeftToRight: TVrMatrixData(FList[I]).MoveRight;
  1175.         end;
  1176.   end
  1177.   else
  1178.   if FScrollDirection = sdTopToBottom then
  1179.   begin
  1180.     FList.Add(FList[0]);
  1181.     FList.Delete(0);
  1182.   end
  1183.   else
  1184.   begin
  1185.     FList.Insert(0, FList[FList.Count - 1]);
  1186.     FList.Delete(FList.Count - 1);
  1187.   end;
  1188.   UpdateControlCanvas;
  1189. end;
  1191. procedure TVrMatrixGroup.FormatStrings;
  1192. var
  1193.   S: string;
  1194.   I, MaxLen, Count: Integer;
  1195.   Strings: TStringList;
  1197.   function Center(S: string; Width: Integer): string;
  1198.   var
  1199.     Append: Boolean;
  1200.     Cnt: Integer;
  1201.   begin
  1202.     Result := S;
  1203.     Cnt := CountChars(S);
  1204.     Append := True;
  1205.     while Cnt < Width do
  1206.     begin
  1207.       if Append then Result := Result + #32 else Result := #32 + Result;
  1208.       Append := not Append;
  1209.       Inc(Cnt);
  1210.     end;
  1211.   end;
  1213.   function RightJustify(S: string; Width: Integer): string;
  1214.   var
  1215.     Cnt: Integer;
  1216.   begin
  1217.     Result := S;
  1218.     Cnt := CountChars(S);
  1219.     while Cnt < Width do
  1220.     begin
  1221.       Result := #32 + Result;
  1222.       Inc(Cnt);
  1223.     end;
  1224.   end;
  1226. begin
  1227.   Strings := TStringList.Create;
  1228.   try
  1229.     for I := 0 to Lines.Count - 1 do
  1230.       case Alignment of
  1231.         taCenter: Strings.Add(Center(Lines[I], Cols));
  1232.         taRightJustify: Strings.Add(RightJustify(Lines[I], Cols));
  1233.         else Strings.Add(Lines[I]);
  1234.       end;
  1236.     while Strings.Count < Rows * 2 do Strings.Add(#32);
  1238.     MaxLen := Cols;
  1239.     for I := 0 to Strings.Count - 1 do
  1240.       MaxLen := MaxIntVal(MaxLen, CountChars(Strings[I]));
  1242.     for I := 0 to Strings.Count - 1 do
  1243.     begin
  1244.       S := Strings[I];
  1245.       Count := CountChars(S);
  1246.       while Count < MaxLen + Cols do
  1247.       begin
  1248.         S := S + #32;
  1249.         Inc(Count);
  1250.       end;
  1251.       TVrMatrixData(FList[I]).Decode(S);
  1252.       TVrMatrixData(FList[I]).SetStyle(FTextStyle);
  1253.     end;
  1255.   finally
  1256.     Strings.Free;
  1257.   end;
  1258. end;
  1260. procedure TVrMatrixGroup.PaletteModified(Sender: TObject);
  1261. begin
  1262.   CreateLedImage;
  1263.   UpdateControlCanvas;
  1264. end;
  1266. procedure TVrMatrixGroup.BevelChanged(Sender: TObject);
  1267. begin
  1268.   UpdateControlCanvas;
  1269. end;
  1271. procedure TVrMatrixGroup.LinesChanged(Sender: TObject);
  1272. begin
  1273.   FormatStrings;
  1274.   UpdateControlCanvas;
  1275. end;
  1277. procedure TVrMatrixGroup.SetPalette(Value: TVrPalette);
  1278. begin
  1279.   FPalette.Assign(Value);
  1280. end;
  1282. procedure TVrMatrixGroup.SetBevel(Value: TVrBevel);
  1283. begin
  1284.   FBevel.Assign(Value);
  1285. end;
  1287. procedure TVrMatrixGroup.SetLines(Value: TStrings);
  1288. begin
  1289.   FLines.Assign(Value);
  1290. end;
  1292. procedure TVrMatrixGroup.SetCols(Value: TVrColInt);
  1293. begin
  1294.   if FCols <> Value then
  1295.   begin
  1296.     FCols := Value;
  1297.     CreateLedImage;
  1298.     FormatStrings;
  1299.     UpdateControlCanvas;
  1300.   end;
  1301. end;
  1303. procedure TVrMatrixGroup.SetRows(Value: TVrRowInt);
  1304. begin
  1305.   if FRows <> Value then
  1306.   begin
  1307.     FRows := Value;
  1308.     CreateDataList;
  1309.     CreateLedImage;
  1310.     FormatStrings;
  1311.     UpdateControlCanvas;
  1312.   end;
  1313. end;
  1315. procedure TVrMatrixGroup.SetCharSpacing(Value: Integer);
  1316. begin
  1317.   if FCharSpacing <> Value then
  1318.   begin
  1319.     FCharSpacing := Value;
  1320.     CreateLedImage;
  1321.     UpdateControlCanvas;
  1322.   end;
  1323. end;
  1325. procedure TVrMatrixGroup.SetLineSpacing(Value: Integer);
  1326. begin
  1327.   if FLineSpacing <> Value then
  1328.   begin
  1329.     FLineSpacing := Value;
  1330.     CreateLedImage;
  1331.     UpdateControlCanvas;
  1332.   end;
  1333. end;
  1335. procedure TVrMatrixGroup.SetPixelSize(Value: Integer);
  1336. begin
  1337.   if FPixelSize <> Value then
  1338.   begin
  1339.     FPixelSize := Value;
  1340.     CreateLedImage;
  1341.     UpdateControlCanvas;
  1342.   end;
  1343. end;
  1345. procedure TVrMatrixGroup.SetPixelSpacing(Value: Integer);
  1346. begin
  1347.   if FPixelSpacing <> Value then
  1348.   begin
  1349.     FPixelSpacing := Value;
  1350.     CreateLedImage;
  1351.     UpdateControlCanvas;
  1352.   end;
  1353. end;
  1355. procedure TVrMatrixGroup.SetAutoScroll(Value: Boolean);
  1356. begin
  1357.   if FAutoScroll <> Value then
  1358.   begin
  1359.     FAutoScroll := Value;
  1360.     UpdateControlCanvas;
  1361.     if not (Designing or Loading) then
  1362.       FTimer.Enabled := Value;
  1363.   end;
  1364. end;
  1366. procedure TVrMatrixGroup.SetAlignment(Value: TAlignment);
  1367. begin
  1368.   if FAlignment <> Value then
  1369.   begin
  1370.     FAlignment := Value;
  1371.     FormatStrings;
  1372.     if (Designing) or (not FAutoScroll) then
  1373.       UpdateControlCanvas;
  1374.   end;
  1375. end;
  1377. procedure TVrMatrixGroup.SetTextStyle(Value: TVrMatrixTextStyle);
  1378. begin
  1379.   if FTextStyle <> Value then
  1380.   begin
  1381.     FTextStyle := Value;
  1382.     FormatStrings;
  1383.     UpdateControlCanvas;
  1384.   end;
  1385. end;
  1387. procedure TVrMatrixGroup.SetThreaded(Value: Boolean);
  1388. begin
  1389.   if FThreaded <> Value then
  1390.   begin
  1391.     FThreaded := Value;
  1392.     if Value then FTimer.TimerType := ttThread
  1393.     else FTimer.TimerType := ttSystem;
  1394.   end;
  1395. end;
  1397. procedure TVrMatrixGroup.SetTimeInterval(Value: Integer);
  1398. begin
  1399.   FTimer.Interval := Value;
  1400. end;
  1402. function TVrMatrixGroup.GetTimeInterval: Integer;
  1403. begin
  1404.   Result := FTimer.Interval;
  1405. end;
  1407. procedure TVrMatrixGroup.CMColorChanged(var Message: TMessage);
  1408. begin
  1409.   inherited;
  1410.   if FColorChanged then
  1411.   begin
  1412.     CreateLedImage;
  1413.     UpdateControlCanvas;
  1414.   end;
  1415. end;
  1418. end.