8 LED simulieren ..

[funker]

Hallo guten Tag.
Ich suche ein Purebasicdemo um LED zu simulieren.
Ich möchte ein Byte aufteilen in Bit und damit LED steuern.

Danke.

Gruss

[STARGÅTE]

Was möchtest du?
"LED simulieren", mein du damit ein Gadget wo eine LED dargestelllt wird, die dann an- und ausgeschaltet werden kann?
"ein Byte aufteilen in Bit und damit LED steuern", ein Bit kann auch keine LED steuern!
Über welche Schnittstelle möchtest du gehen?
Hast du eine Steuerplatine oder willst du die LEDs direkt an die Datenpins des Parallelports hängen?

[Danilo]

Heute würde man das einfach selbst zeichnen mit CanvasGadget.

Die Boardsuche nach "LED" gibt aber auch schon viele (alte) Ergebnisse.
Zum Beispiel: Pseudo-Leucht-Dioden

Uralter Code von 2005, aber nach ein paar Änderungen läuft es wieder (nur auf Mac OS X getestet):

Code: Alles auswählen

#speed = 75 ; milliseconds

#point_w   = 14
#point_h   = 7
#display_w = 50*#point_w
#display_h = 17*#point_h

#points_horz = #display_w / #point_w
#points_vert = #display_h / #point_h

#font_w = 12
#font_h = #font_w

