[mortenbs.com home]
Music
Music
IT
IT
Videos
Videos
Contact
Contact
[icon] LedPanel (TLedPanel) | Delphi programming | mortenbs.com
Last updated July 2010.

TLedPanel component for Delphi is simple and easy to use.

[TLedPanel Demo]
[icon] Download delphi source 210 Kb | D7

A small demo project is included in the archive.


TLedPanel v1.0 unit
unit ledPanel;

interface

//TLedPanel v1.0, mortenbs.com
//Last updated: 2010-05-16

uses
 windows,classes,controls,graphics;

{$R ledPanel.dcr}

type
 ptr=pointer;
 lInt=longInt;
 str=ansiString;
 tLedMode=(lmMulti,lmSingle,lmSingleForced);
 tTextMode=(tmAutoNumb,tmDisabled,tmManual,tmCommon);
 pPtrList=^tPtrList;
 tPtrList=array[0..MAXINT div 16-1] of ptr;
 tSimpleEvent=procedure of object;
//-----------------------------|----------------|----------------------|----------------------------
 tLed=class public
  text                         :str;
  state                        :boolean;
  colorBgOn,colorBgOff         :tColor;
  colorFontOn,colorFontOff     :tColor;
  txtW,txtH,x1,y1,x2,y2        :lInt;
 end;
//-----------------------------|----------------|----------------------|----------------------------
 tLeds=class
  procedure clear;
  function validId(id:lInt):boolean;
  function add(aLed:tLed):lInt;
  procedure delete(id:lInt);
 private
  fCount,fCapacity             :lInt;
  procedure setCapacity(i:lInt);
  procedure setCount(i:lInt);
  procedure grow;
 public
  fList                        :pPtrList;
  destructor destroy;override;
  property count               :lInt           read fCount            write setCount;
 end;
