PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

[Gelöst] Suche Lösung für Float Input Gadget

https://www.purebasic.fr/german/viewtopic.php?t=25210

Seite 1 von 1

[Gelöst] Suche Lösung für Float Input Gadget

Verfasst: 10.02.2012 12:48
von mpz
Hi,

ich möchte Eingabefelder auf einem Windows Fenster erstellen mit Gadgets. In eins der Felder soll man float Werte eingeben können z.B. 0.01 oder 1.05. Ich vermute das man ein Textgadegt ummodeln muss das es nur noch float Werte annehmen kann. Ich habe schon gesucht aber nichts sinnvolles gefundnen. Hat jemand ein Tipp für mich?


Gruß Michael

Re: Suche Lösung für Float Input Gadget

Verfasst: 10.02.2012 13:24
von HeX0R
FloatGadget.pbi [WinOnly]:

Code: Alles auswählen

;/-------------
;| FloatGadget.pbi
;| V1.002 [19.01.2011]
;| (Well, in fact it is a DoubleGadget)
;|
;| ©HeX0R 2008/2011
;| Based on edels code here:
;| http://www.purebasic.fr/german/viewtopic.php?t=7450#81584
;|
;| [German Text / too lazy too translate]
;| Das FloatGadget macht endlich Schluß mit den Rundungsfehlern
;| und endlosen Gedanken über die angezeigten Nachkommastellen.
;| Der echte Doublewert wird einfach mitgespeichert und ist
;| unabhängig von der Darstellung.
;| Mit der Taste E kann man die Anzeige in Exponentialform
;| hin- und herschalten.
;|
;| Man sollte, um Verfälschungen möglichst gering zu halten
;| dann die Funktionen:
;|
;| SetFloatGadgetValue()
;| &
;| GetFloatGadgetValue()
;|
;| benutzen, um mit dem Gadget zu kommunizieren.
;| Natürlich geht auch das übliche Set/GetGadgetText().
;|
;/-------------
#STRING_FLOAT_IDENTIFY_VALUE = $1a2b3d4e

#STRING_FLOAT_USE_SIMPLE_MODE = $00000001
#STRING_FLOAT_USE_SEPERATOR   = $00000002 ;<-Not yet

#SF_GET_DECIMAL          = 1
#SF_GET_SEPERATOR        = 2

#SF_ATTRIBUTE_EXPODIGITS = 1

Structure _FLOAT_GADGET_HELPER_
	Identify.l     ;Identify-Long, just to make sure this is really a FloatGadget
	*OldProcedure  ;Address of old Callback-Procedure
	RealValue.d    ;Holds the real value
	Decimals.l     ;Digits
	Flags.l        ;Some more Flags
	ExpoDigits.l
EndStructure

