Page 1 of 1

7 Led Gadget

Posted: Wed Jun 01, 2005 8:52 pm
by Droopy
Code updated For 5.20+

Create easyly a seven led gadget

Code: Select all

; PureBasic 3.93
; Idea from Localmotion34

; De préférence utilisez un gadget ayant un rapport de 11 * 13 ex 110 / 130

Structure SevenSegmentLed
  x.l
  y.l
  width.l
  height.l
  Image.l
  Gadget.l
  value.l
  point.l
  color1.l
  color2.l
  BackgroundColor.l
EndStructure

;{ Datasection
DataSection
  Led:
  ; Segment a
  Data.l 1,1,1,-1,6,0,1,1,-1,1,-6,0,-1,-1,0,0
  ; Segment g
  Data.l 1,6,1,-1,6,0,1,1,-1,1,-6,0,-1,-1,0,0
  ; Segment d
  Data.l 1,11,1,-1,6,0,1,1,-1,1,-6,0,-1,-1,0,0
  ; Segment f
  Data.l 1,1,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
  ; Segment b
  Data.l 9,1,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
  ; Segment e
  Data.l 1,6,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
  ; Segment c
  Data.l 9,6,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
  ; Point
  Data.l 10,11,1,1,-1,1,-1,-1,1,-1,0,0
  ; Fin dessin Leds
  Data.l 0,0
  
  SegmentA:
  Data.l 5,1
  SegmentB:
  Data.l 9,3
  SegmentC:
  Data.l 9,8
  SegmentD:
  Data.l 5,11
  SegmentE:
  Data.l 1,9
  SegmentF:
  Data.l 1,4
  SegmentG:
  Data.l 5,6
  SegmentP:
  Data.l 10,12
  
EndDataSection
;}

ProcedureDLL SevenSegmentLed(x,y,width,height,color1,color2,BackgroundColor)
  
  ; Initialise the LinkedList the first call
  Static Init
  If Init=0
    Global NewList SevenSegmentLedLList.SevenSegmentLed()
  EndIf
  Init=1
  
  ; Fill the Structure
  AddElement(SevenSegmentLedLList())
  SevenSegmentLedLList()\x=x
  SevenSegmentLedLList()\y=y
  SevenSegmentLedLList()\width=width
  SevenSegmentLedLList()\height=height
  SevenSegmentLedLList()\color1=color1
  SevenSegmentLedLList()\color2=color2
  SevenSegmentLedLList()\BackgroundColor=BackgroundColor
  SevenSegmentLedLList()\Image=CreateImage(#PB_Any,width,height)
  
  PWidth.f=SevenSegmentLedLList()\width/11
  PHeight.f=SevenSegmentLedLList()\height/13
  
  
  ;/ Dessine les Leds
  ;       UseImage()
  StartDrawing(ImageOutput(SevenSegmentLedLList()\Image))
  Box(0,0,SevenSegmentLedLList()\width,SevenSegmentLedLList()\height,SevenSegmentLedLList()\BackgroundColor)
  Restore  Led
  Repeat
    Read x
    Read y
    If x=0 And y=0 : Break : EndIf
    Repeat
      Read a
      Read b
      If a=0 And b=0 : Break : EndIf
      Line(x*PWidth,y*PHeight,a*PWidth,b*PHeight,color1)
      x=x+a : y=y+b
    ForEver
  ForEver
  StopDrawing()
  
  ; create the gadget & show the image
  SevenSegmentLedLList()\Gadget=ImageGadget(#PB_Any,SevenSegmentLedLList()\x,SevenSegmentLedLList()\y,width,height,ImageID(SevenSegmentLedLList()\Image),#PB_Image_Border)
  
  ; Return the gadget id
  ProcedureReturn ListIndex(SevenSegmentLedLList())
  
EndProcedure

ProcedureDLL SevenSegmentLedSet(id,value)
  Shared SevenSegmentLedLList()
  SelectElement(SevenSegmentLedLList(),id)
  
  SevenSegmentLedLList()\value=value
  
  PWidth.f=SevenSegmentLedLList()\width/11
  PHeight.f=SevenSegmentLedLList()\height/13
  
  ;/ Allume les Segments
  ;       UseImage()
  StartDrawing(ImageOutput(SevenSegmentLedLList()\Image))
  
  ; Eteind les segments
  Restore SegmentA
  For n=1 To 8
    Read a
    Read b
    FillArea(a*PWidth,b*PHeight,SevenSegmentLedLList()\color1,SevenSegmentLedLList()\BackgroundColor)
  Next
  
  Select value
    Case 0
      temp.s="abcdef"
    Case 1
      temp="bc"
    Case 2
      temp="abged"
    Case 3
      temp="abgcd"
    Case 4
      temp="fbgc"
    Case 5
      temp="afgcd"
    Case 6
      temp="afedgc"
    Case 7
      temp="abc"
    Case 8
      temp="abcdefg"
    Case 9
      temp="abcdfg"
  EndSelect
  
  ; Gestion du point
  If SevenSegmentLedLList()\point=1
    temp+"p"
  EndIf
  
  
  For n=1 To Len(temp)
    Select Mid(temp,n,1)
      Case "a"
        Restore SegmentA
      Case "b"
        Restore SegmentB
      Case "c"
        Restore SegmentC
      Case "d"
        Restore SegmentD
      Case "e"
        Restore SegmentE
      Case "f"
        Restore SegmentF
      Case "g"
        Restore SegmentG
      Case "p"
        Restore SegmentP
        
    EndSelect
    
    
    Read a
    Read b
    
    FillArea(a*PWidth,b*PHeight,SevenSegmentLedLList()\color1,SevenSegmentLedLList()\color2)
  Next
  
  StopDrawing()
  Shared SevenSegmentLedLList()
  SetGadgetState(SevenSegmentLedLList()\Gadget,ImageID(SevenSegmentLedLList()\Image))
  
EndProcedure

ProcedureDLL SevenSegmentLedGet(id)
  SelectElement(SevenSegmentLedLList(),id)
  ProcedureReturn SevenSegmentLedLList()\value
EndProcedure

Procedure SevenSegmentLedEvent(id)
  SelectElement(SevenSegmentLedLList(),id)
  ProcedureReturn SevenSegmentLedLList()\Gadget
EndProcedure 

Procedure SevenSegmentLedPoint(id,light)
  SelectElement(SevenSegmentLedLList(),id)
  SevenSegmentLedLList()\point=light
EndProcedure



;/ Test
OpenWindow(0,0,0,580,290 ,"7 Segment Led",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)

SevenSegmentLed(10,10,220,260,8404992,16776960,10485760)
SevenSegmentLed(250,10,110,130,4227072,65280,4210688)
SevenSegmentLed(400,10,55,65,1118481,255,0)
SevenSegmentLed(455,10,55,65,1118481,255,0)
SevenSegmentLed(510,10,55,65,1118481,255,0)

For n= 0 To 9
  For i=1 To 4
    SevenSegmentLedSet(i,Random(9))
    SevenSegmentLedPoint(i,Random(1))
  Next i
  
  SevenSegmentLedSet(0,n)
  
  Beep_(1000,25)
  Delay(500)
Next n


Posted: Wed Jun 01, 2005 9:05 pm
by dell_jockey
Droopy strikes again! :D

Well done, thanks!

Posted: Wed Jun 01, 2005 9:30 pm
by walker
Hi,

Great Work :!: :!:
I've modified the code slightly to get it work on Linux (this version schould work on Win too)
The changes:
- removed the Beep_ (=Win-Api)
- added While WindowEvent():Wend to get the display updated

Code: Select all


; PureBasic 3.93
; Idea from Localmotion34

; De préférence utilisez un gadget ayant un rapport de 11 * 13 ex 110 / 130

Structure SevenSegmentLed
  x.l
  y.l
  width.l
  height.l
  Image.l
  Gadget.l
  value.l
  point.l
  color1.l
  color2.l
  BackgroundColor.l
EndStructure

;{ Datasection
DataSection
Led:
; Segment a
Data.l 1,1,1,-1,6,0,1,1,-1,1,-6,0,-1,-1,0,0
; Segment g
Data.l 1,6,1,-1,6,0,1,1,-1,1,-6,0,-1,-1,0,0
; Segment d
Data.l 1,11,1,-1,6,0,1,1,-1,1,-6,0,-1,-1,0,0
; Segment f
Data.l 1,1,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
; Segment b
Data.l 9,1,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
; Segment e
Data.l 1,6,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
; Segment c
Data.l 9,6,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
; Point
Data.l 10,11,1,1,-1,1,-1,-1,1,-1,0,0
; Fin dessin Leds
Data.l 0,0

SegmentA:
Data.l 5,1
SegmentB:
Data.l 9,3
SegmentC:
Data.l 9,8
SegmentD:
Data.l 5,11
SegmentE:
Data.l 1,9
SegmentF:
Data.l 1,4
SegmentG:
Data.l 5,6
SegmentP:
Data.l 10,12

EndDataSection
;}

ProcedureDLL SevenSegmentLed(x,y,width,height,color1,color2,BackgroundColor)
 
  ; Initialise the LinkedList the first call
  Static Init
  If Init=0
    NewList SevenSegmentLedLList.SevenSegmentLed()
  EndIf
  Init=1
 
  ; Fill the Structure
  AddElement(SevenSegmentLedLList())
  SevenSegmentLedLList()\x=x
  SevenSegmentLedLList()\y=y
  SevenSegmentLedLList()\width=width
  SevenSegmentLedLList()\height=height
  SevenSegmentLedLList()\color1=color1
  SevenSegmentLedLList()\color2=color2
  SevenSegmentLedLList()\BackgroundColor=BackgroundColor
  SevenSegmentLedLList()\Image=CreateImage(#PB_Any,width,height)
 
  PWidth.f=SevenSegmentLedLList()\width/11
  PHeight.f=SevenSegmentLedLList()\height/13
 
 
  ;/ Dessine les Leds
  UseImage(SevenSegmentLedLList()\Image)
  StartDrawing(ImageOutput())
  Box(0,0,SevenSegmentLedLList()\width,SevenSegmentLedLList()\height,SevenSegmentLedLList()\BackgroundColor)
  Restore  Led
  Repeat
    Read x
    Read y
    If x=0 And y=0 : Break : EndIf
    Repeat
      Read a
      Read b
      If a=0 And b=0 : Break : EndIf
      Line(x*PWidth,y*PHeight,a*PWidth,b*PHeight,color1)
      x=x+a : y=y+b
    ForEver
  ForEver
  StopDrawing()
 
  ; create the gadget & show the image
  SevenSegmentLedLList()\Gadget=ImageGadget(#PB_Any,SevenSegmentLedLList()\x,SevenSegmentLedLList()\y,width,height,UseImage(SevenSegmentLedLList()\Image),#PB_Image_Border)
 
  ; Return the gadget id
  ProcedureReturn ListIndex(SevenSegmentLedLList())
 
EndProcedure

ProcedureDLL SevenSegmentLedSet(id,value)
 
  SelectElement(SevenSegmentLedLList(),id)
 
  SevenSegmentLedLList()\value=value
 
  PWidth.f=SevenSegmentLedLList()\width/11
  PHeight.f=SevenSegmentLedLList()\height/13
 
  ;/ Allume les Segments
  UseImage(SevenSegmentLedLList()\Image)
  StartDrawing(ImageOutput())
 
  ; Eteind les segments
  Restore SegmentA
  For n=1 To 8
    Read a
    Read b
    FillArea(a*PWidth,b*PHeight,SevenSegmentLedLList()\color1,SevenSegmentLedLList()\BackgroundColor)
  Next
 
  Select value
    Case 0
      temp.s="abcdef"
    Case 1
      temp="bc"
    Case 2
      temp="abged"
    Case 3
      temp="abgcd"
    Case 4
      temp="fbgc"
    Case 5
      temp="afgcd"
    Case 6
      temp="afedgc"
    Case 7
      temp="abc"
    Case 8
      temp="abcdefg"
    Case 9
      temp="abcdfg"
  EndSelect
 
  ; Gestion du point
  If SevenSegmentLedLList()\point=1
    temp+"p"
  EndIf
 
 
  For n=1 To Len(temp)
    Select Mid(temp,n,1)
      Case "a"
        Restore SegmentA
      Case "b"
        Restore SegmentB
      Case "c"
        Restore SegmentC
      Case "d"
        Restore SegmentD
      Case "e"
        Restore SegmentE
      Case "f"
        Restore SegmentF
      Case "g"
        Restore SegmentG
      Case "p"
        Restore SegmentP
     
    EndSelect
   
   
    Read a
    Read b
   
    FillArea(a*PWidth,b*PHeight,SevenSegmentLedLList()\color1,SevenSegmentLedLList()\color2)
  Next
 
    StopDrawing()
     
  SetGadgetState(SevenSegmentLedLList()\Gadget,UseImage(SevenSegmentLedLList()\Image))
 
EndProcedure

ProcedureDLL SevenSegmentLedGet(id)
  SelectElement(SevenSegmentLedLList(),id)
  ProcedureReturn SevenSegmentLedLList()\value
EndProcedure

Procedure SevenSegmentLedEvent(id)
  SelectElement(SevenSegmentLedLList(),id)
  ProcedureReturn SevenSegmentLedLList()\Gadget
EndProcedure 

Procedure SevenSegmentLedPoint(id,light)
  SelectElement(SevenSegmentLedLList(),id)
  SevenSegmentLedLList()\point=light
EndProcedure



;/ Test
OpenWindow(0,0,0,580,290,#PB_Window_SystemMenu|#PB_Window_ScreenCentered ,"7 Segment Led")
CreateGadgetList(WindowID(0))
SevenSegmentLed(10,10,220,260,8404992,16776960,10485760)
SevenSegmentLed(250,10,110,130,4227072,65280,4210688)
SevenSegmentLed(400,10,55,65,1118481,255,0)
SevenSegmentLed(455,10,55,65,1118481,255,0)
SevenSegmentLed(510,10,55,65,1118481,255,0)

For n= 0 To 9
  For i=1 To 4
    SevenSegmentLedSet(i,Random(9))
    SevenSegmentLedPoint(i,Random(1))
  Next i
 
  SevenSegmentLedSet(0,n)
 
 ; Beep_(1000,25)
 While WindowEvent():Wend
 
  Delay(500)
Next n 
cu
Ulf

Posted: Wed Jun 01, 2005 9:46 pm
by dell_jockey
Ulf,

gute Arbeit, es läuft ebenfalls auf Win-XP.

good job, it indeed runs on Win-XP as well.

bye

Re: 7 Led Gadget

Posted: Wed Jun 01, 2005 10:58 pm
by traumatic
nice! :D

Excellent!

Posted: Thu Jun 02, 2005 12:43 am
by Fangbeast
This is seriously cool

Posted: Thu Jun 02, 2005 5:39 pm
by Droopy
This version can show Hex value

Code: Select all

; PureBasic 3.93 
; Idea from Localmotion34 

; De préférence utilisez un gadget ayant un rapport de 11 * 13 ex 110 / 130

Structure SevenSegmentLed 
  x.l 
  y.l 
  width.l 
  height.l 
  Image.l 
  Gadget.l 
  value.l
  point.l
  color1.l 
  color2.l 
  BackgroundColor.l
EndStructure 

;{ Datasection
DataSection
Led:
; Segment a
Data.l 1,1,1,-1,6,0,1,1,-1,1,-6,0,-1,-1,0,0
; Segment g
Data.l 1,6,1,-1,6,0,1,1,-1,1,-6,0,-1,-1,0,0
; Segment d
Data.l 1,11,1,-1,6,0,1,1,-1,1,-6,0,-1,-1,0,0
; Segment f
Data.l 1,1,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
; Segment b
Data.l 9,1,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
; Segment e
Data.l 1,6,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
; Segment c
Data.l 9,6,1,1,0,3,-1,1,-1,-1,0,-3,1,-1,0,0
; Point
Data.l 10,11,1,1,-1,1,-1,-1,1,-1,0,0
; Fin dessin Leds
Data.l 0,0

SegmentA:
Data.l 5,1
SegmentB:
Data.l 9,3
SegmentC:
Data.l 9,8
SegmentD:
Data.l 5,11
SegmentE:
Data.l 1,9
SegmentF:
Data.l 1,4
SegmentG:
Data.l 5,6
SegmentP:
Data.l 10,12

EndDataSection
;}

ProcedureDLL SevenSegmentLed(x,y,width,height,color1,color2,BackgroundColor) 
  
  ; Initialise the LinkedList the first call 
  Static Init 
  If Init=0 
    NewList SevenSegmentLedLList.SevenSegmentLed() 
  EndIf 
  Init=1 
  
  ; Fill the Structure 
  AddElement(SevenSegmentLedLList()) 
  SevenSegmentLedLList()\x=x 
  SevenSegmentLedLList()\y=y 
  SevenSegmentLedLList()\width=width 
  SevenSegmentLedLList()\height=height 
  SevenSegmentLedLList()\color1=color1 
  SevenSegmentLedLList()\color2=color2 
  SevenSegmentLedLList()\BackgroundColor=BackgroundColor
  SevenSegmentLedLList()\Image=CreateImage(#PB_Any,width,height) 
  
  PWidth.f=SevenSegmentLedLList()\width/11
  PHeight.f=SevenSegmentLedLList()\height/13
  
  
  ;/ Dessine les Leds
  UseImage(SevenSegmentLedLList()\Image)
  StartDrawing(ImageOutput())
  Box(0,0,SevenSegmentLedLList()\width,SevenSegmentLedLList()\height,SevenSegmentLedLList()\BackgroundColor)
  Restore  Led
  Repeat
    Read x
    Read y
    If x=0 And y=0 : Break : EndIf
    Repeat
      Read a
      Read b
      If a=0 And b=0 : Break : EndIf
      Line(x*PWidth,y*PHeight,a*PWidth,b*PHeight,color1)
      x=x+a : y=y+b
    ForEver
  ForEver
  StopDrawing()
  
  ; create the gadget & show the image 
  SevenSegmentLedLList()\Gadget=ImageGadget(#PB_Any,SevenSegmentLedLList()\x,SevenSegmentLedLList()\y,width,height,UseImage(SevenSegmentLedLList()\Image),#PB_Image_Border) 
  
  ; Return the gadget id 
  ProcedureReturn ListIndex(SevenSegmentLedLList()) 
  
EndProcedure 

ProcedureDLL SevenSegmentLedSet(id,value) 
  
  SelectElement(SevenSegmentLedLList(),id) 
  
  SevenSegmentLedLList()\value=value 
  
  PWidth.f=SevenSegmentLedLList()\width/11
  PHeight.f=SevenSegmentLedLList()\height/13
  
  ;/ Allume les Segments
  UseImage(SevenSegmentLedLList()\Image)
  StartDrawing(ImageOutput())
  
  ; Eteind les segments
  Restore SegmentA
  For n=1 To 8
    Read a
    Read b
    FillArea(a*PWidth,b*PHeight,SevenSegmentLedLList()\color1,SevenSegmentLedLList()\BackgroundColor)
  Next
  
  Select value
    Case 0
      temp.s="abcdef"
    Case 1
      temp="bc"
    Case 2
      temp="abged"
    Case 3
      temp="abgcd"
    Case 4
      temp="fbgc"
    Case 5
      temp="afgcd"
    Case 6
      temp="afedgc"
    Case 7
      temp="abc"
    Case 8
      temp="abcdefg"
    Case 9
      temp="abcdfg"
    Case 10 ; A
      temp="abcefg"
    Case 11 ; b
      temp="fgcde"
    Case 12 ; c
      temp="ged"
    Case 13 ; d
      temp="bcdeg"
    Case 14 ; E
      temp="afged"
    Case 15 ; F
      temp="afeg"
      
      
      
  EndSelect
  
  
  ; Gestion du point
  If SevenSegmentLedLList()\point=1
    temp+"p"
  EndIf
  
  
  For n=1 To Len(temp)
    Select Mid(temp,n,1)
      Case "a"
        Restore SegmentA
      Case "b"
        Restore SegmentB
      Case "c"
        Restore SegmentC
      Case "d"
        Restore SegmentD
      Case "e"
        Restore SegmentE
      Case "f"
        Restore SegmentF
      Case "g"
        Restore SegmentG
      Case "p"
        Restore SegmentP
     
    EndSelect
    
    
    Read a
    Read b
    
    FillArea(a*PWidth,b*PHeight,SevenSegmentLedLList()\color1,SevenSegmentLedLList()\color2)
  Next
  
    StopDrawing()
      
  SetGadgetState(SevenSegmentLedLList()\Gadget,UseImage(SevenSegmentLedLList()\Image)) 
  
EndProcedure 

ProcedureDLL SevenSegmentLedGet(id) 
  SelectElement(SevenSegmentLedLList(),id) 
  ProcedureReturn SevenSegmentLedLList()\value 
EndProcedure 

ProcedureDLL SevenSegmentLedEvent(id) 
  SelectElement(SevenSegmentLedLList(),id) 
  ProcedureReturn SevenSegmentLedLList()\Gadget 
EndProcedure  

ProcedureDLL SevenSegmentLedPoint(id,light)
  SelectElement(SevenSegmentLedLList(),id) 
  SevenSegmentLedLList()\point=light
EndProcedure



;/ Test 
OpenWindow(0,0,0,580,290,#PB_Window_SystemMenu|#PB_Window_ScreenCentered ,"7 Segment Led")
CreateGadgetList(WindowID(0))
SevenSegmentLed(10,10,220,260,8404992,16776960,10485760)
SevenSegmentLed(250,10,110,130,4227072,65280,4210688)
SevenSegmentLed(400,10,55,65,1118481,255,0)
SevenSegmentLed(455,10,55,65,1118481,255,0)
SevenSegmentLed(510,10,55,65,1118481,255,0)

For n= 0 To 15
  For i=1 To 4
    SevenSegmentLedSet(i,Random(9))
    SevenSegmentLedPoint(i,Random(1))
  Next i 
  
  SevenSegmentLedSet(0,n)
  
  Beep_(1000,25)
  Delay(500)
Next n

Posted: Sat Jun 18, 2005 12:26 am
by BytePtr
Very nice, will be very useful in future for me.