iagaloled.pas

delphi 3d led component It provides 3d led component with source codes. you can make leds with

unit IAgaloLED;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,Math,extctrls;

type
  TIALedClass = (ialcRect,ialcRound,ialcRomb,ialcHalfCircle,ialcTriangle,ialcTrapezium);
  TIABorderLedStyle = (iablsUp,iablsDown,iablsNone);
  TIAglPoly = array of TPoint;
  TIAxyRealPoint = record
    x : double;
    y : double;
  end;
  TIAxyPoly = array of TIAxyRealPoint;
  TIAglSubstanceMode = (iasmTile,iasmStretch);
  TIAgaloLED = class(TCustomControl)
  private
    FLedClass: TIALedClass;
    FLedPlasticDepth: integer;
    FInnerBorderDepth: integer;
    FAngle: integer;
    FGap: integer;
    FOuterBorderDepth: integer;
    FBorderSubstance: TBitmap;
    FBorderL,FBorderD : TBitmap;
    FLedPlasticSubstance: TBitmap;
    FBorderColor: TColor;
    FLedPlasticColor: TColor;
    FOuterBorderStyle: TIABorderLedStyle;
    FInnerBorderStyle: TIABorderLedStyle;
    FLedOn: Boolean;
    FLedHeight: integer;
    FLedWidth: integer;
    FLastHeight: integer;
    FLastWidth : integer;
    FLedPoints : TIAglPoly;
    FGapPoints : TIAglPoly;
    FInnerPoints : TIAglPoly;
    FOuterPoints : TIAglPoly;
    FLedPointsxy : TIAxyPoly;
    FGapPointsxy : TIAxyPoly;
    FInnerPointsxy : TIAxyPoly;
    FOuterPointsxy : TIAxyPoly;
    FPaintBitmap : TBitmap;
    FGapColor: TColor;
    FLedPlasticSubsMode: TIAglSubstanceMode;
    FBorderSubsMode: TIAglSubstanceMode;
    FGaloON: Boolean;
    FGaloONwas : Boolean;
    FGaloSize: integer;
    FGaloIntensity: integer;


    procedure DefineWidthHeight;
    procedure WMSIZE(var Message : TMessage);message WM_SIZE;
    procedure WMMOVE(var Message : TMessage);message WM_MOVE;
    procedure DefinePointArrays;
    procedure reinsertpoints;
    procedure RotatePolyPoints(Var Apoly : TIAxyPoly);
    procedure GetPaintBitmap;
    function  AngleIsDark(AAngle : Integer): Boolean;

    procedure SetBorderSubstance(Value: TBitmap);
    procedure SetLedPlasticSubstance(Value: TBitmap);
  protected
    { Protected declarations }
    procedure Paint; override;
    procedure CreateHandle; override;
    procedure Loaded; override;

    procedure SetHeight(Value: Integer);virtual;
    procedure SetWidth(Value: Integer);virtual;
    function GetHeight: integer;virtual;
    function GetWidth: integer;virtual;
    procedure SetLedClass(Value: TIALedClass);virtual;
    procedure SetAngle(Value: integer); virtual;
    procedure SetBorderColor(Value: TColor);    virtual;

    procedure SetGap(Value: integer);virtual;
    procedure SetInnerBorderDepth(Value: integer);virtual;
    procedure SetInnerBorderStyle(Value: TIABorderLedStyle);virtual;
    procedure SetGapColor(Value: TColor);virtual;

    procedure SetLedPlasticColor(Value: TColor);virtual;
    procedure SetLedPlasticDepth(Value: integer);virtual;

    procedure SetOuterBorderDepth(Value: integer);virtual;
    procedure SetOuterBorderStyle(Value: TIABorderLedStyle);virtual;
    procedure SetLedOn(Value: Boolean);virtual;
    procedure SetLedHeight(Value: integer);virtual;
    procedure SetLedWidth(Value: integer);virtual;
    procedure SetLedPlasticSubsMode(Value: TIAglSubstanceMode);virtual;
    procedure SetBorderSubsMode(Value: TIAglSubstanceMode);virtual;
    procedure SetGaloON(Value: Boolean);virtual;
    procedure SetGaloSize(Value: integer);virtual;
    procedure SetGaloIntensity(Value: integer);virtual;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;


  published
    { Published declarations }
    property BorderSubstance     : TBitmap read FBorderSubstance     write SetBorderSubstance     default nil;
    property LedPlasticSubstance : TBitmap read FLedPlasticSubstance write SetLedPlasticSubstance default nil;
    property Width: Integer read GetWidth write SetWidth default 24;
    property Height: Integer read GetHeight write SetHeight default 14;
    property LedClass : TIALedClass read FLedClass write SetLedClass default ialcRect;
    property LedPlasticDepth : integer read FLedPlasticDepth write SetLedPlasticDepth default 5;

    property Gap : integer read FGap write SetGap default 0;
    property GapColor : TColor read FGapColor write SetGapColor default clGray;
    property Angle : integer read FAngle write SetAngle default 0;
    property InnerBorderStyle : TIABorderLedStyle read FInnerBorderStyle write SetInnerBorderStyle default iablsNone;
    property OuterBorderStyle : TIABorderLedStyle read FOuterBorderStyle write SetOuterBorderStyle default iablsDown;
    property InnerBorderDepth : integer read FInnerBorderDepth write SetInnerBorderDepth default 0;
    property OuterBorderDepth : integer read FOuterBorderDepth write SetOuterBorderDepth default 2;
    property BorderColor : TColor read FBorderColor write SetBorderColor default clGray;
    property LedPlasticColor : TColor read FLedPlasticColor write SetLedPlasticColor default clRed;

    property LedOn : Boolean read FLedOn write SetLedOn;
    property LedWidth : integer read FLedWidth write SetLedWidth;
    property LedHeight : integer read FLedHeight write SetLedHeight;
    property LedPlasticSubsMode : TIAglSubstanceMode read FLedPlasticSubsMode write SetLedPlasticSubsMode default iasmTile;
    property BorderSubsMode : TIAglSubstanceMode read FBorderSubsMode write SetBorderSubsMode default iasmTile;
    property GaloON : Boolean read FGaloON write SetGaloON default false;
    property GaloSize : integer read FGaloSize write SetGaloSize default 10;
    property GaloIntensity : integer read FGaloIntensity write SetGaloIntensity default 5;

    property Anchors;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('TIA', [TIAgaloLED]);