Procedure.s internal_FG_GetValues(Num = -1)
	Static FLOAT_GADGET_DECIMAL.s
	Static FLOAT_GADGET_SEPERATOR.s
	Protected Result.s, numChars
	
	If FLOAT_GADGET_DECIMAL = ""
		;First Call!
		numChars             = GetLocaleInfo_(#LOCALE_USER_DEFAULT, #LOCALE_SDECIMAL, FLOAT_GADGET_DECIMAL, 0)
		FLOAT_GADGET_DECIMAL = Space(numChars + 1)
		GetLocaleInfo_(#LOCALE_USER_DEFAULT, #LOCALE_SDECIMAL, FLOAT_GADGET_DECIMAL, numChars)
		
		numChars               = GetLocaleInfo_(#LOCALE_USER_DEFAULT, #LOCALE_STHOUSAND, FLOAT_GADGET_SEPERATOR, 0)
		FLOAT_GADGET_SEPERATOR = Space(numChars + 1)
		GetLocaleInfo_(#LOCALE_USER_DEFAULT, #LOCALE_STHOUSAND, FLOAT_GADGET_SEPERATOR, numChars)
	EndIf
	
	If Num = #SF_GET_DECIMAL
		Result = FLOAT_GADGET_DECIMAL
	ElseIf Num = #SF_GET_SEPERATOR
		Result = FLOAT_GADGET_SEPERATOR
	EndIf
	
	ProcedureReturn Result
EndProcedure

Procedure.s ParseFloat2(d.d, Expo)
	;/----------------
	;| Very stupid function
	;| Just cut unused zeros.
	;| If StrD() will return this:
	;| 1.000000
	;| Function will return
	;| 1
	;|
	;| You can activate this simple FloatParsing
	;| if you set SpecialFlags of FloatGadget-Procedure to #True
	;/----------------

	Protected i, a$
	
	a$ = StrD(d, Expo)
	For i = 1 To Expo
		If Right(a$, 1) = "0"
			a$ = Left(a$, Len(a$) - 1)
		EndIf
	Next i
	If Right(a$, 1) = "."
		a$ = Left(a$, Len(a$) - 1)
	EndIf
	
	
	ProcedureReturn a$
EndProcedure

Procedure.s ParseFloat(d.d, Expo = 7, ExpoDigits = 2)
	;/--------------
	;| Similar to StrD(), BUT:
	;| StrD() is too stupid, to handle floats/doubles correctly.
	;| Examples:
	;| StrD(0.0000000123456789, 7)       = "0.0000000"
	;| ParseFloat(0.0000000123456789, 7) = "0.000000012345679"
	;| StrD(0, 7)                        = "0.0000000"
	;| ParseFloat(0, 7)                  = "0"
	;|
	;| See the point?
	;| It checks where the interesting part of a number begins.
	;|
	;| Make Expo negative to Show with exponent (1.23E-03 for example)
	;|
	;/--------------

	Protected i, e, Result.s, Exp.s, f.d = Abs(d), Minus.s = ""
	
	If d < 0.0
		Minus = "-"
	EndIf
	If Expo >= 0
		d = f
		If d > 0.0 And d < 1.0
			While d < 1.0
				d * 10
				Expo + 1
			Wend
		EndIf
	Else
		Expo = - Expo
		If IsInfinity(f)
			f = 0
		EndIf
		If f > 1.0
			While f >= 10.0
				e + 1
				f / 10
				Expo + 1
			Wend
			If e
				Exp = "E+" + RSet(Str(e), ExpoDigits, "0")
			EndIf
		ElseIf f > 0 And f < 1.0
			While f < 1.0
				e + 1
				f * 10
			Wend
			If e
				Exp = "E-" + RSet(Str(e), ExpoDigits, "0")
			EndIf
		EndIf
	EndIf

; 	Result = StrD(f, Expo)
; 	While Right(Result, 1) = "0"
; 		Result = Left(Result, Len(Result) - 1)
; 	Wend
; 	If Right(Result, 1) = "."
; 		Result = Left(Result, Len(Result) - 1)
; 	EndIf
;		Result = Minus + Result + Exp
	Result = Minus + ParseFloat2(f, Expo) + Exp
	ProcedureReturn Result
EndProcedure

Procedure.s CheckForForbiddenChars(a$, Expo)
	Protected Result.s, i, FoundE, OK, FoundComma, *C.CHARACTER = @a$
	
	FoundE     = -1
	FoundComma = -1
	
	While *C\c
		OK = #False
		If *C\c = ',' Or *C\c = '.'
			If FoundComma = -1 And FoundE = -1
				*C\c       = '.'
				FoundComma = i
				OK         = #True
			EndIf
		ElseIf *C\c = 'e' Or *C\c = 'E'
			If FoundE = -1
				FoundE = i
				*C\c   = 'E'
				OK     = #True
			EndIf
		ElseIf *C\c >= '0' And *C\c <= '9'
			If FoundE > -1 And FoundE = i - 1
				Result + "+"
			EndIf
			OK = #True
		ElseIf *C\c = '-'
			If Result = ""
				OK      = #True
			ElseIf FoundE > -1 And FoundE = i - 1
				OK      = #True
			EndIf
		ElseIf *C\c = '+'
			If FoundE > -1 And FoundE = i - 1
				OK = #True
			EndIf
		EndIf
		If OK
			Result + Chr(*C\c)
			i + 1
		EndIf
		*C + SizeOf(CHARACTER)
	Wend
	
	FoundE = FindString(Result, "E", 1)
	If FoundE
		If Len(Result) < FoundE + Expo + 1
			Result = LSet(Result, FoundE + Expo + 1, "0")
		ElseIf Len(Result) > FoundE + Expo + 1
			Result = Left(Result, FoundE + Expo + 1)
		EndIf
	EndIf
	
	ProcedureReturn Result
EndProcedure

Procedure FloatGadget_Callback(hWnd, Msg, wParam, lParam)
	Protected *SGF._FLOAT_GADGET_HELPER_ = GetWindowLongPtr_(hWnd, #GWL_USERDATA)
	Protected i, j, k, L, m, OldProc
	Protected Input.s, Buffer.s = Space(256)

	If *SGF
		OldProc = *SGF\OldProcedure
	EndIf

	Select Msg

		Case #WM_SETTEXT
			If lParam
				Input          = CheckForForbiddenChars(PeekS(lParam), *SGF\ExpoDigits)
				*SGF\RealValue = ValD(Input)
			Else
				*SGF\RealValue = 0.0
			EndIf
			If FindString(Input, "E", 1)
				Buffer = ParseFloat(*SGF\RealValue, -*SGF\Decimals, *SGF\ExpoDigits)
			Else
				Buffer = ParseFloat(*SGF\RealValue, *SGF\Decimals, *SGF\ExpoDigits)
			EndIf
			SendMessage_(hWnd, #EM_SETSEL, 0, -1)
			SendMessage_(hWnd, #EM_REPLACESEL, 0, @Buffer)
			SendMessage_(hWnd, #EM_SETSEL, 0, 0)
			OldProc = #False

		Case #WM_LBUTTONUP
			
		Case #WM_CHAR
			SendMessage_(hWnd, #EM_GETSEL, @i, @j)
			L = SendMessage_(hWnd, #WM_GETTEXT, 256, @Buffer)
			k = FindString(Buffer, "E", 1)
			m = #True
			If wParam >= '0' And wParam <= '9'
				If k
					If j = k
						OldProc = #Null
					ElseIf j > k
						Buffer = Left(Buffer, j) + Chr('0' + wParam - #VK_0) + Mid(Buffer, j + 2)
						k      = FindString(Buffer, "E", 1)
						If k And Len(Buffer) > k + *SGF\ExpoDigits + 1
							Buffer = Left(Buffer, k + *SGF\ExpoDigits + 1)
							i - 1
							j - 1
						EndIf
						SendMessage_(hWnd, #EM_SETSEL, 0, -1)
						SendMessage_(hWnd, #EM_REPLACESEL, 0, @Buffer)
						SendMessage_(hWnd, #EM_SETSEL, i + 1, j + 1)
						OldProc = #Null
					EndIf
				EndIf
			ElseIf wParam = #VK_BACK
				If k
					;Only check if in expo-view-mode
					If j = k + 1 Or j = k
						;if cursor is here: 0,123E<HERE>+01 or here: 0,123E+<HERE>01 just move cursor to the left
						SendMessage_(hWnd, #EM_SETSEL, i - 1, j - 1)
						OldProc = #Null
					ElseIf j > k
						;we are in the middle of the exponent
						Input          = Left(Buffer, i - 1) + "0" + Mid(Buffer, j + 1)
						OldProc        = #Null
						*SGF\RealValue = ValD(Input)
						SendMessage_(hWnd, #EM_SETSEL, 0, -1)
						SendMessage_(hWnd, #EM_REPLACESEL, 0, @Input)
						SendMessage_(hWnd, #EM_SETSEL, i - 1, j - 1)
					EndIf
				EndIf
			ElseIf wParam = '.'
				If FindString(Buffer, ".", 1)
					OldProc = #Null
				ElseIf k > 0 And j >= k
					OldProc = #Null
				Else
					Input          = Left(Buffer, i) + "." + Mid(Buffer, j + 1)
					*SGF\RealValue = ValD(Input)
				EndIf
			Else
				OldProc = #Null
			EndIf

		Case #WM_KEYDOWN
			SendMessage_(hWnd, #EM_GETSEL, @i, @j)
			L = SendMessage_(hWnd, #WM_GETTEXT, 256, @Buffer)
			k = FindString(Buffer, "E", 1)
	 		m = #True
	 		If wParam = #VK_DELETE
	 			;The Delete-Key should be checked, directly, when pressed,
	 			;otherwise it might be too late!
				If k
					;Only check in Expo-View-Mode
					If j = k - 1
						;Cursor is here: 0,123<HERE>E+01, don't delete the "E"!
						OldProc = #Null
						m       = #False
					ElseIf j = k
						;Cursor is here: 0,123E<HERE>+01, don't delete the "+"!
						OldProc = #Null
						m       = #False
					ElseIf j > k
						OldProc = #Null
						m       = #False
						If i < L
							;Cursor is NOT at the end
							Input          = Left(Buffer, i) + "0" + Mid(Buffer, j + 2)
							*SGF\RealValue = ValD(Input)
							SendMessage_(hWnd, #EM_SETSEL, 0, -1)
							SendMessage_(hWnd, #EM_REPLACESEL, 0, @Input)
							SendMessage_(hWnd, #EM_SETSEL, i, j)
						EndIf
					EndIf
				EndIf
			EndIf
			If m
				;Value changed, get new value
 				L              = SendMessage_(hWnd, #WM_GETTEXT, 256, @Buffer)
 				Input          = CheckForForbiddenChars(Left(Buffer, L), *SGF\ExpoDigits)
 				*SGF\RealValue = ValD(Input)
 			EndIf
 			
		Case #WM_KEYUP
			SendMessage_(hWnd, #EM_GETSEL, @i, @j)
			L = SendMessage_(hWnd, #WM_GETTEXT, 256, @Buffer)
			k = FindString(Buffer, "E", 1)
			m = #True

			If wParam = #VK_DECIMAL Or wParam = $BC Or wParam = $BE
				If FindString(Buffer, ".", 0) = 0
					;We don't have a decimal point yet
					If L = 0 Or Buffer = "-"
						;String is empty, or just a "-" in it.
						;Therefore, we will add a "0."
						Input = "0."
					Else
						;Nothing special, add point
						Input = "."
					EndIf
					SendMessage_(hWnd, #EM_REPLACESEL, 0, @Input)
				Else
					;There is allready a decimal point, so this keystroke is ignored
					m = #False
				EndIf

			ElseIf wParam = #VK_E
				;Pressed E, so switch View from normal to expo-view
				If FindString(Buffer, "E", 1)
					Buffer = ParseFloat(*SGF\RealValue, *SGF\Decimals, *SGF\ExpoDigits)
				Else
					Buffer = ParseFloat(*SGF\RealValue, -*SGF\Decimals, *SGF\ExpoDigits)
					If FindString(Buffer, "E", 1) = 0
						Buffer + LSet("E+", *SGF\ExpoDigits + 2, "0")
					EndIf
				EndIf
				SendMessage_(hWnd, #EM_SETSEL, 0, -1)
				SendMessage_(hWnd, #EM_REPLACESEL, 0, @Buffer)
				k = FindString(Buffer, "E", 1)
				If k
					SendMessage_(hWnd, #EM_SETSEL, k + 1, k + 1)
				EndIf
				;Value didn't change, we just changed the view, so:
				m = #False

			ElseIf wParam = #VK_SUBTRACT Or wParam = $BD
				;Pressed "-"
				If k = 0 Or j < k
					If i = 0 And j = L
						Input = "-"
						SendMessage_(hWnd, #EM_REPLACESEL, 0, @Input)
					ElseIf Left(Buffer, 1) <> "-"
						Input = "-"
						SendMessage_(hWnd, #EM_SETSEL, 0, 0)
						SendMessage_(hWnd, #EM_REPLACESEL, 0, @Input)
						SendMessage_(hWnd, #EM_SETSEL, i + 1, j + 1)
					Else
						Buffer = Right(Buffer, L - 1)
						SendMessage_(hWnd, #EM_SETSEL, 0, -1)
						SendMessage_(hWnd, #EM_REPLACESEL, 0, @Buffer)
						SendMessage_(hWnd, #EM_SETSEL, i - 1, j - 1)
					EndIf
					*SGF\RealValue = -*SGF\RealValue
					m              = #False
				Else
					If Mid(Buffer, k + 1, 1) = "-"
						Buffer = Left(Buffer, k) + "+" + Mid(Buffer, k + 2)
					Else
						Buffer = Left(Buffer, k) + "-" + Mid(Buffer, k + 2)
					EndIf
					SendMessage_(hWnd, #EM_SETSEL, 0, -1)
					SendMessage_(hWnd, #EM_REPLACESEL, 0, @Buffer)
					SendMessage_(hWnd, #EM_SETSEL, i, j)
				EndIf
				
			ElseIf wParam = #VK_ADD Or wParam = 187
				;Pressed "+"
				If k = 0 Or j < k
					If Left(Buffer, 1) = "-"
						Buffer = Right(Buffer, L - 1)
						SendMessage_(hWnd, #EM_SETSEL, 0, -1)
						SendMessage_(hWnd, #EM_REPLACESEL, 0, @Buffer)
						SendMessage_(hWnd, #EM_SETSEL, i - 1, j - 1)
						*SGF\RealValue = -*SGF\RealValue
						oldProc = #False
					EndIf
					m = #False
				ElseIf Mid(Buffer, k + 1, 1) = "-"
					Buffer = Left(Buffer, k) + "+" + Mid(Buffer, k + 2)
					SendMessage_(hWnd, #EM_SETSEL, 0, -1)
					SendMessage_(hWnd, #EM_REPLACESEL, 0, @Buffer)
					SendMessage_(hWnd, #EM_SETSEL, i, j)
				EndIf

			ElseIf wParam = #VK_RIGHT Or wParam = #VK_LEFT Or wParam = #VK_DOWN Or wParam = #VK_UP
				;User moved cursor, so value didn't change
				m = #False

			EndIf
			If m
				;Value seems to have changed, so get it
				L              = SendMessage_(hWnd, #WM_GETTEXT, 256, @Buffer)
				Input          = CheckForForbiddenChars(Left(Buffer, L), *SGF\ExpoDigits)
				*SGF\RealValue = ValD(Input)
				If Input <> Left(Buffer, L)
					SendMessage_(hWnd, #EM_SETSEL, 0, -1)
					SendMessage_(hWnd, #EM_REPLACESEL, 0, @Input)
					SendMessage_(hWnd, #EM_SETSEL, i, j)
				EndIf
				If IsInfinity(*SGF\RealValue)
					*SGF\RealValue = 0
				EndIf
			EndIf

		Case #WM_PASTE
			SendMessage_(hWnd, #EM_GETSEL, @i, @j)
			L              = SendMessage_(hWnd, #WM_GETTEXT, 256, @Buffer)
			Input          = Left(Buffer, i) + GetClipboardText() + Right(Buffer, Len(Buffer) - j)
			Input          = CheckForForbiddenChars(Input, *SGF\ExpoDigits)
			*SGF\RealValue = ValD(Input)
			OldProc        = #Null
			SendMessage_(hWnd, #EM_SETSEL, 0, -1)
			SendMessage_(hWnd, #EM_REPLACESEL, 0, @Input)
			SendMessage_(hWnd, #EM_SETSEL, 0, 0)

		Case #WM_NCDESTROY
			FreeMemory(*SGF)

		Case #EM_SHOWBALLOONTIP
			OldProc = #Null
			
	EndSelect

	If OldProc
		ProcedureReturn CallWindowProc_(OldProc, hWnd, Msg, wParam, lParam)
	EndIf
	ProcedureReturn 1
EndProcedure

Procedure FloatGadget(Gadget, x, y, Width, Height, Value.d, Decimals = 2, Flags = #False, SpecialFlags = 0, ExpoDigits = 2)
	;/-----------------
	;| Parameters
	;| Gadget              = GadgetNo (or #PB_Any)
	;| x, y, Width, Height = Size and Position of Gadget
	;| Value               = Real Value
	;|                       If Value = 0, the Gadget will be empty
	;|                       If you want it to show the 0, you can do a
	;|                       SetFloatGadgetValue(Gadget, 0) right after the creation.
	;| Decimals            = Digits of shown Text
	;| Flags               = See StringGadget for optional Flags
	;| SpecialFlags        = Use a combination of
	;|                       #STRING_FLOAT_USE_SIMPLE_MODE For a very simple FloatGadget
	;|                       #STRING_FLOAT_USE_SEPERATOR is not yet finished...
	;| ExpoDigits          = Set the shown expo-digits (1,234E-<THIS>10<THIS>)
	;|                       You can alter this value later through SetFloatGadgetAttribute()
	;/-----------------

	Protected a$, i, Result, *SGF._FLOAT_GADGET_HELPER_
	
	If ExpoDigits < 1 Or ExpoDigits > 3
		ExpoDigits = 2
	EndIf
	
	internal_FG_GetValues()
	If Value <> 0.0
		If SpecialFlags & #STRING_FLOAT_USE_SIMPLE_MODE
			a$ = ParseFloat2(Value, Decimals)
		Else
			a$ = ParseFloat(Value, Decimals, ExpoDigits)
		EndIf
		Result = StringGadget(Gadget, x, y, Width, Height, a$, Flags)
	Else
		Result = StringGadget(Gadget, x, y, Width, Height, "", Flags)
	EndIf
	If Result
		If Gadget = #PB_Any
			Gadget = Result
		EndIf

		*SGF              = AllocateMemory(SizeOf(_FLOAT_GADGET_HELPER_))
		*SGF\Identify     = #STRING_FLOAT_IDENTIFY_VALUE
		*SGF\OldProcedure = SetWindowLongPtr_(GadgetID(Gadget), #GWL_WNDPROC, @FloatGadget_Callback())
		*SGF\RealValue    = Value
		*SGF\Decimals     = Decimals
		*SGF\Flags        = SpecialFlags
		*SGF\ExpoDigits   = ExpoDigits
		SetWindowLongPtr_(GadgetID(Gadget), #GWL_USERDATA, *SGF)
	EndIf

	ProcedureReturn Result
EndProcedure

Procedure SetFloatGadgetValue(GadgetID, Value.d)
	Protected *SGF._FLOAT_GADGET_HELPER_, Buffer.s

	If IsGadget(GadgetID)
		*SGF._FLOAT_GADGET_HELPER_ = GetWindowLongPtr_(GadgetID(GadgetID), #GWL_USERDATA)
	EndIf
	If *SGF
		If *SGF\Identify = #STRING_FLOAT_IDENTIFY_VALUE
			*SGF\RealValue = Value
			If *SGF\Flags & #STRING_FLOAT_USE_SIMPLE_MODE
				Buffer = ParseFloat2(Value, *SGF\Decimals)
			Else
				Buffer = ParseFloat(Value, *SGF\Decimals, *SGF\ExpoDigits)
			EndIf
			SendMessage_(GadgetID(GadgetID), #EM_SETSEL, 0, -1)
			SendMessage_(GadgetID(GadgetID), #EM_REPLACESEL, 0, @Buffer)
			SendMessage_(GadgetID(GadgetID), #EM_SETSEL, 0, 0)
		EndIf
	EndIf

EndProcedure

Procedure.d GetFloatGadgetValue(GadgetID)
	Protected Result.d, *SGF._FLOAT_GADGET_HELPER_

	If IsGadget(GadgetID)
		*SGF._FLOAT_GADGET_HELPER_ = GetWindowLongPtr_(GadgetID(GadgetID), #GWL_USERDATA)
	EndIf
	If *SGF
		If *SGF\Identify = #STRING_FLOAT_IDENTIFY_VALUE
			Result = *SGF\RealValue
		EndIf
	EndIf

	ProcedureReturn Result
EndProcedure

Procedure SetFloatGadgetAttribute(GadgetID, Attribute, ExpoDigits)
	Protected Result, i, a$, b$, c$, *SGF._FLOAT_GADGET_HELPER_

	If ExpoDigits > 0 And ExpoDigits < 4
		If IsGadget(GadgetID)
			*SGF._FLOAT_GADGET_HELPER_ = GetWindowLongPtr_(GadgetID(GadgetID), #GWL_USERDATA)
		EndIf
		If *SGF
			If *SGF\Identify = #STRING_FLOAT_IDENTIFY_VALUE
				Select Attribute
					Case #SF_ATTRIBUTE_EXPODIGITS
						Result          = *SGF\ExpoDigits
						*SGF\ExpoDigits = ExpoDigits
						a$              = GetGadgetText(GadgetID)
						i               = FindString(a$, "E", 1)
						If i
							c$ = Mid(a$, i + 2)
							b$ = a$
							If Result < ExpoDigits
								b$ = Left(a$, i + 1) + RSet(c$, ExpoDigits, "0")
							ElseIf Result > ExpoDigits
								b$ = Left(a$, i + 1) + Right(a$, ExpoDigits)
							EndIf
							If b$ <> a$
								SetGadgetText(GadgetID, b$)
							EndIf
						EndIf
				EndSelect
			EndIf
		EndIf
	EndIf

	ProcedureReturn Result
EndProcedure

Procedure GetFloatGadgetAttribute(GadgetID, Attribute)
	Protected Result, a$, *SGF._FLOAT_GADGET_HELPER_

	If IsGadget(GadgetID)
		*SGF._FLOAT_GADGET_HELPER_ = GetWindowLongPtr_(GadgetID(GadgetID), #GWL_USERDATA)
	EndIf
	If *SGF
		If *SGF\Identify = #STRING_FLOAT_IDENTIFY_VALUE
			Select Attribute
				Case #SF_ATTRIBUTE_EXPODIGITS
					Result = *SGF\ExpoDigits
			EndSelect
		EndIf
	EndIf

	ProcedureReturn Result
EndProcedure
(Da sind auch ein paar Dinge drin, die ich nie ausprogrammiert habe)

[Edit]
Noch ein simples Beispiel:

Code: Alles auswählen

;#EXPO_DIGITS = 3
XIncludeFile "FloatGadget.pbi"

Define.d d, e

OpenWindow(0, 0, 0, 300, 80, "FloatGadget Example", $C80001)
TextGadget(#PB_Any, 5, 5, 70, 22, "Eingabe:")
FloatGadget(0, 75, 5, 210, 22, 0, 7)
TextGadget(#PB_Any, 5, 30, 70, 22, "Echtwert:")
StringGadget(1, 75, 30, 210, 22, "", #PB_String_ReadOnly)
SpinGadget(2, 120, 55, 60, 20, 1, 3, #PB_Spin_Numeric)
SetGadgetState(2, 2)
d = ValD("0.000001251241231221111")
SetFloatGadgetValue(0, d)
SetGadgetText(1, ParseFloat(d, 21))

Repeat
	Select WaitWindowEvent(100)
		Case #PB_Event_CloseWindow
			Break
		Case #PB_Event_Gadget
			Select EventGadget()
				Case 2
					SetFloatGadgetAttribute(0, #SF_ATTRIBUTE_EXPODIGITS, GetGadgetState(2))
			EndSelect
		Case 0
			e = GetFloatGadgetValue(0)
			If e <> d
				SetGadgetText(1, ParseFloat(e, 21))
				d = e
			EndIf
	EndSelect
ForEver

Re: Suche Lösung für Float Input Gadget

Verfasst: 10.02.2012 13:49
von Danilo
mpz hat geschrieben:Hi,

ich möchte Eingabefelder auf einem Windows Fenster erstellen mit Gadgets. In eins der Felder soll man float Werte eingeben können z.B. 0.01 oder 1.05. Ich vermute das man ein Textgadegt ummodeln muss das es nur noch float Werte annehmen kann. Ich habe schon gesucht aber nichts sinnvolles gefundnen. Hat jemand ein Tipp für mich?
Falls Du nur Eingaben mit "[0-9].[0-9]" brauchst, kannst Du mal damit spielen und es anpassen:

Code: Alles auswählen

Procedure checkFloatInput(gadget)
    SendMessage_(GadgetID(gadget),#EM_GETSEL,@start,0)
    txt$ = GetGadgetText(gadget)
    *p.Character = @txt$
    While *p\c = '.' Or (*p\c >= '0' And *p\c <= '9')
        If *p\c = '.'
            pointcount+1
            If pointcount > 1 : *p + SizeOf(Character) : start-1 : Continue : EndIf
        EndIf
        new$ + Chr(*p\c) : *p + SizeOf(Character)
    Wend
    SetGadgetText(gadget,new$)
    SendMessage_(GadgetID(gadget),#EM_SETSEL,start,start)
EndProcedure

If OpenWindow(0, 0, 0, 322, 205, "StringGadget Flags", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    StringGadget(0, 8,  10, 306, 20, "")
    StringGadget(1, 8,  35, 306, 20, "1234567")
    Repeat
        event = WaitWindowEvent()
        If     event = #PB_Event_CloseWindow : End
        ElseIf event = #PB_Event_Gadget
            If EventType()=#PB_EventType_Change
                checkFloatInput(EventGadget())
            EndIf
        EndIf
    ForEver
EndIf

Re: Suche Lösung für Float Input Gadget

Verfasst: 10.02.2012 13:52
von mpz
Hi,

Hexor und Danilo was soll ich da sagen ausser: Perfekt, genau das was ich gesucht habe :lol:

Viele Dank

Grüße Michael

Re: [Gelöst] Suche Lösung für Float Input Gadget

Verfasst: 10.02.2012 20:40
von Danilo
Mein letzter Code schneidet eine Eingabe einfach ab, wenn man eine falsche Eingabe macht.
Zum Beispiel mit dem Cursor auf die Mitte von "1234567" gehen und dann die Taste 'a' drücken.

Ist mir erst eingefallen als ich Computer ausgeschalten hatte. :)

Immer den ganzen Text scannen sollte da besser sein:

Code: Alles auswählen

Procedure checkFloatInput(gadget)
    SendMessage_(GadgetID(gadget),#EM_GETSEL,@start,0)
    txt$ = GetGadgetText(gadget)
    *p.Character = @txt$
    While *p\c ; <> 0
        If *p\c = '.'
            pointcount+1
            If pointcount < 2
                new$ + Chr(*p\c)
            Else
                If start>count : start-1 : EndIf
            EndIf
        ElseIf *p\c >= '0' And *p\c <= '9'
            new$ + Chr(*p\c)
        Else
            start - 1
        EndIf
        *p + SizeOf(Character)
        count + 1
    Wend
    SetGadgetText(gadget,new$)
    SendMessage_(GadgetID(gadget),#EM_SETSEL,start,start)
EndProcedure

If OpenWindow(0, 0, 0, 322, 205, "StringGadget Flags", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    StringGadget(0, 8,  10, 306, 20, "")
    StringGadget(1, 8,  35, 306, 20, "1234567")
    Repeat
        event = WaitWindowEvent()
        If     event = #PB_Event_CloseWindow : End
        ElseIf event = #PB_Event_Gadget
            If EventType()=#PB_EventType_Change
                checkFloatInput(EventGadget())
            EndIf
        EndIf
    ForEver
EndIf

Re: [Gelöst] Suche Lösung für Float Input Gadget

Verfasst: 10.02.2012 21:01
von ts-soft
Habe Danilos Codebeispiel mal um Minus-Werte erweitert:

Code: Alles auswählen

EnableExplicit

Procedure checkFloatInput(gadget)
    Protected start, count, pointcount, new$
    SendMessage_(GadgetID(gadget), #EM_GETSEL, @start, 0)
    Protected txt$ = GetGadgetText(gadget)
    Protected *p.Character = @txt$
    
    While *p\c ; <> 0
        If *p\c = '.'
            pointcount+1
            If pointcount < 2
                new$ + Chr(*p\c)
            Else
                If start>count : start-1 : EndIf
            EndIf
        ElseIf count = 0 And *p\c = '-'
          new$ + Chr('-')
        ElseIf *p\c >= '0' And *p\c <= '9'
            new$ + Chr(*p\c)
        Else
            start - 1
        EndIf
        *p + SizeOf(Character)
        count + 1
    Wend
    SetGadgetText(gadget, new$)
    SendMessage_(GadgetID(gadget), #EM_SETSEL, start, start)
EndProcedure

Define event
If OpenWindow(0, 0, 0, 322, 205, "StringGadget Flags", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    StringGadget(0, 8,  10, 306, 20, "")
    StringGadget(1, 8,  35, 306, 20, "1234567")
    Repeat
        event = WaitWindowEvent()
        If     event = #PB_Event_CloseWindow : End
        ElseIf event = #PB_Event_Gadget
            If EventType() = #PB_EventType_Change
                checkFloatInput(EventGadget())
            EndIf
        EndIf
    ForEver
EndIf
Hoffe es funktioniert jetzt noch :)

Re: [Gelöst] Suche Lösung für Float Input Gadget

Verfasst: 10.02.2012 21:15
von Danilo
ts-soft hat geschrieben:Habe Danilos Codebeispiel mal um Minus-Werte erweitert:
Danke! :allright:
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de