//-----------------------------|----------------|----------------------|----------------------------
 tLedPanel=class(tCustomControl)
  function isSingleLed(b:byte):boolean;         //In single-led mode this is the current LED
  function findLed(x,y:lInt):lInt;              //Position to led-ID
  function getLedState(id:byte):boolean;        //Get led state (any mode)
  procedure setLedState(id:lInt;bl:boolean);    //Set led state (any mode)
  procedure invLedState(id:byte);               //Inverse led state (multi)
  procedure updateLedColors;
 private
  fHintMode                    :tTextMode;      //Hint mode
  fLedMode                     :tLedMode;       //Led Mode (multi/single/singleForced)
  fManualText                  :tStringList;    //Led text (manual text mode)
  fTextMode                    :tTextMode;      //Text mode (autoNumb,disabled,manual,common)
  fCommonText                  :str;            //Common text for all leds (common text mode)
  fFontSize,fLedSize           :byte;           //Font-size, LED-size
  fLedCount,fSingleLed         :byte;           //LED-Count, Single LED id (single/singleForced)
  fFontName                    :tFontName;      //Font name
  fUseMouse                    :boolean;        //Enable mouse support
  fVertical,fAutoSize,started  :boolean;        //Vertical panel, Auto size
  fColorBgOn,fColorBgOff       :tColor;         //Default colors (LEDs background)
  fColorFontOn,fColorFontOff   :tColor;         //Default colors (LEDs font)
  fColorBorder                 :tColor;         //Panel borders color
  fOnStateChange               :tSimpleEvent;   //Event when a LED-state is changed
  using_text,using_multi       :boolean;        //Internal use
  invert_from                  :boolean;        //Internal use
  mouse_led,last_mouse_led     :lInt;           //Internal use
  procedure setColorBorder(aColor:tColor);
  function getLedText(id:lInt):str;
  function getFirstLedState:boolean;
  procedure setFirstLedState(bl:boolean);
  procedure setVertical(bl:boolean);
  procedure setAutoSize(bl:boolean);reintroduce;
  procedure setColorBgOff(aColor:tColor);
  procedure setColorBgOn(aColor:tColor);
  procedure setColorFontOff(aColor:tColor);
  procedure setColorFontOn(aColor:tColor);
  procedure setCommonText(s:str);
  procedure setFontName(s:tFontName);
  procedure setFontSize(b:byte);
  procedure setLedCount(b:byte);
  procedure setSingleLed(b:byte);
  procedure setLedSize(aSize:byte);
  procedure setManualText(sl:tStringList);
  procedure setTextMode(aMode:tTextMode);
  procedure setLedMode(lm:tLedMode);
  procedure setHintMode(lm:tTextMode);
 protected
  procedure reSize;override;
  procedure paint;override;
  procedure mouseDown(button:tMouseButton;shift:tShiftState;x,y:integer);override;
  procedure mouseMove(shift:tShiftState;x,y:integer);override;
 public
  leds                         :tLeds;          //Leds list
  constructor create(aOwner:tComponent);override;
  destructor destroy;override;
  procedure rePaint;override;
  procedure notifyStateChanged;
 published
  property align;
  property cursor;
  property showHint;
  property visible;
  property popUpMenu;
  property autoSize            :boolean         read fAutoSize         write setAutoSize;
  property commonText          :str             read fCommonText       write setCommonText;
  property colorBorder         :tColor          read fColorBorder      write setColorBorder;
  property colorBgOff          :tColor          read fColorBgOff       write setColorBgOff;
  property colorBgOn           :tColor          read fColorBgOn        write setColorBgOn;
  property colorFontOff        :tColor          read fColorFontOff     write setColorFontOff;
  property colorFontOn         :tColor          read fColorFontOn      write setColorFontOn;
  property firstLed            :boolean         read getFirstLedState  write setFirstLedState;
  property fontName            :tFontName       read fFontName         write setFontName;
  property fontSize            :byte            read fFontSize         write setFontSize;
  property ledCount            :byte            read fLedCount         write setLedCount;
  property ledMode             :tLedMode        read fLedMode          write setLedMode;
  property ledSize             :byte            read fLedSize          write setLedSize;
  property manualText          :tStringList     read fManualText       write setManualText;
  property singleLed           :byte            read fSingleLed        write setSingleLed;
  property textMode            :tTextMode       read fTextMode         write setTextMode;
  property hintMode            :tTextMode       read fHintMode         write setHintMode;
  property vertical            :boolean         read fVertical         write setVertical;
  property useMouse            :boolean         read fUseMouse         write fUseMouse;
  property onStateChange       :tSimpleEvent    read fOnStateChange    write fOnStateChange;
  property onMouseMove;
  property onMouseDown;
  property onMouseUp;
 end;
//-----------------------------|----------------|----------------------|----------------------------

function allIsOn(aLeds:tLedPanel):boolean;
function allIsOff(aLeds:tLedPanel):boolean;

//...
procedure Register;

implementation

uses
 sysUtils,forms;

function allIsOn(aLeds:tLedPanel):boolean;
var i:lInt;
begin result:=false;if aLeds.fLedMode<>lmMulti then exit;
 for i:=0 to aLeds.leds.count-1 do if not tLed(aLeds.leds.fList^[i]).state then exit;result:=true
end;

function allIsOff(aLeds:tLedPanel):boolean;
var i:lInt;
begin result:=false;if aLeds.fLedMode<>lmMulti then exit;
 for i:=0 to aLeds.leds.count-1 do if tLed(aLeds.leds.fList^[i]).state then exit;result:=true
end;

//------------------------------------------------------------------------------------------------
//tLeds:

destructor tLeds.destroy;
begin clear;inherited destroy end;

function tLeds.validId(id:lInt):boolean;
begin result:=(id>-1) and (id<fCount) end;

procedure tLeds.clear;
begin if fCount=0 then exit;
 while fCount>0 do delete(fCount-1);
 setCount(0);setCapacity(0)
end;

function tLeds.add(aLed:tLed):lInt;
begin result:=fCount;if result=fCapacity then grow;
 fList^[result]:=ptr(aLed);inc(fCount)
end;

procedure tLeds.delete(id:lInt);
begin
 if fList^[id]<>nil then begin tLed(fList^[id]).free;fList^[id]:=nil end;
 dec(fCount);if id<fCount then system.move(fList^[id+1],fList^[id],(fCount-id)*sizeOf(ptr))
end;

procedure tLeds.setCount(i:lInt);
var c:lInt;
begin
 if i<0 then i:=0 else if i>255 then i:=255;
 if i>fCapacity then setCapacity(i);
 if i>fCount then fillChar(fList^[fCount],(i-fCount)*sizeOf(ptr),0) else
 for c:=fCount-1 downto i do delete(c);fCount:=i
end;

procedure tLeds.grow;var i:lInt;
begin
 if fCapacity>64 then i:=fCapacity div 4 else
 if fCapacity>8 then i:=16 else i:=4;
 setCapacity(fCapacity+i)
end;

procedure tLeds.setCapacity(i:lInt);
begin
 if i=fCapacity then exit;
 if i<fCount then i:=fCount;if i>255 then i:=255;
 reAllocMem(fList,i*sizeOf(ptr));fCapacity:=i
end;

//------------------------------------------------------------------------------------------------
//tLedPanel:

constructor tLedPanel.create(aOwner:tComponent);//override;
begin started:=false;
 if not assigned(fManualText) then fManualText:=tStringList.create;
 inherited create(aOwner);parent:=(aOwner as tWinControl);
 controlStyle:=[csAcceptsControls,csCaptureMouse,csClickEvents,csSetCaption];
 doubleBuffered:=true;tabStop:=false;useDockManager:=true;
 fFontName:='Tahoma';fFontSize:=8;fSingleLed:=0;fLedCount:=5;
 fVertical:=false;fAutoSize:=true;fLedSize:=14;fUseMouse:=true;
 fColorBgOn:=$0060DD60;fColorBgOff:=$001C621C;
 fColorFontOn:=$00000000;fColorFontOff:=$00FFFFFF;fColorBorder:=$00000000;
 using_text:=false;using_multi:=false;invert_from:=false;mouse_led:=-1;last_mouse_led:=-1;

 leds:=tLeds.create;
 if leds.fCount=0 then begin fLedMode:=lmMulti;fTextMode:=tmAutoNumb;
  setHintMode(tmAutoNumb);if not fVertical then height:=13 else if width<1 then width:=fLedSize
 end;

 started:=true;
 setLedCount(fLedCount)
end;

destructor tLedPanel.destroy;begin started:=false;leds.free;fManualText.free;inherited destroy end;
procedure tLedPanel.notifyStateChanged;begin invalidate;if assigned(fOnStateChange) then fOnStateChange end;
procedure tLedPanel.rePaint;begin invalidate end;
procedure tLedPanel.setFontName(s:tFontName);begin fFontName:=s;reSize end;
procedure tLedPanel.setFontSize(b:byte);begin fFontSize:=b;reSize end;
procedure tLedPanel.setHintMode(lm:tTextMode);begin fHintMode:=lm;inherited showHint:=lm<>tmDisabled end;
function tLedPanel.isSingleLed(b:byte):boolean;begin result:=fSingleLed=b end;
procedure tLedPanel.setCommonText(s:str);begin fCommonText:=s;reSize end;
procedure tLedPanel.setColorBorder(aColor:tColor);begin fColorBorder:=aColor;reSize end;
procedure tLedPanel.setColorBgOff(aColor:tColor);begin fColorBgOff:=aColor;color:=aColor;updateLedColors end;
procedure tLedPanel.setColorBgOn(aColor:tColor);begin fColorBgOn:=aColor;updateLedColors end;
procedure tLedPanel.setColorFontOff(aColor:tColor);begin fColorFontOff:=aColor;updateLedColors end;
procedure tLedPanel.setColorFontOn(aColor:tColor);begin fColorFontOn:=aColor;updateLedColors end;
procedure tLedPanel.setAutoSize(bl:boolean);begin fAutoSize:=bl;reSize end;
procedure tLedPanel.invLedState(id:byte);begin setLedState(id,not getLedState(id)) end;
procedure tLedPanel.setLedSize(aSize:byte);begin fLedSize:=aSize;reSize end;
procedure tLedPanel.setTextMode(aMode:tTextMode);begin fTextMode:=aMode;reSize end;
procedure tLedPanel.setManualText(sl:tStringList);begin fManualText.text:=sl.text;reSize end;
procedure tLedPanel.setFirstLedState(bl:boolean);begin setLedState(1,bl) end;

