gedrückter button, nur ein event

[kartmanne]

HI,

ich habe in einem Formular einen Button. Erreichen möchte ich, dass eine code-sequenz so lange ausgeführt ausgeführt wird, so lange der Button gedrückt wird.

Mit folgendem code geht das nicht. Es werden anscheinend so viele events erzeugt, dass diese noch abgearbeitet werden, wenn der button schon längst gelöst wurde.

Da ich PB noch nicht lange benutze, könnt ihr mir sicher einen Tip geben, wie sowas mit PB-Mitteln lösbar sein könnte...

Code: Alles auswählen

repeat
waitwindowevent()
Select EventGadget()
   Case Buttont_11   
      If senpos<180:senpos=senpos+1:EndIf
         SetGadgetText(senpos_e,Str(senpos))
      EndIf
delay(100)
EndSelect
forever

[Bisonte]

Wenn man nicht mit Threads arbeiten möchte, sollte man in deinem Fall das CanvasGadget nehmen und kein ButtonGadget.
Bei dem Canvas kann man die Events des Mausklicks spezieller auswerten. (als Beispiel : #PB_EventType_LeftButtonDown/#PB_EventType_LeftButtonUp)

Edit : Hier ein kurzer Code um zu zeigen wie ich das meine ....

Code: Alles auswählen

EnableExplicit

Define MaustasteUnten = #False
Define TextGadget, Canvas, Event, Quit, Pos

OpenWindow(0, 0, 0, 640, 480, "Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)

TextGadget = TextGadget(#PB_Any, 10, 10, 100, 20, "0")
Canvas = CanvasGadget(#PB_Any, 130, 10, 100, 20)
StartDrawing(CanvasOutput(Canvas))
Box(0,0,OutputWidth(),OutputHeight(), $000000)
StopDrawing()

Repeat
  
  Event = WaitWindowEvent(25) ; Mit Timeout, damit die Schleife auch ausgeführt wird wenn nichts passiert.
  
  If MaustasteUnten
    Pos + 1
    SetGadgetText(TextGadget, Str(Pos))
  EndIf
  
  Select Event
      
    Case #PB_Event_CloseWindow
      Quit = 1
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case Canvas
          Select EventType()
            Case #PB_EventType_LeftButtonDown
              MaustasteUnten = #True
              StartDrawing(CanvasOutput(Canvas))
              Box(0,0,OutputWidth(),OutputHeight(), $FF0000)
              StopDrawing()
            Case #PB_EventType_LeftButtonUp
              MaustasteUnten = #False
              StartDrawing(CanvasOutput(Canvas))
              Box(0,0,OutputWidth(),OutputHeight(), $000000)
              StopDrawing()
          EndSelect
      EndSelect
      
      
  EndSelect
  
Until Quit > 0

[ts-soft]

Schönes Beispiel

Ich würde aber eher einen Timer nutzen, statt des Timeouts:

Code: Alles auswählen

EnableExplicit

Define MaustasteUnten = #False
Define TextGadget, Canvas, Event, Quit, Pos

OpenWindow(0, 0, 0, 640, 480, "Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)

TextGadget = TextGadget(#PB_Any, 10, 10, 100, 20, "0")
Canvas = CanvasGadget(#PB_Any, 130, 10, 100, 20)
StartDrawing(CanvasOutput(Canvas))
Box(0,0,OutputWidth(),OutputHeight(), $000000)
StopDrawing()
AddWindowTimer(0, 1, 25)

Repeat
 
  Event = WaitWindowEvent()
 
  Select Event
     
    Case #PB_Event_CloseWindow
      Quit = 1
     
    Case #PB_Event_Timer
      Select EventTimer()
        Case 1
          If MaustasteUnten
            Pos + 1
            SetGadgetText(TextGadget, Str(Pos))
          EndIf
      EndSelect
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case Canvas
          Select EventType()
            Case #PB_EventType_LeftButtonDown
              MaustasteUnten = #True
              StartDrawing(CanvasOutput(Canvas))
              Box(0,0,OutputWidth(),OutputHeight(), $FF0000)
              StopDrawing()
            Case #PB_EventType_LeftButtonUp
              MaustasteUnten = #False
              StartDrawing(CanvasOutput(Canvas))
              Box(0,0,OutputWidth(),OutputHeight(), $000000)
              StopDrawing()
          EndSelect
      EndSelect
     
     
  EndSelect
 
Until Quit > 0 

Gruß
Thomas

[kartmanne]

HI,

ok. Danke. Aber ....hmmm...

Sehe ich das richtig, dass dann das Design des Buttons nicht am ausgewählten windows-design hängt? Der Button wäre ein eigenes Dings.

[RSBasic]

Das stimmt. Mit CanvasGadget zeichnest du komplett selber.

[kartmanne]

HI,

dann wäre das für mich eine Lösung - aber irgendwie nicht "schön"

[RSBasic]

Mit etwas mehr Aufwand kannst du auch aus den Theme-Ressourcendateien des Betriebssystems die einzelnen Buttongrafiken laden und wiederverwenden, damit deine eigenen Schaltflächen genau wie echte Windows-Buttons aussehen.

Alternativ (nur für Windows) kannst du auch den folgenden Code verwenden: http://www.purebasic.fr/german/viewtopi ... 61#p329961
Zwischen #WM_LBUTTONDOWN und #WM_LBUTTONUP kannst du auch einen Timer starten, um zu ermitteln, wie lange auf den Button gedrückt wurde.

[RSBasic]

mk-soft hat eben eine Include für eigene Buttons programmiert und bereitgestellt. Es sind zwar immer noch keine echten OS-Buttons, aber sehen ähnlich aus: http://www.purebasic.fr/german/viewtopi ... 3&p=330066

[mk-soft]

Mit den CanvasGadget kann man so einiges selber erstellen...

Hab man ein Projekt von mir aufgeräumt.
http://www.purebasic.fr/german/viewtopi ... =8&t=28903



P.S.
Danke RSBasic. warst schneller

[kartmanne]

HI,

boar, ey... das nenn ich mal Einsatz

Ich versuche den code mal zu durchdringen. Schließlich möcht ich schon verstehen, was ich benutz