Aktuelle Zeit: 26.05.2020 14:18

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 3 Beiträge ] 
Autor Nachricht
 Betreff des Beitrags: WheelButton habe ich meine Idee genannt
BeitragVerfasst: 06.03.2020 18:56 
Offline
Benutzeravatar

Registriert: 27.02.2006 22:30
Wohnort: Neumünster
Hier meine neueste Idee

kann man noch erweitern, aber man kann ja klein anfangen.

Vorschläge willkommen.

Code:
;WheelButton, V.2.0, PB 5.41 x86 - Feb.2020 by HJBremer

DeclareModule WheelButton
   
   Declare.i WheelButton(pbnr, x, y, width, height, text$, flag=0, format$="######.##")
   Declare.i WheelButton_Free(pbnr)
   
   Declare.i WheelButton_AddText (pbnr, text$)
   Declare.s WheelButton_GetText (pbnr, item=-1)
   Declare.i WheelButton_SetText (pbnr, info$, idx=1)     
   Declare.i WheelButton_SetItem (pbnr, item)   
   Declare.i WheelButton_SetSize (pbnr, size.d, font=-1)
   Declare.i WheelButton_SetColor(pbnr, color, idx=0)
   
   #Wheel_Info1 = 1: #Wheel_Liste = 2: #Wheel_Info2 = 3: #Wheel_Result = 4
   
EndDeclareModule