end;
function GetDColor(Value : Tcolor): Tcolor;
var
  pR,pB,pG : pByte;
begin
  result:=colortoRGB(Value);
  pR:=@result;
  pG:=pByte(integer(pR)+1);
  pB:=pByte(integer(pG)+1);
  if pR^<32 then pR^:=0 else dec(pR^,32);
  if pG^<32 then pG^:=0 else dec(pG^,32);
  if pB^<32 then pB^:=0 else dec(pB^,32);
end;
function GetLColor(Value : Tcolor): Tcolor;
var
  pR,pB,pG : pByte;
begin
  result:=colortoRGB(Value);
  pR:=@result;
  pG:=pByte(integer(pR)+1);
  pB:=pByte(integer(pG)+1);
  if pR^>223 then pR^:=255 else inc(pR^,32);
  if pG^>223 then pG^:=255 else inc(pG^,32);
  if pB^>223 then pB^:=255 else inc(pB^,32);
end;
procedure Dark24Bitmap(var B : TBitmap;N : integer);
var
  i,j : integer;
  pB : PByteArray;
begin
  for i:=0 to B.Height-1 do
   begin
     pb:=B.ScanLine[i];
     for j:=0 to 3*B.Width-1 do
       begin
         if pb[j]<n then pb[j]:=0 else dec(pb[j],n);
       end;
   end;
end;

procedure Light24Bitmap(var B : TBitmap;N : integer);
var
  i,j : integer;
  pB : PByteArray;
begin
  for i:=0 to B.Height-1 do
   begin
     pb:=B.ScanLine[i];
     for j:=0 to 3*B.Width-1 do
       begin
         if pb[j]>(255-n) then pb[j]:=255 else inc(pb[j],n);
       end;
   end;
end;
{ TIAgaloLED }

function TIAgaloLED.AngleIsDark(AAngle: Integer): Boolean;
var s1,c1 : double;
begin
  s1:=sin(AAngle*pi/1800);c1:=cos(AAngle*pi/1800);
  if (S1>0) then
    begin
      if C1>-1/sqrt(2) then  result:=false else result:=true;
    end else
    begin
      if C1>1/sqrt(2) then result:=false else result:=true;
    end;
