PureBoard

Verfasst: **18.03.2018 21:05**

schönen Guten Abend

ein Parameter der an eine Procedure übergeben wird, soll wahlweise eine Zahl oder ein String sein

In PB ist das normalerweise ohne nicht vorgesehen. Ich möchte auch keine Adresse übergeben.
Sondern wirklich entweder z.B. 69 oder einen String wie "65+85+84+79" angeben.

In folgendem Code habe ich das mit einem Macro gelöst, ist aber natürlich lange nicht perfekt,
sondern funktioniert nur unter bestimmten Voraussetzungen.

Gibt es eine Lösung oder einen besseren Weg als meiner ? Vielleicht mit RegEx um zu prüfen ob Zahl oder String ?

Mein Code funktioniert so wie im Beispiel bis auf e$. Auf die e$ Variante könnte ich aber verzichten.

Code: Alles auswählen

Procedure.s makechar2(test$)
   
   test$ = ReplaceString(test$, #DOUBLEQUOTE$, "")
   
   panz = CountString(test$, "+")
   If panz
      For j = 1 To panz + 1
         new$ + Chr(Val(StringField(test$, j, "+")))
      Next
   Else         
      new$ = Chr(Val(test$)): Debug " ist Zahl"
   EndIf
   
   ProcedureReturn new$  
EndProcedure



Macro test(gadget, x, y, br, hh, char)
   
   Debug makechar2(#DOUBLEQUOTE$ + char + #DOUBLEQUOTE$)
  
   Debug "-----"
   
EndMacro


a$ = "$4f+$42+$43"
b$ = "65+66+67"
c$ = "$4f"
d$ = "75"
e$ = "A"

test(gadget, x, y, br, hh, a$)
test(gadget, x, y, br, hh, b$)
test(gadget, x, y, br, hh, c$)
test(gadget, x, y, br, hh, d$)
test(gadget, x, y, br, hh, e$)
test(gadget, x, y, br, hh, "75+76+77")
test(gadget, x, y, br, hh, "$41+$42+$43")
test(gadget, x, y, br, hh, $41)
test(gadget, x, y, br, hh, 69)

Verfasst: **18.03.2018 22:10**

Ich kenne die folgende Möglichkeit. Die funktioniert allerdings nur, wenn du als Parameter eine Variable benutzt, nicht mit Strings oder Zahlen direkt. Allerdings habe ich vor einiger Zeit mal etwas gebastelt, was noch besser funktionierte. Das war aber ein ganz schönes Makrowirrwarr. Ich weiß nicht, ob ich das wieder finde.

Code: Alles auswählen

Macro test(gadget, x, y, br, hh, char)
	
	CompilerIf TypeOf(char) = #PB_String
		Debug ~"char ist ein String: \"" + char + ~"\""
	CompilerElse
		Debug ~"char ist eine Zahl: " + char
	CompilerEndIf
EndMacro


a$ = "$4f+$42+$43"
b$ = "65+66+67"
c$ = "$4f"
d$ = "75"
e$ = "A"
f = 69

test(gadget, x, y, br, hh, a$)
test(gadget, x, y, br, hh, b$)
test(gadget, x, y, br, hh, c$)
test(gadget, x, y, br, hh, d$)
test(gadget, x, y, br, hh, e$)
test(gadget, x, y, br, hh, f)

Was ist denn der genaue Hintergrund, warum du sowas machen möchtest?

Edit:
Ah, ich weiß wieder, was es war. Vielleicht hilft dir das, bin nicht sicher.

Code: Alles auswählen

EnableExplicit

Structure Vector
	x.f
	y.f
	z.f
EndStructure

Macro MacroRo
	ro
EndMacro

Macro VectorOp(op, opName)
	Procedure Vector#opName#Vector(*a.Vector, *b.Vector)
		*a\x op *b\x
		*a\y op *b\y
		*a\z op *b\z
	EndProcedure
	
	Procedure Vector#opName#Skalar(*a.Vector, b.f)
		*a\x op b
		*a\y op b
		*a\z op b
	EndProcedure
	Mac#MacroRo Vector#opName(a, b)
		CompilerIf Defined(a, #PB_Variable)	;a is a variable?
			CompilerIf Defined(b, #PB_Variable) ;b is a variable?
				CompilerIf TypeOf(b) = #PB_Structure ;b has a structure (unfortunality we can not check if the structure is really Vector)
					CompilerIf TypeOf(a) = #PB_Structure ;a has a structure
						Vector#opName#Vector(a, b)	;a and b have a structur
					CompilerElse
						Vector#opName#Skalar(b, a)	;b has a structure and a is a normal variable, maybe float or integer
					CompilerEndIf
				CompilerElse
					CompilerIf TypeOf(a) = #PB_Structure
						Vector#opName#Skalar(a, b)	;a has a structure and b is a normal variable, maybe float or integer
					CompilerElse
						CompilerError "VectorMul(Float, Float): At least on parameter has to be of type Vector."
					CompilerEndIf
				CompilerEndIf
			CompilerElse
				CompilerIf TypeOf(a) = #PB_Structure
					Vector#opName#Skalar(a, b)	;a has a structure und b is a constant value (until now only integers are possible)
				CompilerElse
					CompilerError "VectorMul(Float, Constant): At least on parameter has to be of type Vector."
				CompilerEndIf
			CompilerEndIf
		CompilerElse
			CompilerIf Defined(b, #PB_Variable)
				CompilerIf TypeOf(b) = #PB_Structure
					Vector#opName#Skalar(b, a)		;b has a structure und a is a constant value
				CompilerElse
					CompilerError "VectorMul(Constant, Float): At least on parameter has to be of type Vector."
				CompilerEndIf
			CompilerElse ;a und b sind keine Variablen -> Fehler
				CompilerError "VectorMul(Constant, Constant): At least on parameter has to be of type Vector."
			CompilerEndIf
		CompilerEndIf
;	EndMac#MacroRo
EndMacro

;For some reason I had to put the EndMacro after VectorOp instead of uncomment it three lines above
VectorOp(*, Mul)
EndMacro
VectorOp(+, Add)
EndMacro
VectorOp(/, Div)
EndMacro
VectorOp(-, Sub)
EndMacro

; After these macro executions the following procedures exist
; - VectorMulVector(*a.Vector, *b.Vector)
; - VectorMulSkalar(*a.Vector, b.f)
; - VectorAddVector(*a.Vector, *b.Vector)
; - VectorAddSkalar(*a.Vector, b.f)
; - VectorDivVector(*a.Vector, *b.Vector)
; - VectorDivSkalar(*a.Vector, b.f)
; - VectorSubVector(*a.Vector, *b.Vector)
; - VectorSubSkalar(*a.Vector, b.f)
;
; The following four macros help you ignoring the type and order of the parameters (overloading)
; - VectorMul(a, b)
; - VectorAdd(a, b)
; - VectorDiv(a, b)
; - VectorSub(a, b)

Define a.Vector, b.Vector, c.f
a\x = 1 : a\y = 2 : a\z = 3
b\x = 1 : b\y = 2 : b\z = 3
c = 4

Debug "a = (" + a\x + ", " + a\y + ", " + a\z + ")"
Debug "b = (" + b\x + ", " + b\y + ", " + b\z + ")"
Debug "c = " + c

VectorAdd(a, b)	;Vector + Vector
Debug "a + b"
Debug "a = (" + a\x + ", " + a\y + ", " + a\z + ")"

VectorMul(c, a) ;Skalar * Vector
Debug "c * a"
Debug "a = (" + a\x + ", " + a\y + ", " + a\z + ")"

VectorDiv(a, c) ;Vector / Skalar
Debug "a / c"
Debug "a = (" + a\x + ", " + a\y + ", " + a\z + ")"

VectorSub(a, b) ;Vector - Vector
Debug "a - b"
Debug "a = (" + a\x + ", " + a\y + ", " + a\z + ")"

VectorMul(a, 4) ;Vector * 4    ;Until now, it is not possible to using floating point numbers, but integers work as expected
Debug "a * 4"
Debug "a = (" + a\x + ", " + a\y + ", " + a\z + ")"

;To test the error checking uncomment one or more of these lines
;VectorAdd(3, 4)
;VectorAdd(c, c)
;VectorAdd(c, 2)

Verfasst: **18.03.2018 22:45**

Hier meine ominöse "IstStringEineZahl"-Funktion:

Code: Alles auswählen

Dim test.s(9)

test(0) = "%011100" ;gültige Bin-Zahl
test(1) = "21832789.3334"
test(2) = "$f3f0004fabcde" ;gültige Hex-Zahl
test(3) = "A12" ;keine gültige Hex-Zahl
test(4) = "234234.0"
test(5) = "-12.34A34"
test(6) = "123"
test(7) = "0.34"
test(8) = "-0.34"
test(9) = "-0" ; -0 ist wird bei mir als Zahl angesehen.

;Meine ziemlich ominöse IstZahl()-Funktion (ohne Exponential-Zahl (e) )
Procedure.s IstStringEineZahl(zahl.s)
  Protected pos = 0
  ;Hex-Prüfen
  If ( LTrim(zahl,Chr(36)) <> zahl And UCase(Hex(Val(zahl))) = UCase(LTrim(LTrim(zahl,Chr(36)),Chr(48))) ) Or zahl = "$0"
    ProcedureReturn "Ist warscheinlich eine hexadezimale Zahl."
  ElseIf ( LTrim(zahl,Chr(37)) <> zahl And UCase(Bin(Val(zahl))) = UCase(LTrim(LTrim(zahl,Chr(37)),Chr(48))) ) Or zahl = "%0"
    ProcedureReturn "Ist warscheinlich eine binäre Zahl."
  Else
    pos = Len(StringField(zahl , 2, "."))
    If LTrim(zahl,Chr(45)) = "0" Or StrD(ValD(zahl),pos) = zahl
      ProcedureReturn "Ist eine dezimale Zahl"
    Else
      ProcedureReturn "Ist keine dezimale, binäre oder hexadezimale Zahl"
    EndIf
  EndIf
EndProcedure

For i = 0 To 9
  Debug IstStringEineZahl(test(i))
Next i

>Auch wenn es nicht ganz dazu passt.

Verfasst: **19.03.2018 00:38**

NicTheQuick hat geschrieben: Was ist denn der genaue Hintergrund, warum du sowas machen möchtest?

Sowas. Ist aber noch nicht fertig und etwas sinnfrei, aber egal

Das wichtigste ist die Übergabe einer Variablen als Zahl oder String
hat man dafür eine kleine und simple Methode gefunden, kann man es immer wieder gebrauchen.

Code: Alles auswählen

#propname_Symbol = "symbolgadgetcb"

Procedure.i SymbolGadget_CB(hwnd, msg, wParam, lParam)       
   Protected oldproc = GetProp_(hwnd, #propname_Symbol)
   Protected pbnr = GetDlgCtrlID_(hwnd)   
   Protected tm.TRACKMOUSEEVENT      
   Static tracking, oldcolor      
   
   Select msg
      Case #WM_MOUSEMOVE
         If tracking = #False
            tracking = #True                    ;TRACKING wird gestartet
            tm\cbSize = SizeOf(TRACKMOUSEEVENT) ;auf #TME_HOVER könnte man verzichten, aber so ist es
            tm\dwFlags = #TME_LEAVE|#TME_HOVER  ;übersichtlicher und man könnte mehr Action einbauen.
            tm\hwndTrack = hwnd                 ;für welches Fenster/Gadget
            tm\dwHoverTime = 10                 ;Zeit bis #WM_MOUSEHOVER/#WM_MOUSELEAVE ausgelöst wird              
            TrackMouseEvent_(@tm)
         EndIf 
         
      Case #WM_MOUSEHOVER: 
         oldcolor = GetGadgetColor(pbnr, #PB_Gadget_FrontColor)
         SetGadgetColor(pbnr, #PB_Gadget_FrontColor, #Red)
         
      Case #WM_MOUSELEAVE: tracking = #False: SetGadgetColor(pbnr, #PB_Gadget_FrontColor, oldcolor)            
      Case #WM_LBUTTONUP: SetGadgetColor(pbnr, #PB_Gadget_FrontColor, #Red)
      Case #WM_LBUTTONDOWN: SetGadgetColor(pbnr, #PB_Gadget_FrontColor, #Green)            
   EndSelect
   
   ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wParam, lParam)     
EndProcedure

Procedure.i SymbolGadget1(gadget, x, y, br, hh, z$, text$="", fontid=1)
   ;br sollte min 32 sein
   
   Protected color, nr, pbid, pbnr, oldproc      
   Static f1id, f2id, f3id, size = 18
   
   Select fontid         ;Wingdings ist Standard
         Case 1: If f1id = 0: f1id = FontID(LoadFont(#PB_Any, "Wingdings", size)): EndIf: fontid = f1id: color = #Black
         Case 2: If f2id = 0: f2id = FontID(LoadFont(#PB_Any, "Webdings", size)): EndIf: fontid = f2id: color = $092D69
         Case 3: If f3id = 0: f3id = FontID(LoadFont(#PB_Any, "Segoe UI Emoji", size)): EndIf: fontid = f3id: color = $4C371A
      Default
   EndSelect
   
   If text$: z$ + " " + text$: EndIf
   
   nr = TextGadget(gadget, x, y, br, hh, z$, #SS_NOTIFY|#SS_CENTER|#SS_CENTERIMAGE);|#PB_Text_Border)
   
   If gadget = #PB_Any        
      pbid = GadgetID(nr): pbnr = nr
   Else
      pbid = nr: pbnr = gadget
   EndIf
   
   If fontid: SetGadgetFont(pbnr, fontid): EndIf
   SetGadgetColor(pbnr, #PB_Gadget_FrontColor, color)      
   oldproc = SetWindowLongPtr_(pbid, #GWL_WNDPROC, @SymbolGadget_CB())
   SetProp_(pbid, #propname_Symbol, oldproc)      
   ProcedureReturn nr
EndProcedure

Procedure.s makechar2(test$)
   
   test$ = ReplaceString(test$, #DOUBLEQUOTE$, "")
   
   panz = CountString(test$, "+")
   If panz
      For j = 1 To panz + 1
         new$ + Chr(Val(StringField(test$, j, "+")))
      Next
   Else         
      new$ = Chr(Val(test$)): Debug " ist Zahl"
   EndIf
   
   ProcedureReturn new$  
EndProcedure



Macro SymbolGadget(gadget, x, y, br, hh, char, text="", fontid=1)
   
   SymbolGadget1(gadget, x, y, br, hh, makechar2(#DOUBLEQUOTE$ + char + #DOUBLEQUOTE$), text, fontid)
   
EndMacro


OpenWindow(0, 0, 0, 470, 200, "TextGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)


SymbolGadget(0, 10,  10, 170, 33, 9742, "Telefon",3)

SymbolGadget(1, 10,  50, 170, 33, "$26df+$a0+$26df+$a0+$26df", "Autos", 3)

SymbolGadget(2, 10,  90, 170, 33, "$2639+$2639+$2639", "Mist", 3)


Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow

PureBoard

An Procedure Zahl oder String übergeben, geht es besser

An Procedure Zahl oder String übergeben, geht es besser

Re: An Procedure Zahl oder String übergeben, geht es besser

Re: An Procedure Zahl oder String übergeben, geht es besser

Re: An Procedure Zahl oder String übergeben, geht es besser