Module WheelButton
   
   EnableExplicit
   
   Global def_font = LoadFont(#PB_Any, "Verdana", 12, #PB_Font_Bold) ;Vorgabe Font für Text
   
   ;- Structure
   Structure WheelButton   
      pbnr.i            ;PbNr vom Canvasgadget
      lvnr.i            ;PbNr vom ListViewgadget
      font.i : size.d   ;
      item.i      ;intern: aktuelles Listenelement
      flag.i      ;#PB_Text_Border | #PB_String_Numeric | [#PB_Text_Right #PB_Text_Center]
      format.s    ;wenn Listentext Zahlen und flag #PB_String_Numeric, Vorgabe="######.##"
      text.s[5]   ;index 0-4, nur 1-4 wird genutzt, 1=InfoText 2=ListenText 3=Infotext 4=Text rechts
      color.i[5]  ;index 0-4, 0-4 wird genutzt, [0] ist Windowfarbe, 1-4 Textfarben
   EndStructure
   
   Procedure.i WheelButton_Draw(*wb.WheelButton)
      Protected a = $FF000000             ;Alphawert von VectorSourceColor
      Protected gw, gh, j, abstand = 2
      Protected.d x, y, w, h, z = 0.001   ;damit w+h in DrawVectorParagraph > null, z addieren
     
      With *wb     
         StartVectorDrawing(CanvasVectorOutput(\pbnr))           
            gw = GadgetWidth(\pbnr): gh = GadgetHeight(\pbnr)           
           
            AddPathBox(0, 0, gw, gh): VectorSourceColor(a|\color[0]): FillPath() ;Canvas Background
            If \flag & #PB_Text_Border
               AddPathBox(0, 0, gw, gh): VectorSourceColor(a|#Gray): StrokePath(2)  ;Rahmen
            EndIf
           
            ;- Text
            VectorFont(FontID(\font), \size)
           
            \text[2] = Trim(GetGadgetItemText(\lvnr, \item))   ;Text aus der Liste
           
            h = VectorTextHeight(\text[2]) + z
            w = VectorTextWidth(\text[1] + \text[2] + \text[3] + \text[4]) + (z*3)
            x = 0 : y = gh/2 - h/2
           
            If \flag & #PB_Text_Border : x = abstand : gw - abstand : EndIf
            If \flag & #PB_Text_Right  : x + (gw-w-abstand-abstand) : EndIf
            If \flag & #PB_Text_Center : x + ((gw-w)/2) - 1 : EndIf
            ;AddPathBox(x, y, w, h): VectorSourceColor(a|#Blue): StrokePath(1)
           
            For j = 1 To 4    ;1=Info links, 2=Text aus Liste, 3=mitte, 4=rechts   
               MovePathCursor(x, y) : VectorSourceColor(a | \color[j])         
               w = VectorTextWidth(\text[j]) + z
               DrawVectorParagraph(\text[j], w, h) : x + w
               ;DrawVectorText(\text[j]) : x + w
            Next
           
         StopVectorDrawing()
      EndWith   
   EndProcedure
   
   Procedure.s WheelButton_Numeric(text$, format$)
      Protected p, d, komma$ = "."     
     
      If FindString(format$, ","): komma$ = ",": text$ = ReplaceString(text$, "," , "."): EndIf  ;Komma ?
     
      p = FindString(format$, komma$)        ;suche Komma
      If p : d = Len(format$) - p : EndIf    ;Anzahl Kommastellen
     
      text$ = StrF(ValF(text$), d)           ;Kommastellen auffüllen/abschneiden
      text$ = RSet(text$, Len(format$))      ;Leerzeichen vorweg sonst sortiert die Liste falsch
     
      If komma$ = ",": text$ = ReplaceString(text$, "." , ","): EndIf   ;falls Komma, Punkt weg
     
      ProcedureReturn text$
   EndProcedure 
   
   Procedure.i WheelButton_Free(pbnr)     
      Protected *wb.WheelButton = GetGadgetData(pbnr)
      FreeGadget(*wb\lvnr) : FreeGadget(*wb\pbnr) : FreeStructure(*wb)
   EndProcedure
   
   Procedure.i WheelButton_AddText(pbnr, text$)     
      Protected *wb.WheelButton = GetGadgetData(pbnr)
      If *wb\flag & #PB_String_Numeric : text$ = WheelButton_Numeric(text$, *wb\format) : EndIf     
      SendMessage_(GadgetID(*wb\lvnr), #LB_ADDSTRING, 0, @text$) 
   EndProcedure 
   
   Procedure.s WheelButton_GetText(pbnr, item=-1)     
      Protected *wb.WheelButton = GetGadgetData(pbnr)
      If item = -1
         ProcedureReturn GetGadgetItemText(*wb\lvnr, *wb\item)
      Else
         ProcedureReturn GetGadgetItemText(*wb\lvnr, item)
      EndIf
   EndProcedure
   
   Procedure.i WheelButton_SetText(pbnr, info$, idx=1)     
      Protected *wb.WheelButton = GetGadgetData(pbnr)
      ;1=links; 2=mitte links (Liste); 3=mitte rechts; 4=rechts
      If idx < 5 And idx > 0 : *wb\text[idx] = info$ : EndIf
      WheelButton_Draw(*wb)
   EndProcedure
   
   Procedure.i WheelButton_SetColor(pbnr, color, idx=0)
      Protected *wb.WheelButton = GetGadgetData(pbnr)
      ;0=Window; 1=links; 2=mitte links (Liste); 3=mitte rechts; 4=rechts
      If idx < 5 And idx > -1 : *wb\color[idx] = color : EndIf
      WheelButton_Draw(*wb)
   EndProcedure   
   
   Procedure.i WheelButton_SetItem(pbnr, item)     
      Protected *wb.WheelButton = GetGadgetData(pbnr)     
      *wb\item = item
      WheelButton_Draw(*wb)
   EndProcedure 
   
   Procedure.i WheelButton_SetSize(pbnr, size.d, font=-1)     
      Protected *wb.WheelButton = GetGadgetData(pbnr)     
      *wb\size = size
      If font > -1: *wb\font = font: EndIf
      WheelButton_Draw(*wb)
   EndProcedure   
   
   Procedure.i WheelButton_Event()   
      Protected *wb.WheelButton = GetGadgetData(EventGadget())     
      Protected mx, flag=#True, min=0, max=CountGadgetItems(*wb\lvnr)-1
      If EventType() = #PB_EventType_MouseWheel ;wenn mehrere EventTypes muß Abfrage sein
            *wb\item + GetGadgetAttribute(*wb\pbnr, #PB_Canvas_WheelDelta) ;:Debug  *wb\item   
            If *wb\item < min : *wb\item = min : flag = #False : EndIf
            If *wb\item > max : *wb\item = max : flag = #False : EndIf     
            If flag = #True     
               PostEvent(#PB_Event_Gadget, EventWindow(), *wb\pbnr, #PB_EventType_Change)
               WheelButton_Draw(*wb)
            EndIf
       EndIf
   EndProcedure
   
   Procedure.i WheelButton(pbnr, x, y, width, height, text$, flag=0, format$="######.##")     
      Protected id, *wb.WheelButton = AllocateStructure(WheelButton)
     
      id = CanvasGadget(pbnr, x, y, width, height)
      If pbnr = #PB_Any : pbnr = id : EndIf       
      SetGadgetData(pbnr, *wb)
     
      With *wb
         \pbnr = pbnr
         \lvnr = ListViewGadget(#PB_Any, 0,0,0,0, #LBS_SORT) : HideGadget(\lvnr, 1)
         \font = def_font
         \size = 12
         \flag = flag
         \format = format$
         \color[0] = $f0f0f0         
         \color[1] = #Gray : \color[3] = #Gray
         \color[2] = #Blue : \color[4] = #Red
         SetGadgetAttribute(\pbnr, #PB_Canvas_Cursor, #PB_Cursor_Hand)   
         BindGadgetEvent(\pbnr, @WheelButton_Event(), #PB_EventType_MouseWheel)
      EndWith     
      WheelButton_AddText(pbnr, text$)
      WheelButton_Draw(*wb)     
      ProcedureReturn id
   EndProcedure
   
EndModule

UseModule WheelButton

CompilerIf #PB_Compiler_IsMainFile
   
   Procedure.s BerechneInfo1(pbnr)
     
      Protected a$ = WheelButton_GetText(pbnr)
      Protected wert.f = ValF(a$) * 1.19 : a$ = StrF(wert, 2) 
      ;a$ = ReplaceString(a$, "." , ",")   ;mit Komma
      WheelButton_SetText(pbnr, a$, #Wheel_Result)
      ProcedureReturn a$   
   EndProcedure
   

   
   Define event, test$, j, item
   
   OpenWindow(10, 0, 0, 820, 420, "Canvas example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
   
   WheelButton(1, 11, 50, 320, 30, "50", #PB_Text_Border|#PB_Text_Center|#PB_String_Numeric)
   
   WheelButton_AddText(1, "75")
   WheelButton_AddText(1, "100")
   WheelButton_AddText(1, "125")
   WheelButton_AddText(1, "150")
   WheelButton_AddText(1, "175")
   WheelButton_AddText(1, "57.22")
   WheelButton_AddText(1, "200")
   WheelButton_AddText(1, "1200")
   
   WheelButton_SetSize(1, 14)
   WheelButton_SetItem(1, 3)
   WheelButton_SetText(1, "Netto: ", #Wheel_Info1)
   WheelButton_SetText(1, "  + 19% MwSt: ", #Wheel_Info2)
   WheelButton_SetColor(1, #Magenta, #Wheel_Result)
   
   BerechneInfo1(1)

   Repeat
      Event = WaitWindowEvent()   
      If Event = #PB_Event_Gadget
         
         Select EventGadget()           
            Case 1               
               If EventType() = #PB_EventType_Change  ;EventType() Abfrage muß beim Canvas sein !!!!
                  a$ = BerechneInfo1(1)               
               EndIf
               
         EndSelect
         
      EndIf   
   Until Event = #PB_Event_CloseWindow
CompilerEndIf

_________________
Purebasic 5.60 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: WheelButton habe ich meine Idee genannt
BeitragVerfasst: 06.03.2020 19:57 
Offline
Benutzeravatar

Registriert: 04.02.2005 15:40
Wohnort: Kaufbeuren
Ein kleiner Hinweis zur Funktionsweise wäre nett gewesen. :wink:
Musste erst den ganzen Code durchforsten, bis ich herausgefunden habe, wie der Button funktioniert.

Wer sich die Arbeit ersparen will, der Button reagiert nur auf das Mausrad.

Es ist sozusagen eine Mausrad nutzende ComboBox ohne Liste, die gleichzeitig bei jeder Änderung Berechnungen anstellen kann.

PS: Ich glaube, du hast mich gerade auf eine interessante Idee gebracht: eine Kombination von ComboBox und SpinGadget, die sich auch mit einem Mausrad bedienen ließe.

_________________
Download der Module
Download der Programme

Bild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: WheelButton habe ich meine Idee genannt
BeitragVerfasst: 06.03.2020 23:52 
Offline
Benutzeravatar

Registriert: 08.09.2004 08:21
Wohnort: Amphibios 9
hjbremer hat geschrieben:
Vorschläge willkommen.

ein Screenshot wäre nicht schlecht.

_________________
Schrödingers Smiley :):


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 3 Beiträge ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 3 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye