PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

LEDgadget 1.0 alpha

https://www.purebasic.fr/english/viewtopic.php?t=16372

Page 2 of 2

Posted: Mon Jan 01, 2007 8:48 pm
by sharkpeter
Hallo,

a happy new year for all.

Use this, but i don´t checked the status bar function, only led gadget.

Code: Select all

#Led_2state=10101101
#led_3state=10101102
#led_vertical=10101103
#led_circles=10101104
#led_horizontal=10101105
#led_bars=10101106
#OnOff_Red=10101107
#OnOff_green=10101108
#OnOff_yellow=10101109
#OnOff_blue=10101110
 
DataSection
ledred:IncludeBinary "LedRed.ico"
ledredoff:IncludeBinary "LedDarkRed.ico"
ledgreen:IncludeBinary "LedGreen.ico"
ledgreenoff:IncludeBinary "LedGreenoff.ico"
ledyellow:IncludeBinary "LedYellow.ico"
ledyellowoff:IncludeBinary "LedYellowoff.ico"
ledblue:IncludeBinary "LedBlue.ico"
ledblueoff:IncludeBinary "Ledblueoff.ico"
EndDataSection


;***********************************
; das muß raus aus der Procedure
 Structure gauge
    imagegad.l
    imageid.l
    width.l
    height.l
    imagehwnd.l
    precision.l
    ticks.l
    textgad.l
    texthwnd.l 
    State.l
    numstates.l
  EndStructure
  Global Dim ledpics.l(10)
  Global NewList led.gauge()
;***********************************

 
ProcedureDLL initLED()
  ledpics(0)=CatchImage(#PB_Any,?ledred)
  ledpics(1)=CatchImage(#PB_Any,?ledgreen)
  ledpics(2)=CatchImage(#PB_Any,?ledyellow)
  ledpics(4)=CatchImage(#PB_Any,?ledredoff)
  ledpics(5)=CatchImage(#PB_Any,?ledgreenoff)
  ledpics(6)=CatchImage(#PB_Any,?ledyellowoff)
  ledpics(7)=CatchImage(#PB_Any,?ledblue)
  ledpics(8)=CatchImage(#PB_Any,?ledblueoff)
EndProcedure 
 
Procedure subclassled(hwnd,msg,wParam,lParam)
  Select msg
    Case #WM_LBUTTONDOWN 
      ForEach led()
        If led()\texthwnd = hwnd Or led()\imagehwnd=hwnd
          If led()\numstates=#Led_2state
            If led()\State=1
              SetGadgetState(led()\imagegad,ImageID(ledpics(0)))
              led()\State=0
            ElseIf led()\State=0
              SetGadgetState(led()\imagegad,ImageID(ledpics(1)))
              led()\State=1
            EndIf
          ElseIf led()\numstates =#led_3state
            If led()\State=0
              SetGadgetState(led()\imagegad,ImageID(ledpics(1)))
              led()\State=1
            ElseIf led()\State=1
              SetGadgetState(led()\imagegad,ImageID(ledpics(2)))
              led()\State=2
            ElseIf led()\State=2
              SetGadgetState(led()\imagegad,ImageID(ledpics(0)))
              led()\State=0
            EndIf
          ElseIf led()\numstates =#OnOff_Red
            If led()\State=1
              SetGadgetState(led()\imagegad,ImageID(ledpics(4)))
              led()\State=0
            ElseIf led()\State=0
              SetGadgetState(led()\imagegad,ImageID(ledpics(0)))
              led()\State=1
            EndIf
          ElseIf led()\numstates =#OnOff_green
            If led()\State=1
              SetGadgetState(led()\imagegad,ImageID(ledpics(5)))
              led()\State=0
            ElseIf led()\State=0
              SetGadgetState(led()\imagegad,ImageID(ledpics(1)))
              led()\State=1
            EndIf
          ElseIf led()\numstates =#OnOff_yellow
            If led()\State=1
              SetGadgetState(led()\imagegad,ImageID(ledpics(6)))
              led()\State=0
            ElseIf led()\State=0
              SetGadgetState(led()\imagegad,ImageID(ledpics(2)))
              led()\State=1
            EndIf
          ElseIf led()\numstates =#OnOff_blue
            If led()\State=1
              SetGadgetState(led()\imagegad,ImageID(ledpics(8)))
              led()\State=0
            ElseIf led()\State=0
              SetGadgetState(led()\imagegad,ImageID(ledpics(7)))
              led()\State=1
            EndIf
          EndIf 
        EndIf 
      Next 
      ProcedureReturn 0
  EndSelect 
  ProcedureReturn CallWindowProc_(GetProp_(hwnd,"OldProc4"),hwnd,msg,wParam,lParam)
EndProcedure
  
ProcedureDLL LEDgadget(number,x,y,width,height,display,orientation,type)
  Select type
    Case #led_bars
      
      AddElement(led())
      SelectElement(led(),number)
      led()\width=width
      led()\height=height
      led()\imageid=CreateImage(#PB_Any,led()\width,led()\height)

;****************************
      ; hier kannst du nicht mit fester nummer agieren
      iop=led()\imageid
      StartDrawing(ImageOutput(iop))
;****************************      
      
      Box(0,0,led()\width,led()\height,#Black)
      ledheight=led()\height-20
      boxwidth=(led()\width-10-1)/2
      secondx= 6+boxwidth
      tickcount=0
      For a=0 To led()\height-20 Step 4
        tickcount=tickcount+1
        Box(5,a,boxwidth,3,$7F00)
        Box(secondx,a,boxwidth,3,$7F00)
      Next 
      led()\ticks=tickcount
      ;Locate((led()\width/2)-10,led()\height-15)
      BackColor($000000)
      FrontColor($00FF00)
      DrawText((led()\width/2)-10,led()\height-15,"0%")
      StopDrawing()
      led()\imagegad=ImageGadget(#PB_Any,x,y,width,height,ImageID(led()\imageid),#PB_Image_Border)
      ProcedureReturn led()\imagegad
    ; Case #led_circles
      ; AddElement(led())
      ; SelectElement(led(),number)
      ; led()\width=width
      ; led()\height=height
      ; led()\imageid=CreateImage(#PB_Any,led()\width,led()\height)
      ; StartDrawing(ImageOutput())
      ; Box(0,0,led()\width,led()\height,#Black)
      ; ledheight=led()\height-20
      ; circlewidth.f=(led()\width-4)/2
      ; Result.f = Round(circlewidth.f, 1)
      ; numbercircles.f=(led()\height-20)/Result
      ; Result1.f = Round(numbercircles, 1)
      ; For a=0 To Result1-1
        ; Debug a
        ; tickcount=tickcount+1
        ; DrawImage(imageid(ledpics(4)),0,a*Result,Result,Result)
        ; DrawImage(imageid(ledpics(4)),Result+1,a*Result,Result,Result)
      ; Next 
      ; StopDrawing()
      ; led()\imagegad=ImageGadget(#PB_Any,x,y,width,height,imageid(led()\imageid),#PB_Image_Border)
      ProcedureReturn led()\imagegad
  EndSelect 
EndProcedure
 
ProcedureDLL LEDswitch(number,x,y,width,height,text.s,type)
  AddElement(led())
  SelectElement(led(),number)
  If type=#Led_2state
    led()\numstates=#Led_2state
  ElseIf type=#led_3state
    led()\numstates=#led_3state
  Else
    led()\numstates=type
  EndIf 
  led()\width=width
  led()\height=height
  led()\State=0
  led()\textgad=TextGadget(#PB_Any,x,y,width,16,text.s,#PB_Text_Center|#SS_NOTIFY)
  If type=#Led_2state Or type=#led_3state
    led()\imagegad=ImageGadget(#PB_Any,0,0,16,16,ImageID(ledpics(0)))
  Else
    Select type
      Case #OnOff_Red 
        led()\imagegad=ImageGadget(#PB_Any,0,0,16,16,ImageID(ledpics(4)))
      Case #OnOff_green 
        led()\imagegad=ImageGadget(#PB_Any,0,0,16,16,ImageID(ledpics(5)))
      Case #OnOff_yellow
        led()\imagegad=ImageGadget(#PB_Any,0,0,16,16,ImageID(ledpics(6)))
      Case #OnOff_blue
        led()\imagegad=ImageGadget(#PB_Any,0,0,16,16,ImageID(ledpics(8)))
    EndSelect 
  EndIf 
  led()\texthwnd=GadgetID(led()\textgad)
  led()\imagehwnd=GadgetID(led()\imagegad)
  SetParent_(GadgetID(led()\imagegad),GadgetID(led()\textgad))
  oldstyle=GetWindowLong_(GadgetID(led()\imagegad),#GWL_STYLE)
  SetWindowLong_(GadgetID(led()\imagegad),#GWL_STYLE,oldstyle|#SS_ICON)
  RedrawWindow_(GadgetID(led()\textgad),0,0,#RDW_ALLCHILDREN)
  SetProp_(GadgetID(led()\textgad),"OldProc4",SetWindowLong_(GadgetID(led()\textgad), #GWL_WNDPROC, @subclassled()))
  SetProp_(GadgetID(led()\imagegad),"OldProc4",SetWindowLong_(GadgetID(led()\imagegad), #GWL_WNDPROC, @subclassled()))
EndProcedure
 
ProcedureDLL setLEDstate(led,percent)
  SelectElement(led(),led)
  tickcount=led()\ticks
  perc.f=100/led()\ticks
  percents.f=(percent/100)
  finalpercent.f=percents*tickcount
  stringpercent.s=StrF(finalpercent)
  Result.f = Round(finalpercent, 1)
  finalresult=led()\ticks-Result
  ledheight=led()\height-20
  boxwidth=(led()\width-10-1)/2
  secondx=6+boxwidth

  iop=ImageID(led()\imageid)
  StartDrawing(ImageOutput(iop))

  tickcount=0
  For a=0 To led()\height-20 Step 4
    tickcount=tickcount+1
    If tickcount>=finalresult
      Box(5,a,boxwidth,3,$FF00)
      Box(secondx,a,boxwidth,3,$FF00)
    Else
      Box(5,a,boxwidth,3,$7F00)
      Box(secondx,a,boxwidth,3,$7F00)
    EndIf
  Next
  Box(0,led()\height-15,led()\width,15,#Black)
  ;Locate((led()\width/2)-10,led()\height-15)
  BackColor($000000)
  FrontColor($00FF00)
  DrawText((led()\width/2)-10,led()\height-15,Str(percent)+"%")
  StopDrawing()
  SetGadgetState(led()\imagegad,ImageID(led()\imageid))
EndProcedure
 
initLED()
#WindowWidth  = 390
#WindowHeight = 350
If OpenWindow(0, 100, 200, #WindowWidth, #WindowHeight,"", #PB_Window_MinimizeGadget)
  If CreateGadgetList(WindowID(0))
    led=LEDgadget(0,50,50,75,200,0,#led_vertical,#led_bars)
    LEDswitch(1,150,50,80,20,"2 State",#Led_2state)
    LEDswitch(2,150,80,100,20,"3 State LED",#led_3state)
    LEDswitch(3,150,110,100,20,"On/Off Red",#OnOff_Red)
    LEDswitch(4,150,140,110,20,"On/Off Green",#OnOff_green)
    LEDswitch(5,150,170,100,20,"On/Off Blue",#OnOff_blue)
    LEDswitch(6,150,200,110,20,"On/Off Yellow",#OnOff_yellow)
  EndIf
  
  Repeat
    ;setLEDstate(0,Random(100))
    EventID = WaitWindowEvent()
    
    If EventID = #PB_Event_Gadget
      
      Select EventGadget()
        Case led
          
      EndSelect
      
    EndIf
    
  Until EventID = #PB_Event_CloseWindow
  
EndIf

Posted: Sat Jan 13, 2007 4:40 pm
by ricardo
kinglestat wrote:I didnt manage to get this to work with PB4 I am using 4.02 any ideas ?

regards

KingLestat
Yes, looking for PB4 compatible version. :)
All times are UTC+01:00
Page 2 of 2

Powered by phpBB® Forum Software © phpBB Limited