Structure DISPLAY_FONT
  x.b[#FONT_W]
  y.b[#points_vert]
EndStructure

Global Dim DISPLAY(#points_horz,#points_vert)
Global Dim POINT_ID(2)
Global Dim FONT_DATA(256,#font_w,#points_vert)

Procedure InitDisplayFont()
  image = CreateImage(#PB_Any,#font_w,#points_vert)
  If image
    font  = LoadFont(1,"Lucida Console",#font_h)
    If StartDrawing(ImageOutput(image))
      DrawingMode(1)
      DrawingFont(font)
      FrontColor(RGB($FF,$FF,$FF))
      For i = 0 To 255
        Box(0,0,#font_w,#points_vert,0)
        DrawText(0,0,Chr(i))
        For y = 0 To #points_vert-1
          For x = 0 To #font_w-1
            If Point(x,y)
               FONT_DATA(i,x,y)=1
            EndIf
          Next x
        Next y
      Next i
      StopDrawing()
    EndIf
    FreeFont(1)
    FreeImage(image)
  EndIf
EndProcedure

Procedure DrawDisplayText(text$,skip)
  If skip
    skip_x    = skip%#font_w
    skip_char = skip/#font_w
    If skip_char
      text$=Right(text$,Len(text$)-skip_char)
    EndIf
  EndIf
  index = -1
  count = Len(text$)
  If count
    For i = 0 To count-1
      char = Asc(Mid(text$,i+1,1))
      For x = 0+skip_x To #font_w-1
         index + 1
         If index > #points_horz
           ProcedureReturn
         EndIf
        For y = 0 To #points_vert-1
          DISPLAY(index,y)=FONT_DATA(char,x,y)
        Next y
      Next x
      skip_x = 0
    Next i
  EndIf
EndProcedure

Procedure UpdateDisplay()
  If StartDrawing(ImageOutput(2))
    For y = 0 To #points_vert-1
      For x = 0 To #points_horz-1
        DrawImage(POINT_ID(DISPLAY(x,y)),x*#point_w,y*#point_h)
      Next x
    Next y
    StopDrawing()
  EndIf
EndProcedure

If CreateImage(0,#point_w,#point_h)=0 Or CreateImage(1,#point_w,#point_h)=0 Or CreateImage(2,#display_w,#display_h)=0
  MessageRequester("ERROR","Cant create images !"):End
EndIf

Restore colors
For a = 0 To 1
  Read col
  POINT_ID(a) = ImageID(a)
  If StartDrawing(ImageOutput(a))
    ;Ellipse(#point_w/2,#point_h/2,(#point_w-1)/2,(#point_h-1)/2,col)
    Box(1,1,#point_w-1,#point_h-1,col)
    StopDrawing()
  EndIf
Next a


Restore text
Read.s DisplayText$

InitDisplayFont()
DrawDisplayText(DisplayText$,0):UpdateDisplay()

OpenWindow(0,0,0,#display_w,#display_h,"LeuchtDioden",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  ImageGadget(1,0,0,#display_w,#display_h,ImageID(2))
  AddWindowTimer(0,0,#speed)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Break
    Case #PB_Event_Timer
      index + 1
      If index > Len(DisplayText$)*#font_w
        index=0
      EndIf
      DrawDisplayText(DisplayText$,index):UpdateDisplay()
      SetGadgetState(1,ImageID(2))
  EndSelect
ForEver


DataSection
  colors:
    Data.l $404040, $0000FF
  text:
    Data.s "    Das ist ein Display-Test für Plankton..."
EndDataSection

[funker]

Hallo, danke.
Die LED sollen dann über die RS232 gesteuert werden.

Ich habe auch schon etwas gebastelt.
Habe mal eins getestet, aber es flackert wie wild und das Fenster lässt sich nicht mehr schliessen.

Es sollen 8 grüne werden und 10 rote LED.

Danke.
Gruss

Code: Alles auswählen

Global test.l

Enumeration
  #window_1  
  #Font_Window_0_0
  #b_los
EndEnumeration

Enumeration 
  #img_LED_Green1
  #img_LED_Green2
  #img_LED_Green3
  #img_LED_Green4
  #img_LED_Green5
  #img_LED_Green6
  #img_LED_Green7
  #img_LED_Green8
 
  #img_LED_Red1
  #img_LED_Red2
  #img_LED_Red3
  #img_LED_Red4
  #img_LED_Red5
  #img_LED_Red6
  #img_LED_Red7
  #img_LED_Red8
  #img_LED_Red9
  #img_LED_Red10  
EndEnumeration

Enumeration 
  #gad_LED_Green1
  #gad_LED_Green2
  #gad_LED_Green3
  #gad_LED_Green4
  #gad_LED_Green5
  #gad_LED_Green6
  #gad_LED_Green7
  #gad_LED_Green8
  
  #gad_LED_Red1
  #gad_LED_Red2
  #gad_LED_Red3
  #gad_LED_Red4
  #gad_LED_Red5
  #gad_LED_Red6
  #gad_LED_Red7
  #gad_LED_Red8
  #gad_LED_Red9
  #gad_LED_Red10
EndEnumeration


Procedure CreateLEDColor(ID, Color)
  If CreateImage(ID, 24,24)
    StartDrawing(ImageOutput(ID))
      Box(0,0, 24,24, RGB(255, 255, 255))
      Circle(12,12,7, Color)
    StopDrawing()
  EndIf
EndProcedure


LoadFont(#Font_Window_0_0,"Arial", 10, #PB_Font_Bold)
OpenWindow(#window_1, 500, 5,400,200, "LED", #PB_Window_SystemMenu)

CreateLEDColor(#img_LED_Green1, RGB(0, 255, 0))
CreateLEDColor(#img_LED_Green2, RGB(0, 255, 0))
CreateLEDColor(#img_LED_Green3, RGB(0, 255, 0))
CreateLEDColor(#img_LED_Green4, RGB(0, 255, 0))
CreateLEDColor(#img_LED_Green5, RGB(0, 255, 0))
CreateLEDColor(#img_LED_Green6, RGB(0, 255, 0))
CreateLEDColor(#img_LED_Green7, RGB(0, 255, 0))
CreateLEDColor(#img_LED_Green8, RGB(0, 255, 0))

ButtonGadget(#b_los, 10,160, 80, 25, "LED")

Repeat
  Event = WaitWindowEvent()
  
  Select Event
    Case #PB_Event_Gadget
      EventGadget = EventGadget()
      
      If EventGadget = #b_los
         test=1
      EndIf
      
    Case #PB_Event_CloseWindow
      EventWindow = EventWindow()
      If EventWindow = #Window_1
        CloseWindow(#Window_1)
        Break
      EndIf
  EndSelect
  
  If test =1
    ImageGadget(#gad_LED_Green1,  10, 10, 24,24, ImageID( #img_LED_Green1))     
  EndIf
  
  ForEver 

[Danilo]

Ich habe auch schon etwas gebastelt.
Habe mal eins getestet, aber es flackert wie wild und das Fenster lässt sich nicht mehr schliessen.

Das flackern kommt wohl, weil Du bei Test=1 in jedem Durchlauf das gleiche
Bild neu setzt. Mit einem "Test=0" sollte das nicht mehr passieren (auf Mac OS X flackert es auch so nicht).

Code: Alles auswählen

  If test=1
      ImageGadget(#gad_LED_Green1,  10, 10, 24,24, ImageID( #img_LED_Green1))
      test=0
  EndIf

[funker]

Ich nehme jetzt Sprites, funktioniert wunderbar.
Kann damit jetzt mein DE1-Board kontrollieren.

GRuss