end;

constructor TIAgaloLED.Create(AOwner: TComponent);
begin
  inherited create(AOwner);
  inherited width:=24;
  inherited height:=14;
  FLedWidth:=22;
  FLedHeight:=12;
  FLedclass:=ialcRect;
  FGaloONwas:=false;

  FLedPlasticDepth:=5;
  FInnerBorderDepth:=0;
  FAngle:=0;
  FGap:=0;
  FOuterBorderDepth:=2;

  FBorderSubstance    :=TBitmap.create;
  FLedPlasticSubstance:=TBitmap.create;
  FBorderL:=TBitmap.create;
  FBorderD:=TBitmap.create;
  FBorderSubstance.PixelFormat:=pf24bit;
  FLedPlasticSubstance.PixelFormat:=pf24bit;
  FBorderL.PixelFormat:=pf24bit;
  FBorderD.PixelFormat:=pf24bit;

  FBorderColor:=clGray;
  FGapColor:=clGray;
  FLedPlasticColor:=clRed;
  FOuterBorderStyle:=iablsDown;
  FInnerBorderStyle:=iablsNone;
  FPaintBitmap := TBitmap.Create;
  FPaintBitmap.PixelFormat:=pf24bit;
  FPaintBitmap.Width:=24;
  FPaintBitmap.Height:=14;
  FLedPlasticSubsMode:=iasmTile;
  FBorderSubsMode:=iasmTile;
  FGaloON:=false;
  FGaloSize:=10;
  FGaloIntensity:=5;
end;

procedure TIAgaloLED.CreateHandle;
begin
  inherited CreateHandle;
  ControlStyle:=ControlStyle+[csOpaque];
  DefinePointArrays;
end;

procedure TIAgaloLED.DefinePointArrays;
var dX,N,i : integer;
    RGN : HRGN;
    x,y : double;
begin
  Dx:=FGap;
  if FInnerBorderStyle<>iablsNone then inc(dX,FInnerBorderDepth);
  if FOuterBorderStyle<>iablsNone then inc(dX,FOuterBorderDepth);
  case FLedClass of
    ialcRect :
      begin
        setlength(FLedPointsxy  ,4);
        setlength(FGapPointsxy  ,4);
        setlength(FInnerPointsxy,4);
        setlength(FOuterPointsxy,4);
        FLedPointsxy[0].x:=dx;FLedpointsxy[0].y:=dx;
        FLedPointsxy[1].x:=dx+FLedWidth;FLedpointsxy[1].y:=dx;
        FLedPointsxy[2].x:=dx+FLedWidth;FLedpointsxy[2].y:=dx+FLedHeight;
        FLedPointsxy[3].x:=dx;FLedpointsxy[3].y:=dx+FledHeight;

        FGapPointsxy[0].x:=dx-FGap;          FGapPointsxy[0].y:=dx-FGap;
        FGapPointsxy[1].x:=dx+FLedWidth+FGap;FGapPointsxy[1].y:=dx-FGap;
        FGapPointsxy[2].x:=dx+FLedWidth+FGap;FGapPointsxy[2].y:=dx+FLedHeight+FGap;
        FGapPointsxy[3].x:=dx-FGap;          FGapPointsxy[3].y:=dx+FledHeight+FGap;

        if FInnerBorderStyle<>iablsNone then
          begin
            FInnerPointsxy[0].x:=FGapPointsxy[0].x-FInnerBorderDepth;FInnerPointsxy[0].y:=FGapPointsxy[0].y-FInnerBorderDepth;
            FInnerPointsxy[1].x:=FGapPointsxy[1].x+FInnerBorderDepth;FInnerPointsxy[1].y:=FGapPointsxy[1].y-FInnerBorderDepth;
            FInnerPointsxy[2].x:=FGapPointsxy[2].x+FInnerBorderDepth;FInnerPointsxy[2].y:=FGapPointsxy[2].y+FInnerBorderDepth;
            FInnerPointsxy[3].x:=FGapPointsxy[3].x-FInnerBorderDepth;FInnerPointsxy[3].y:=FGapPointsxy[3].y+FInnerBorderDepth;
          end else
          begin
            FInnerPointsxy[0].x:=FGapPointsxy[0].x;FInnerPointsxy[0].y:=FGapPointsxy[0].y;
            FInnerPointsxy[1].x:=FGapPointsxy[1].x;FInnerPointsxy[1].y:=FGapPointsxy[1].y;
            FInnerPointsxy[2].x:=FGapPointsxy[2].x;FInnerPointsxy[2].y:=FGapPointsxy[2].y;
            FInnerPointsxy[3].x:=FGapPointsxy[3].x;FInnerPointsxy[3].y:=FGapPointsxy[3].y;
          end;
        if FOuterBorderStyle<>iablsNone then
          begin
            FOuterPointsxy[0].x:=FInnerPointsxy[0].x-FOuterBorderDepth;FOuterPointsxy[0].y:=FInnerPointsxy[0].y-FOuterBorderDepth;
            FOuterPointsxy[1].x:=FInnerPointsxy[1].x+FOuterBorderDepth;FOuterPointsxy[1].y:=FInnerPointsxy[1].y-FOuterBorderDepth;
            FOuterPointsxy[2].x:=FInnerPointsxy[2].x+FOuterBorderDepth;FOuterPointsxy[2].y:=FInnerPointsxy[2].y+FOuterBorderDepth;
            FOuterPointsxy[3].x:=FInnerPointsxy[3].x-FOuterBorderDepth;FOuterPointsxy[3].y:=FInnerPointsxy[3].y+FOuterBorderDepth;
          end else
          begin
            FOuterPointsxy[0].x:=FInnerPointsxy[0].x;FOuterPointsxy[0].y:=FInnerPointsxy[0].y;
            FOuterPointsxy[1].x:=FInnerPointsxy[1].x;FOuterPointsxy[1].y:=FInnerPointsxy[1].y;
            FOuterPointsxy[2].x:=FInnerPointsxy[2].x;FOuterPointsxy[2].y:=FInnerPointsxy[2].y;
            FOuterPointsxy[3].x:=FInnerPointsxy[3].x;FOuterPointsxy[3].y:=FInnerPointsxy[3].y;
          end;

        RotatePolyPoints(FLedPointsxy);
        RotatePolyPoints(FGapPointsxy);
        RotatePolyPoints(FInnerPointsxy);
        RotatePolyPoints(FOuterPointsxy);
      end;
    ialcRound :
      begin
        N:=max(FLedWidth,FLedHeight); if N<1 then N:=1;
        setlength(FLedPointsxy  ,2*N);
        setlength(FGapPointsxy  ,2*N);
        setlength(FInnerPointsxy,2*N);
        setlength(FOuterPointsxy,2*N);
        for i:=0 to 2*N-1 do
          begin
            x:=FLedWidth/2+dx+FledWidth*sin(i*pi/N)/2;
            y:=FLedHeight/2+dx-FledHeight*cos(i*pi/N)/2;
            FLedPointsxy[i].x:=x;
            FLedpointsxy[i].y:=y;
            x:=x+FGap*sin(i*pi/N);
            y:=y-FGap*cos(i*pi/N);
            FGapPointsxy[i].x:=x;
            FGapPointsxy[i].y:=y;
            if FInnerBorderStyle<>iablsNone then
              begin
                x:=x+FInnerBorderDepth*sin(i*pi/N);
                y:=y-FInnerBorderDepth*cos(i*pi/N);
                FInnerPointsxy[i].x:=x;
                FInnerPointsxy[i].y:=y;
              end else
              begin
                FInnerPointsxy[i].x:=FGapPointsxy[i].x;FInnerPointsxy[i].y:=FGapPointsxy[i].y;
              end;
            if FOuterBorderStyle<>iablsNone then
              begin
                FOuterPointsxy[i].x:=x+FOuterBorderDepth*sin(i*pi/N);
                FOuterPointsxy[i].y:=y-FOuterBorderDepth*cos(i*pi/N);
              end else
              begin
                FOuterPointsxy[i].x:=FInnerPointsxy[i].x;FOuterPointsxy[i].y:=FInnerPointsxy[i].y;
              end;
          end;

        RotatePolyPoints(FLedPointsxy);
        RotatePolyPoints(FGapPointsxy);
        RotatePolyPoints(FInnerPointsxy);
        RotatePolyPoints(FOuterPointsxy);
      end;
    ialcTrapezium :
      begin
        setlength(FLedPointsxy  ,4);
        setlength(FGapPointsxy  ,4);