function tLedPanel.getLedState(id:byte):boolean;
begin result:=leds.validId(id-1) and tLed(leds.fList^[id-1]).state end;

function tLedPanel.getFirstLedState:boolean;
begin if fLedMode=lmMulti then result:=getLedState(1) else result:=fSingleLed=1 end;

function tLedPanel.getLedText(id:lInt):str;
begin result:='';
 case fTextMode of
  tmAutoNumb:result:=intToStr(id+1);
  tmCommon:result:=fCommonText;
  tmManual:if (id>-1) and (id<fManualText.count) then result:=fManualText.strings[id]
 end
end;

procedure tLedPanel.setVertical(bl:boolean);
var i:lInt;
begin if bl=fVertical then exit;
 fVertical:=bl;i:=width;height:=width;width:=i;reSize
end;

procedure tLedPanel.updateLedColors;
var i:lInt;
begin
 for i:=0 to leds.count-1 do with tLed(leds.fList^[i]) do begin
  colorBgOn:=self.fColorBgOn;
  colorBgOff:=self.fColorBgOff;
  colorFontOn:=self.fColorFontOn;
  colorFontOff:=self.fColorFontOff;
 end;reSize
end;

procedure tLedPanel.reSize;
var i,tW,tH,stPos,amount:lInt;
begin if not started then exit;stPos:=0;tW:=0;tH:=0;
 using_text:=fTextMode<>tmDisabled;using_multi:=fLedMode=lmMulti;
 canvas.font.name:=fFontName;canvas.font.size:=fFontSize;

 for i:=0 to leds.fCount-1 do with tLed(leds.fList^[i]) do begin
  text:=getLedText(i);with canvas.textExtent(text) do begin txtW:=cX;txtH:=cY;tW:=cX;tH:=cY end;
  if fVertical then begin x1:=0;x2:=self.width;y1:=stPos;
   if fAutoSize then y2:=y1+txtH+6 else y2:=y1+fLedSize+2;amount:=y2-y1
  end else begin y1:=0;y2:=self.height;x1:=stPos;
   if fAutoSize then x2:=stPos+txtW+6 else x2:=x1+fLedSize+2;amount:=x2-x1
  end;inc(stPos,amount-1)
 end;

 if stPos>0 then if fVertical then height:=stPos+1 else width:=stPos+1;
 if fAutoSize then if fVertical then width:=tW+1 else height:=tH+1;
 invalidate
end;

procedure tLedPanel.paint;//override;
var i:lInt;aState:boolean;
begin if not (started and visible) then exit;
 with canvas,leds do for i:=0 to fCount-1 do with tLed(fList^[i]) do begin
  if using_multi then aState:=state else aState:=i=fSingleLed-1;
  brush.style:=bsSolid;pen.color:=fColorBorder;
  if aState then brush.color:=colorBgOn else brush.color:=colorBgOff;
  rectangle(x1,y1,x2,y2);if (text='') or not using_text then continue;
  if aState then font.color:=colorFontOn else font.color:=colorFontOff;brush.style:=bsClear;
  textOut(x1+trunc(((x2-x1)/2)-(txtW/2)),y1+trunc(((y2-y1)/2)-(txtH/2)),text);
 end
end;

