iagaloled.pas

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

procedure TIAgaloLED.RotatePolyPoints(var Apoly: TIAxyPoly);
var i,dx : integer;
    x,y,dCx,Dcy : Double;
begin
  Dx:=FGap;
  if FInnerBorderStyle<>iablsNone then inc(dX,FInnerBorderDepth);
  if FOuterBorderStyle<>iablsNone then inc(dX,FOuterBorderDepth);
  dcX:=(FLedWidth+2*dx)*cos(FAngle*pi/1800)/2+(FLedHeight+2*dx)*sin(FAngle*pi/1800)/2;
  dcY:=-(FLedWidth+2*dx)*sin(FAngle*pi/1800)/2+(FLedHeight+2*dx)*cos(FAngle*pi/1800)/2;
  dcx:=width/2-dcx;
  dcy:=height/2-dcy;
  for i:=0 to length(APoly)-1 do
    begin
      x:=APoly[i].x*cos(FAngle*pi/1800)+APoly[i].y*sin(FAngle*pi/1800);
      y:=-APoly[i].x*sin(FAngle*pi/1800)+APoly[i].y*cos(FAngle*pi/1800);
      x:=x+dcx;
      y:=y+dcy;
      APoly[i].x:=x;
      APoly[i].y:=y;
    end;
end;

procedure TIAgaloLED.SetAngle(Value: integer);
begin
  if Value<>FAngle then
    begin
      while Value>1800 do dec(Value,3600);
      while Value<=-1800 do inc(Value,3600);
      FAngle := Value;
      DefineWidthHeight;
      GetPaintBitmap;
      invalidate;
    end;
end;

procedure TIAgaloLED.SetBorderColor(Value: TColor);
begin
  if Value<>FBorderColor then
    begin
      FBorderColor := Value;
      GetPaintBitmap;
      invalidate;
    end;
end;

procedure TIAgaloLED.SetBorderSubsMode(Value: TIAglSubstanceMode);
begin
  if Value<>FBorderSubsMode then
    begin
      FBorderSubsMode := Value;
      GetPaintBitmap;
      invalidate;
    end;
end;

procedure TIAgaloLED.SetBorderSubstance(Value: TBitmap);
begin
  if (Value=nil) or (Value.Width=0) or (Value.Height=0) then
    begin
      FBorderSubstance.height:=0;
      FBorderL.height:=0;
      FBorderD.height:=0;
    end else
    begin
      FBorderSubstance.Width:=Value.Width;
      FBorderSubstance.Height:=Value.Height;
      FBorderSubstance.PixelFormat:=pf24bit;
      FBorderSubstance.Canvas.Draw(0,0,Value);
      FBorderL.Width:=Value.Width;
      FBorderL.Height:=Value.Height;
      FBorderL.PixelFormat:=pf24bit;
      FBorderL.Canvas.Draw(0,0,Value);
      FBorderD.Width:=Value.Width;
      FBorderD.Height:=Value.Height;
      FBorderD.PixelFormat:=pf24bit;
      FBorderD.Canvas.Draw(0,0,Value);
      Light24Bitmap(FBorderL,64);
      Dark24Bitmap(FBorderD,64);
    end;
  GetPaintBitmap;  
  invalidate;
end;

procedure TIAgaloLED.SetGaloIntensity(Value: integer);
begin
  if (Value<>FGaloIntensity) and (Value>0) and (value<11) then
    begin
      FGaloIntensity := Value;
      invalidate;
    end;
end;

procedure TIAgaloLED.SetGaloON(Value: Boolean);
begin
  if Value<>FGaloOn then
    begin
      if FGaloOn and not Value then FGaloONwas:=true else FGaloONwas:=false;
      FGaloON := Value;

      invalidate;
    end;
end;

procedure TIAgaloLED.SetGaloSize(Value: integer);
begin
  if (Value<>FGaloSize) and (Value>=0) and (Value<50) then
    begin
      FGaloSize := Value;
      invalidate;
    end;
end;

procedure TIAgaloLED.SetGap(Value: integer);
begin
  if (FGap<>Value) and (Value>=0) then
    begin
      FGap := Value;
      DefineWidthHeight;
      GetPaintBitmap;
      invalidate;
    end;
end;

procedure TIAgaloLED.SetGapColor(Value: TColor);
begin
  if Value<>FGapColor then
    begin
      FGapColor := Value;
      GetPaintBitmap;
      invalidate;
    end;
end;

procedure TIAgaloLED.SetHeight(Value: Integer);
begin
  if (abs(cos(pi*FAngle/1800))<1e-4) or (abs(sin(pi*FAngle/1800))<1e-4) then
    begin
      inherited height:=value;
      FLastHeight:=Value;
    end;
end;

procedure TIAgaloLED.SetInnerBorderDepth(Value: integer);
begin
  if  (FInnerBorderDepth<>Value) and (value>=0) then
    begin
      FInnerBorderDepth := Value;
      DefineWidthHeight;
      GetPaintBitmap;
      invalidate;
    end;
end;

procedure TIAgaloLED.SetInnerBorderStyle(Value: TIABorderLedStyle);
begin
  if FInnerBorderStyle<>Value then
    begin
      FInnerBorderStyle := Value;
      DefineWidthHeight;
      GetPaintBitmap;
      invalidate;
    end;
end;







procedure TIAgaloLED.SetLedClass(Value: TIALedClass);
begin
  if FLedClass<>Value then
    begin
      FLedClass := Value;
      DefineWidthHeight;
      GetPaintBitmap;
      invalidate;
    end;
end;

