Seite 1 von 1

DateSpinGadget, Datum mit Mausrad einstellen

Verfasst: 23.02.2023 14:58
von hjbremer
Das DateGadget ist ja toll, aber ich wollte das Datum nur mit dem Mausrad einstellen

Hier mein DateSpinGadget

Code: Alles auswählen

;HJBremer
;DateSpinGadget Feb.2023 - V1.3 - PB ab 5.70 x86 

;Tag mit Mausrad ändern, Monat/Jahr ändern wenn Taste M oder Y zusätzlich gedrückt
  
DeclareModule DateSpinGadget
   
   Declare.i DateSpinGadget(pbnr, x, y, br, hh, datemask$="%dd.%mm.%yy")  
   
   Declare.i DateSpinGadget_SetDate(pbnr, text$)
   
EndDeclareModule

Module DateSpinGadget 
   
   EnableExplicit
   
   Global datemin = Date(2020, 1, 2, 0, 0, 0)   ;gilt für alle DateSpinGadgets
   Global datemax = Date(2037, 12, 31, 0, 0, 0) ;könnte man auch via Procedure ändern
   
   Procedure.i DateSpinGadget_SetDate(pbnr, date$)
      
      Protected *datemask.String = GetGadgetData(pbnr)
      
      SetGadgetText(pbnr, date$)      
      SetGadgetState(pbnr, ParseDate(*datemask\s, date$))
      
   EndProcedure
   
   Procedure.i DateSpinGadget_Events()
      
      Protected eventtyp = EventType(), pbnr = EventGadget() 
      Protected old, new, add, *datemask.String = GetGadgetData(pbnr)
      
      Select eventtyp
         Case #PB_EventType_Up, #PB_EventType_Down
            
            add = 1
            If eventtyp = #PB_EventType_Down : add = -1 : EndIf
            
            old = GetGadgetState(pbnr)
            new = AddDate(old, #PB_Date_Day, add)         
            
            ;nur wenn #PB_Spin_ReadOnly gesetzt Taste M/Y, sonst #VK_LEFT/#VK_RIGHT nehmen
            If GetKeyState_(#VK_M) > 1                   ;nur Monat ändert sich
               new = AddDate(old, #PB_Date_Month, add)
            ElseIf GetKeyState_(#VK_Y) > 1               ;nur Jahr ändert sich
               new = AddDate(old, #PB_Date_Year, add)
            EndIf
            
            SetGadgetState (pbnr, new)
            SetGadgetText(pbnr, FormatDate(*datemask\s, new))
            
         Case #PB_EventType_Change ;wenn von Hand Textfeld ändern erlaubt    
            SetGadgetState(pbnr, ParseDate(*datemask\s, GetGadgetText(pbnr))) 
            
      EndSelect
      
   EndProcedure
   
   Procedure.i DateSpinGadget(pbnr, x, y, w, h, datemask$="%dd.%mm.%yy")
      
      Protected id, *datemask.String
      
      id = SpinGadget(pbnr, x, y, w, h, datemin, datemax, #PB_Spin_ReadOnly)  
      If pbnr = #PB_Any : pbnr = id: id = GadgetID(pbnr) : EndIf
      
      BindGadgetEvent(pbnr, @DateSpinGadget_Events())
      
      ;Hinweis: wird das Gadget vor ProgEnde gelöscht, FreeStructure() aufrufen
      *datemask = AllocateStructure(String)      
      *datemask\s = datemask$
      SetGadgetData(pbnr, *datemask)
      
      ;Set aktuelles Datum
      SetGadgetState(pbnr, Date()) 
      SetGadgetText(pbnr, FormatDate(datemask$, Date()))
      
      ProcedureReturn id
   EndProcedure
   
EndModule

UseModule DateSpinGadget

CompilerIf #PB_Compiler_IsMainFile
   
   LoadFont(0, "Consolas", 12)
   
   OpenWindow(0, 0, 0, 500, 220, "DateSpinGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
   
   DateSpinGadget(11, 10, 10, 120, 24)
   SetGadgetFont(11, FontID(0))   
   
   DateSpinGadget(12, 10, 50, 120, 24, "%dd.%mm.%yyyy")
   SetGadgetFont(12, FontID(0))   
   DateSpinGadget_SetDate(12, "19.05.2023")   
   
   Repeat
      Event = WaitWindowEvent()      
      Select Event            
         Case #PB_Event_Gadget
            Select EventGadget()
               Case 11 :  ;Debug EventType()
            EndSelect            
      EndSelect      
   Until Event = #PB_Event_CloseWindow
   
CompilerEndIf

PS: könnte man auch mit einem CanvasGadget machen glaube ich, da mir manches am SpinGadget nicht gefällt.