procedure tLedPanel.setLedCount(b:byte);
var aLed:tLed;
begin
 if b<1 then b:=1;fLedCount:=b;
 while leds.count>b do leds.delete(leds.fCount-1);
 while leds.count<b do begin
  aLed:=tLed.create;aLed.state:=false;aLed.text:='';
  aLed.colorBgOn:=fColorBgOn;aLed.colorBgOff:=fColorBgOff;
  aLed.colorFontOn:=fColorFontOn;aLed.colorFontOff:=fColorFontOff;
  leds.add(aLed)
 end;reSize
end;

procedure tLedPanel.setLedState(id:lInt;bl:boolean);
var doNotify:boolean;
begin if fLedMode<>lmMulti then begin setSingleLed(id);exit end;doNotify:=false;
 if leds.validId(id-1) then with tLed(leds.fList^[id-1]) do begin doNotify:=state<>bl;state:=bl end;
 if doNotify then notifyStateChanged
end;

function tLedPanel.findLed(x,y:lInt):lInt;
var i:lInt;
begin for i:=0 to leds.fCount-1 do with tLed(leds.fList^[i]) do
 if (x>=x1) and (x<=x2) and (y>=y1) and (y<=y2) then begin result:=i;exit end;result:=-1
end;

procedure tLedPanel.mouseDown(button:tMouseButton;shift:tShiftState;x,y:integer);//override;
begin if (button<>mbLeft) or not fUseMouse then exit;
 if fLedMode=lmMulti then setLedState(mouse_led,not invert_from) else
 if (fLedMode=lmSingleForced) and isSingleLed(0) then setSingleLed(1) else setSingleLed(mouse_led);
 if assigned(onMouseDown) then onMouseDown(self,button,shift,x,y)
end;

procedure tLedPanel.mouseMove(shift:tShiftState;x,y:integer);//override;
var s:str;p:tPoint;
begin
 if fVertical then mouse_led:=findLed(width,y)+1 else mouse_led:=findLed(x,height)+1;
 if getKeyState(VK_LBUTTON)>=0 then begin
 if fLedMode=lmMulti then invert_from:=getLedState(mouse_led) else invert_from:=isSingleLed(mouse_led)
 end else if last_mouse_led<>mouse_led then mouseDown(mbLeft,[],x,y);
 last_mouse_led:=mouse_led;s:=hint;
 case fHintMode of
  tmCommon:hint:=fCommonText;
  tmAutoNumb:hint:='Led: '+intToStr(mouse_led);
  tmManual:if (mouse_led>-1) and (mouse_led<fManualText.count) then hint:=fManualText[mouse_led] else hint:='-'
 end;
 if s<>hint then with application do begin cancelHint;getCursorPos(p);activateHint(p) end;
 if assigned(onMouseMove) then onMouseMove(self,shift,x,y)
end;

procedure tLedPanel.setSingleLed(b:byte);
var v:byte;
begin
 if fLedMode=lmSingleForced then v:=1 else v:=0;
 if (b=fSingleLed) or (b<v) or (b>fLedCount) then exit;
 fSingleLed:=b;notifyStateChanged
end;

procedure tLedPanel.setLedMode(lm:tLedMode);
begin fLedMode:=lm;
 if (fLedMode=lmSingleForced) and isSingleLed(0) then setSingleLed(1) else invalidate
end;

//...
procedure Register;
begin
 registerComponents('Standard', [tLedPanel]);
end;

end.
Delphi source HTML generated by PAS to HTM | Mini converter, mortenbs.com




Demo form
unit Unit1;

interface

uses
  windows,ledPanel,classes,controls,graphics,forms, stdCtrls, extCtrls;

type
  TForm1 = class(TForm)
    led1: tLedPanel;
    led6: tLedPanel;
    led2: tLedPanel;
    led3: tLedPanel;
    led4: tLedPanel;
    led5: tLedPanel;
    Label1: TLabel;
    ledOptions: tLedPanel;
    Timer1: TTimer;
    vu1L: tLedPanel;
    vu1R: tLedPanel;
    vu2L: tLedPanel;
    vu2R: tLedPanel;
    procedure ledOptionsStateChange;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    fStep:byte;
    mode1,mode2,mode3,mode4,mode5,mode6:boolean;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin doubleBuffered:=true;randomize;
 ledOptions.setLedState(1,true);
 ledOptions.setLedState(2,true);
 ledOptions.onStateChange:=ledOptionsStateChange;
 ledOptionsStateChange;
 mode1:=true;mode2:=true;mode3:=true;mode4:=true;mode5:=true;
 vu1L.width:=37;vu1R.width:=37;vu2L.width:=37;vu2R.width:=37;
 Timer1.interval:=50;
 Timer1.enabled:=true;