procedure TIAgaloLED.SetLedHeight(Value: integer);
begin
  if (FLedHeight<>Value) and (Value>=0) then
    begin
      FLedHeight := Value;
      DefineWidthHeight;
      GetPaintBitmap;
      invalidate;
    end;
end;

procedure TIAgaloLED.SetLedOn(Value: Boolean);
begin
  if FLedOn<>Value then
    begin
      FLedOn := Value;
      GetPaintBitmap;
      invalidate;
    end;
end;

procedure TIAgaloLED.SetLedPlasticColor(Value: TColor);
begin
  if FLedPlasticColor<>Value then
    begin
      FLedPlasticColor := Value;
      GetPaintBitmap;
      invalidate;
    end;
end;

procedure TIAgaloLED.SetLedPlasticDepth(Value: integer);
begin
  if (FLedPlasticDepth<>Value) and (Value>=1) and (Value<11) then
    begin
      FLedPlasticDepth := Value;
      GetPaintBitmap;
      invalidate;
    end;
end;

procedure TIAgaloLED.SetLedPlasticSubsMode(Value: TIAglSubstanceMode);
begin
  if Value<>FLedPlasticSubsMode then
    begin
      FLedPlasticSubsMode := Value;
      GetPaintBitmap;
      invalidate;
    end;
end;

procedure TIAgaloLED.SetLedPlasticSubstance(Value: TBitmap);
begin
  if (Value=nil) or (Value.Width=0) or (Value.Height=0) then
    begin
      FLedPlasticSubstance.height:=0;
      GetPaintBitmap;
      invalidate;
    end else
    begin
      FLedPlasticSubstance.PixelFormat:=pf24bit;
      FLedPlasticSubstance.Width:=Value.Width;
      FLedPlasticSubstance.Height:=Value.Height;
      FLedPlasticSubstance.Canvas.Draw(0,0,Value);
      GetPaintBitmap;
      invalidate;
    end;
end;

procedure TIAgaloLED.SetLedWidth(Value: integer);
begin
  if (FLedWidth<>Value) and (Value>=0) then
    begin
      FLedWidth := Value;
      DefineWidthHeight;
      GetPaintBitmap;
      invalidate;
    end;
end;

procedure TIAgaloLED.SetOuterBorderDepth(Value: integer);
begin
  if (FOuterBorderDepth<>Value) and (Value>=0) then
    begin
      FOuterBorderDepth := Value;
      DefineWidthHeight;
      GetPaintBitmap;
      invalidate;
    end;
end;

procedure TIAgaloLED.SetOuterBorderStyle(Value: TIABorderLedStyle);
begin
  if FOuterBorderStyle<>value then
    begin
      FOuterBorderStyle := Value;
      DefineWidthHeight;
      GetPaintBitmap;
      invalidate;
    end;
end;



procedure TIAgaloLED.SetWidth(Value: Integer);
begin
  if (abs(cos(pi*FAngle/1800))<1e-4) or (abs(sin(pi*FAngle/1800))<1e-4) then
    begin
      inherited width:=value;
      FLastWidth:=Value;
    end;
end;    

procedure TIAgaloLED.WMMOVE(var Message: TMessage);
var r : Trect;
begin
  inherited;
    if assigned(Parent) and (FGaloOn) and (FLedOn) then
    begin
      r:=rect(0,0,parent.width-1,parent.height-1);
      invalidaterect(parent.handle,@r,true);
      RedrawWindow(self.parent.handle,@r,0,RDW_INVALIDATE or RDW_UPDATENOW or RDW_AllCHILDREN);
    end;
  Message.Result:=0;  
end;

procedure TIAgaloLED.WMSIZE(var Message: TMessage);
var dX : integer;
    r : Trect;
begin
  inherited;

  if (not ((abs(cos(pi*FAngle/1800))<1e-4) or (abs(sin(pi*FAngle/1800))<1e-4))) and
     ((FLastWidth<>Message.LParamLo) or (FLastHeight<>Message.LParamHi)) then
    begin
      MoveWindow(self.handle,left,top,FLastWidth,FLastHeight,TRUE);
      Message.Result:=0;
    end else
    begin
      if ((abs(cos(pi*FAngle/1800))<1e-4) or (abs(sin(pi*FAngle/1800))<1e-4)) then
        begin
          if abs(abs(cos(pi*FAngle/1800))-1)<1e-4 then
            begin //1...3
              FLedWidth :=Message.LParamLo;
              FLedHeight:=Message.LParamHi;
            end else
            begin
              FLedHeight:=Message.LParamLo;
              FLedwidth :=Message.LParamHi;
            end;
          Dx:=FGap;
          if FInnerBorderStyle<>iablsNone then inc(dX,FInnerBorderDepth);
          if FOuterBorderStyle<>iablsNone then inc(dX,FOuterBorderDepth);
          dec(FledWidth,2*dx);
          dec(FLedHeight,2*dx);
          if (FledWidth<0) or (FLedheight<0) then
            begin
              if FLedWidth<0  then FLedWidth :=0;
              if FLedHeight<0 then FLedHeight:=0;
              DefineWidthHeight;
              GetPaintBitmap;
            end;
          Message.Result:=0;
        end;
        DefineWidthHeight;
        GetPaintBitmap;
        Message.Result:=0;
    end;
  if assigned(Parent)  and (FGaloOn) and (FLedOn) then
    begin
      r:=rect(0,0,parent.width-1,parent.height-1);
      invalidaterect(parent.handle,@r,true);
      RedrawWindow(self.parent.handle,@r,0,RDW_INVALIDATE or RDW_UPDATENOW or RDW_AllCHILDREN);
    end;
end;

end.