end;

procedure TForm1.ledOptionsStateChange;
var blA,blB:boolean;
begin
 blA:=ledOptions.getLedState(1);Timer1.enabled:=blA;
 blB:=ledOptions.getLedState(2);
 led1.useMouse:=blB;
 led2.useMouse:=blB;
 led3.useMouse:=blB;
 led4.useMouse:=blB;
 led5.useMouse:=blB;
 led6.useMouse:=blB;
 if not blA then begin mode1:=false;mode2:=false;mode3:=false;mode4:=false;mode5:=false end;
end;

function maybe:boolean;
begin result:=random(1+1)=1 end;

function randomRange(aMin,aMax:lInt):lInt;
begin result:=random(aMax-(aMin-1))+aMin end;

function randomColor(aMinR,aMaxR,aMinG,aMaxG,aMinB,aMaxB:byte):tColor;
begin
 result:=(random(aMaxR-(aMinR-1))+aMinR)
      or ((random(aMaxG-(aMinG-1))+aMinG) shl 8)
      or ((random(aMaxB-(aMinB-1))+aMinB) shl 16)
end;

function manageRandomLeds(aLeds:tLedPanel;var aMode:boolean):lInt;
var i,c,v:lInt;bl:boolean;
begin result:=-1;c:=0;
 for i:=0 to aLeds.leds.count-1 do if tLed(aLeds.leds.fList^[i]).state<>aMode then inc(c);
 if c>0 then v:=randomRange(1,c) else exit;c:=0;
 for i:=0 to aLeds.leds.count-1 do with tLed(aLeds.leds.fList^[i]) do begin
  if state<>aMode then inc(c);if c=v then begin state:=aMode;aLeds.rePaint;break end
 end;
 if aMode then bl:=allIsOn(aLeds) else bl:=allIsOff(aLeds);
 if bl then aMode:=not aMode;
end;

procedure manageLedPos(aLeds:tLedPanel;var aMode:boolean);
var id:lInt;bl:boolean;
begin
 id:=aLeds.singleLed;
 if aMode then inc(id) else dec(id);
 if aMode then bl:=id>aLeds.ledCount else bl:=id<1;
 if bl then aMode:=not aMode;
 aLeds.singleLed:=id;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i,v:lInt;
begin
 if maybe then manageRandomLeds(led1,mode1);
 if maybe then manageRandomLeds(led2,mode2);
 manageLedPos(led3,mode3);
 manageLedPos(led4,mode4);
 manageLedPos(led5,mode5);

 manageLedPos(vu1L,mode6);vu2L.setLedState(vu2L.ledCount,true);
 manageLedPos(vu1R,mode6);vu2R.setLedState(vu2R.ledCount,true);

 v:=vu1L.singleLed;for i:=1 to vu2L.leds.count do tLed(vu2L.leds.fList[i-1]).state:=i>=v;
 v:=vu1R.singleLed;for i:=1 to vu2R.leds.count do tLed(vu2R.leds.fList[i-1]).state:=i>=v;
 vu2L.rePaint;vu2R.rePaint;

 inc(fStep);
 if fStep>49 then begin fStep:=0;
  vu1L.singleLed:=randomRange(1,vu1L.ledCount);
  vu1R.singleLed:=randomRange(1,vu1R.ledCount);
 end;
end;

end.
Delphi source HTML generated by PAS to HTM | Mini converter, mortenbs.com


See also
[icon] Delphi programming - Basics, Components, links...
[icon] IT - IT/Technology. Various projects and information about computer technology and electronic...


[icon] mortenbs.com