IsNumeric

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
Daffy0815
Beiträge: 390
Registriert: 15.06.2005 00:44
Wohnort: 65719 Hofheim
Kontaktdaten:

IsNumeric

Beitrag von Daffy0815 »

Hallo Leute,

hier eine verbesserte Form der IsNumeric aus der Code-Bibliothek.
Sie verarbeitet nicht nur 0..9 sondern auch Gleitpunktzahlen mit Vorzeichen.
Sie verarbeitet NICHT Gleitpunktzahlen in Exponentialdarstellung (z.B. 1E3)

Code: Alles auswählen

Procedure.i IsNumeric(String$) 
  If String$ 
    RemoveString(String$, " ")
    *p.BYTE = @String$ 
    Repeat 
      char = *p\b & $FF 
        Select char
            Case '0' To '9'
                *p+1 
            Case '-'
                *p+1 
            Case '.'
                *p+1 
            Case 0
                *p+1 
            Default
                ProcedureReturn #False 
        EndSelect
    Until char = 0 
    If CountString(String$, ".") > 1 Or CountString(String$, "-") > 1
        ProcedureReturn #False 
    EndIf
    ProcedureReturn #True 
  EndIf 
EndProcedure 

Vor Aufruf der Routine empfiehlt sich die folgende Zeile:

Code: Alles auswählen

Wert$ = RemoveString(GetGadgetText(NumGadget.i), " ") 
Damit ist auch die Eingabe "1 2 3" zulässig und kann mit SetGaget als "123" zurückgeschrieben werden.

Anmerkung:

Nach einiger Zeit der Beschäftigung mit PureBasic / Programmieren für graphische Benutzeroberfläche finde ich es ERSCHRECKEND das die primitivsten Eingaberoutinen welche in früherer Zeit bei der Programmierung gleichartiger Dinge mit SAA-Oberfläche zum elementaren Bestandteil der Basic-Idiome gehörten nicht vorhanden sind.

Statt sich auf die Programmierung der Anwendung zu konzentrieren schlägt man stundenlang die Zeit tot um irgendwelche Primitives zu schreiben oder mit riesigem Aufwand den Befindlichkeiten des Compilers / Betriebssystems Rechnung zu tragen.

Gruß

Daffy
Wir sind LINUX
Widerstand ist zwecklos - Sie werden emuliert
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 7028
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: IsNumeric

Beitrag von STARGÅTE »

Und noch ein IsNumeric() :lol:

IsNumeric()
IsNumber
IsNumber() Function #5326262 :)

Naja, jeder möchte halt seine "eigene" Version vorstellen ...

Im übrigen funktioniert deine nur unter Ascii, und auch nur ohne EnableExplicit.

Benutze also bitte in diesem Forum "Code, Tipps und Tricks" Protected. Und Schreib dazu das es nur unter Ascii funktioniert.
Ansonsten müsstest du *p.CHARACTER machen und *p+1 zu *p+SizeOf(Character)

dann sparst du auch das char = *p\b & $FF ...

Desweiteren kann man auch das Minus irgendwo setzen ... müsste also alles im allem noch etwas verbessert werden.
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Benutzeravatar
RSBasic
Admin
Beiträge: 8047
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: IsNumeric

Beitrag von RSBasic »

Daffy0815 hat geschrieben:Nach einiger Zeit der Beschäftigung mit PureBasic / Programmieren für graphische Benutzeroberfläche finde ich es ERSCHRECKEND das die primitivsten Eingaberoutinen welche in früherer Zeit bei der Programmierung gleichartiger Dinge mit SAA-Oberfläche zum elementaren Bestandteil der Basic-Idiome gehörten nicht vorhanden sind.

Statt sich auf die Programmierung der Anwendung zu konzentrieren schlägt man stundenlang die Zeit tot um irgendwelche Primitives zu schreiben oder mit riesigem Aufwand den Befindlichkeiten des Compilers / Betriebssystems Rechnung zu tragen.
Kann ich nicht nachvollziehen. Ich habe überhaupt keine Probleme damit und kann alles machen was ich möchte. Und ein riesiger Aufwand ist es auch nicht (meine Meinung).
Wenn du über die 3D-Implementierung gemeckert hättest, hätte ich das verstanden, aber über die Programmierung einer Anwendung? :roll:
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 7028
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: IsNumeric

Beitrag von STARGÅTE »

Ich glaube er spielt gerade auf Funktionen wie IsNumeric() an.
Edit: wurde durch die nachfolgende Antwort bestätigt ^^

Vermutlich auch auf: Max(), Min(), usw. also "MiniFunktionen" die man auch als Standard ansehen könnte, PB aber nicht hat.

PB hat sie aber aus einem guten Grund nicht: So kann jeder individuell sein eigenes IsNUmeric schreiben (wie es ja bei vielen der Fall ist) oder sein eigenes Min(), entweder mit Array, List oder Variablen usw. ...
Zuletzt geändert von STARGÅTE am 16.03.2011 22:27, insgesamt 1-mal geändert.
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Benutzeravatar
Daffy0815
Beiträge: 390
Registriert: 15.06.2005 00:44
Wohnort: 65719 Hofheim
Kontaktdaten:

Re: IsNumeric

Beitrag von Daffy0815 »

@Stargate
Naja, jeder möchte halt seine "eigene" Version vorstellen ...
Falsch, eigentlich möchte ich das gar nicht!
Eigentlich würde ich so einen Primitivkram lieber als Bestandteil der Programmiersprache sehen.
Im übrigen funktioniert deine nur unter Ascii, und auch nur ohne EnableExplicit.

Benutze also bitte in diesem Forum "Code, Tipps und Tricks" Protected. Und Schreib dazu das es nur unter Ascii funktioniert.
Ansonsten müsstest du *p.CHARACTER machen und *p+1 zu *p+SizeOf(Character)

dann sparst du auch das char = *p\b & $FF ...
Wie bereits erwähnt handelt es sich um eine "verbesserte Form der IsNumeric aus der Code-Bibliothek"

Gruß

Daffy
Wir sind LINUX
Widerstand ist zwecklos - Sie werden emuliert
Benutzeravatar
Daffy0815
Beiträge: 390
Registriert: 15.06.2005 00:44
Wohnort: 65719 Hofheim
Kontaktdaten:

Re: IsNumeric

Beitrag von Daffy0815 »

@RSBASIC

Schade, dass ich weder Zeit noch Platz habe um hier mal eine funktionierende Eingabemaske für die über 300 Konfigurationsparameter eines Messgerätes mit Touchscreenbedienung und Eingabesensitiver Tastatureinblendung, automatischer Korrektur von nicht plausiblen bzw. fehlerhaften Eingaben sowie automatischer Fokussierung in einem (Sc)Rollbereich einzustellen.

Dann wüsstest Du was ich meine!

Selbiges habe ich mittels ANSI-Terminal-Codes mit meinen DS80C320 Microcontroller-Basic mit einem ZEHNTEL der Programmzeilen realisiert.

Gruß

Daffy
Wir sind LINUX
Widerstand ist zwecklos - Sie werden emuliert
Benutzeravatar
RSBasic
Admin
Beiträge: 8047
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: IsNumeric

Beitrag von RSBasic »

[OT]
@Daffy0815
Btw: Mir ist schon letztes Mal aufgefallen und zwar: Es gibt einen Bild-Button, wenn du was nachträgliches hinzufügen möchtest. Danke.
[/OT]
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
Daffy0815
Beiträge: 390
Registriert: 15.06.2005 00:44
Wohnort: 65719 Hofheim
Kontaktdaten:

Re: IsNumeric

Beitrag von Daffy0815 »

Hier mal ein kleine Auswahl die ich als absolut notwendige Dinge betrachte:
(Nicht weiter kommentiert, aber ich denke doch, dass man was damit anfangen kann und so das Rad nicht jedes mal neu erfinden muss)

Code: Alles auswählen

Procedure.s FormatWert(Wert.d, MinWert.d, MaxWert.d, InitWert.d, Format.d) 
    ;
    If Wert.d = #Undefiniert
        Wert.d = InitWert.d
    EndIf
    If Wert.d < MinWert.d
        Wert.d = MinWert.d
    EndIf
    If Wert.d > MaxWert.d
        Wert.d = MaxWert.d
    EndIf
    ;
    AnzahlVorkommastellen.d = Int(Format.d / 10)
    AnzahlNachkommastellen.d = Format.d - (AnzahlVorkommastellen.d * 10)
    ;
    Temp$ = StrD(Wert.d, AnzahlNachkommastellen.d)
    ;
    If AnzahlNachkommastellen.d > 0
        AnzahlVorkommastellen.d = AnzahlVorkommastellen.d + 1
    EndIf
    Temp$ = RSet(Temp$, AnzahlVorkommastellen.d + AnzahlNachkommastellen.d)
    ;
    ProcedureReturn Temp$
    ;
EndProcedure

Code: Alles auswählen

Procedure.i SetTextGadget(NumGadget.i, XPos.i, YPos.i, FontID.i, Text$)
    ;
    Width.i = TextRealWidth(FontID.i, Text$)
    TextGadget(NumGadget.i, XPos.i, YPos.i, Width.i, TextRealHeight(FontID.i, Text$), Text$) 
    SetGadgetFont(NumGadget.i, FontID.i)
    SetGadgetNormalfarben(NumGadget.i)
    ;
    ProcedureReturn Width.i
    ;
EndProcedure

Code: Alles auswählen

Procedure SetGadgetNormalfarben(NumGadget.i)
    SetGadgetColor(NumGadget.i, #PB_Gadget_BackColor, RGBFarbcodes(Hintergrundfarbe.i))
    SetGadgetColor(NumGadget.i, #PB_Gadget_FrontColor, RGBFarbcodes(Vordergrundfarbe.i))
EndProcedure

Code: Alles auswählen

Procedure EdierenEinAus(NumGadget.i, Edit.d, Status.i)
    If Status.i = #Entriegelt
        If Edit.d = #Ja
            DisableGadget(NumGadget.i, 0)
            PureCOLOR_SetGadgetColor(NumGadget.i, RGBFarbcodes(Eingabefeldvordergrundfarbe.i), RGBFarbcodes(Eingabefeldhintergrundfarbe.i))
        EndIf
    Else
        DisableGadget(NumGadget.i, 1)
        PureCOLOR_SetGadgetColor(NumGadget.i, SysColorGrayText.i, RGBFarbcodes(Hintergrundfarbe.i))
    EndIf
EndProcedure

Code: Alles auswählen

Procedure ButtonEdierenEinAus(NumGadget.i, Edit.d, Status.i)
    If Status.i = #Entriegelt
        If Edit.d = #Ja
            DisableGadget(NumGadget.i, 0)
            PureCOLOR_SetGadgetColor(NumGadget.i, #PureCOLOR_UseLastColor, RGBFarbcodes(Hintergrundfarbe.i))
        EndIf
    Else
        DisableGadget(NumGadget.i, 1)
        PureCOLOR_SetGadgetColor(NumGadget.i, #PureCOLOR_SystemColor, #PureCOLOR_DontSetBackColor)
    EndIf
EndProcedure

Code: Alles auswählen

Procedure.i SetRealTextGadget(NumGadget.i, XPos.i, YPos.i, BreiteMin.i, Hoehe.i, FontID.i, Text$, Flags.i)
    ;
    Breite.i = TextRealWidth(FontID.i, Text$)
    If Breite.i < BreiteMin.i
        Breite.i = BreiteMin.i
    EndIf
    ;
    If Flags.i = 0 
        TextGadget(NumGadget.i, XPos.i, YPos.i, Breite.i, Hoehe.i, Text$) 
    Else
        TextGadget(NumGadget.i, XPos.i, YPos.i, Breite.i, Hoehe.i, Text$, Flags.i)
    EndIf     
    SetGadgetFont(NumGadget.i, FontID.i)
    SetGadgetNormalfarben(NumGadget.i)
    ;
    ProcedureReturn Breite.i
    ;
EndProcedure

Code: Alles auswählen

Procedure SetButtonImageGadget(NumGadget.i, XPos.i, YPos.i, ImageNumState0.i, ImageNumState1.i, Status.i)
    ;
    If Status.i = 1
        ID.i = ImageNumState1.i
    Else
        ID.i = ImageNumState0.i
    EndIf
    ;
    ButtonImageGadget(NumGadget.i, XPos.i, YPos.i, ImageWidth(ID.i), ImageHeight(ID.i), ImageID(ID.i), 0)
    s.l=GetWindowLong_(GadgetID(NumGadget.i), #GWL_STYLE)
    SetWindowLong_(GadgetID(NumGadget.i), #GWL_STYLE, #BS_FLAT | #BS_OWNERDRAW | s) 
    ;
EndProcedure

Code: Alles auswählen

Procedure.i GetButtonImageGadgetState(NumGadget.i, ImageNumState0.i, ImageNumState1.i)
    ;
    If GetGadgetAttribute(NumGadget.i, #PB_Button_Image) = ImageID(ImageNumState1.i)
        ProcedureReturn 1
    Else
        ProcedureReturn 0
    EndIf
    ;
EndProcedure

Code: Alles auswählen

Procedure ToggleButtonImageGadget(NumGadget.i, ImageNumState0.i, ImageNumState1.i)
    ;
    Status.i = GetGadgetAttribute(NumGadget.i, #PB_Button_Image)
    If Status.i = ImageID(ImageNumState0.i)
        SetGadgetAttribute(NumGadget.i, #PB_Button_Image, ImageID(ImageNumState1.i))       
    Else
        SetGadgetAttribute(NumGadget.i, #PB_Button_Image, ImageID(ImageNumState0.i))       
    EndIf
    PureCOLOR_SetGadgetColor(NumGadget.i, #PureCOLOR_UseLastColor, RGBFarbcodes(Hintergrundfarbe.i))
    ;
EndProcedure

Code: Alles auswählen

PROCEDURE.i TextRealWidth(FontID, Text$)
   PROTECTED dc = GetDC_(0)
   PROTECTED sz.Size
   
   SelectObject_(dc, FontID)
   GetTextExtentPoint32_(dc, Text$, Len(Text$), sz)
   ReleaseDC_(0, dc)
   
   PROCEDURERETURN sz\cx 
ENDPROCEDURE

Code: Alles auswählen

PROCEDURE.i TextRealHeight(FontID, Text$)
   PROTECTED dc = GetDC_(0)
   PROTECTED sz.Size
   
   SelectObject_(dc, FontID)
   GetTextExtentPoint32_(dc, Text$, Len(Text$), sz)
   ReleaseDC_(0, dc)
   
   PROCEDURERETURN sz\cy 
ENDPROCEDURE

Code: Alles auswählen

Procedure.i SetNumerischesEingabefeld(NumGadget.i, XPos.i, YPos.i, WertMin.d, WertMax.d, WertVorgabe.d, WertFormat.d, Wert.d, FontID.i)
    ;
    If Wert.d = #Undefiniert
        Edit$ = ""
        AnzahlVorkommastellen.d = Int(WertFormat.d / 10)
        AnzahlNachkommastellen.d = WertFormat.d - (AnzahlVorkommastellen.d * 10)
        If AnzahlVorkommastellen.d > 0
            For X.i = 1 To AnzahlVorkommastellen.d
                Edit$ = Edit$ + "#"
            Next
        EndIf
        If AnzahlNachkommastellen.d > 0
            Edit$ = Edit$ + "."
            For X.i = 1 To AnzahlNachkommastellen.d
                Edit$ = Edit$ + "#"
            Next
        EndIf
    Else
        Edit$ = FormatWert(Wert.d, WertMin.d, WertMax.d, WertVorgabe.d, WertFormat.d) 
    EndIf
    ;
    BreiteEingabefeld.i = TextRealWidth(FontID.i, Edit$ + "X")
    HoeheEingabefeld.i = TextRealHeight(FontID.i, Edit$)
    StringGadget(NumGadget.i, XPos.i, YPos.i, BreiteEingabefeld.i, HoeheEingabefeld.i, Edit$)
    SendMessage_(GadgetID(NumGadget.i), #EM_LIMITTEXT, 0, 0)
    SetGadgetEingabefeldfarben(NumGadget.i)
    SetGadgetFont(NumGadget.i, FontID.i)
    ;
    ProcedureReturn BreiteEingabefeld.i
    ;
EndProcedure

Code: Alles auswählen

Procedure.s GetAndFormatNumStringGadget(NumGadget.i, Min.d, Max.d, Vorgabe.d, Format.d)
    ;
    Wert$ = RemoveString(GetGadgetText(NumGadget.i), " ") 
    If IsNumeric(Wert$) 
        Wert.d = ValD(Wert$)
    Else
        Wert.d = #Undefiniert
    EndIf
    Wert$ = FormatWert(Wert.d, Min.d, Max.d, Vorgabe.d, Format.d) 
    SetGadgetText(NumGadget.i, Wert$)
    ;
    ProcedureReturn Wert$    
    ;
EndProcedure

Code: Alles auswählen

Procedure KeyNumParGadget(NumGadget.i, ShortcutID.i, Min.d, Max.d, Vorgabe.d, Format.d)
    ;
    If EventMenu() = ShortcutID.i
        SendMessage_(GadgetID(NumGadget.i), #EM_SETSEL, $fffffff, 0)
        Wert$ = GetAndFormatNumStringGadget(NumGadget.i, Min.d, Max.d, Vorgabe.d, Format.d)
        SetGadgetText(NumGadget.i, Wert$)
        SendMessage_(GadgetID(NumGadget.i), #EM_SETSEL, $fffffff, 0)
        keybd_event_(#VK_SHIFT, 0, #KEYEVENTF_KEYUP, 0)
        Keybd_Event_(#VK_TAB, 0, 0, 0)
    EndIf
    ;
EndProcedure

Code: Alles auswählen

Procedure EditNumParGadget(NumGadget.i, Min.d, Max.d, Vorgabe.d, Format.d)
    ;
    SendMessage_(GadgetID(NumGadget.i), #EM_SETSEL, $fffffff, 0)
    If EventType() = #PB_EventType_Change    
        SendMessage_(GadgetID(NumGadget.i), #EM_SETSEL, $fffffff, $fffffff)
    EndIf
    If EventType() = #PB_EventType_LostFocus   
        Wert.d = ValD(GetAndFormatNumStringGadget(NumGadget.i, Min.d, Max.d, Vorgabe.d, Format.d))
    EndIf
    ;
EndProcedure

Code: Alles auswählen

Procedure ScrollEditNumParGadget(NumScrollArea.i, NumGadget.i, Min.d, Max.d, Vorgabe.d, Format.d)
    ;
    SendMessage_(GadgetID(NumGadget.i), #EM_SETSEL, $fffffff, 0)
    ;
    If EventType() = #PB_EventType_Focus    
       SetGadgetAttribute(NumScrollArea.i, #PB_ScrollArea_Y, GadgetY(NumGadget.i) - GetGadgetData(NumScrollArea.i))
    EndIf
    ;
    If EventType() = #PB_EventType_Change    
        SendMessage_(GadgetID(NumGadget.i), #EM_SETSEL, $fffffff, $fffffff)
    EndIf
    ;
    If EventType() = #PB_EventType_LostFocus   
        Wert.d = ValD(GetAndFormatNumStringGadget(NumGadget.i, Min.d, Max.d, Vorgabe.d, Format.d))
    EndIf
    ;
EndProcedure

Code: Alles auswählen

Procedure ScrollEditSelektorGadget(NumScrollArea.i, NumGadget.i)
    ;
    If EventType() = #PB_EventType_RightDoubleClick     ;3 ;#PB_EventType_LostFocus   
       SetGadgetAttribute(NumScrollArea.i, #PB_ScrollArea_Y, GadgetY(NumGadget.i) - GetGadgetData(NumScrollArea.i))
    EndIf
    ;
EndProcedure

Code: Alles auswählen

Procedure ScrollKeyButtonImageGadget(NumScrollArea.i, NumGadget.i)
    ;
    SetGadgetAttribute(NumScrollArea.i, #PB_ScrollArea_Y, GadgetY(NumGadget.i) - GetGadgetData(NumScrollArea.i))
    Keybd_Event_(#VK_TAB, 0, 0, 0)
    ;
EndProcedure

Code: Alles auswählen

Procedure.i ScrollNoEventKeyButtonImageGadget(NumScrollArea.i, NumGadget.i)
    ;
    SetGadgetAttribute(NumScrollArea.i, #PB_ScrollArea_Y, GadgetY(NumGadget.i) - GetGadgetData(NumScrollArea.i))
    ProcedureReturn NumGadget.i
    ;
EndProcedure

Code: Alles auswählen

Procedure.i SetComboboxSelektor(NumGadget.i, Array Selektoren.s(1), XPos.i, YPos.i, SelektorMin.d, SelektorMax.d, SelektorVorgabe.d, SelektorEingabe.d, Vordergrundfarbe.i, Hintergrundfarbe.i, FontID.i)
    ;
    MaxBreite.i = 0
    For Selektorzaehler.i = SelektorMin.d To SelektorMax.d
        Breite.i = TextRealWidth(FontID.i, Selektoren.s(Selektorzaehler.i) + "Xi")
        If Breite.i > MaxBreite.i 
            MaxBreite.i = Breite.i
        EndIf
    Next
    ;
    ComboBoxGadget(NumGadget.i, XPos.i, YPos.i, MaxBreite.i, TextRealHeight(FontID.i, Selektoren.s(Int(SelektorMin.d))), #CBS_NOINTEGRALHEIGHT) 
    SetGadgetFont(NumGadget.i, FontID.i)
    PureCOLOR_SetGadgetColor(NumGadget.i, RGBFarbcodes(Vordergrundfarbe.i), RGBFarbcodes(Hintergrundfarbe.i))
    ;
    For Selektorzaehler.i = SelektorMin.d To SelektorMax.d
        AddGadgetItem(NumGadget.i, -1, Selektoren.s(Selektorzaehler.i))
    Next
    ;
    If ((SelektorEingabe.d < SelektorMin.d) OR (SelektorEingabe.d > SelektorMax.d))
        Selektorstatus.i = SelektorVorgabe.d - 1
    Else
        Selektorstatus.i = SelektorEingabe.d - 1
    EndIf
    SetGadgetState(NumGadget.i, Selektorstatus.i)
    ;
    ProcedureReturn MaxBreite.i
    ;
EndProcedure
Gruß

Daffy
Wir sind LINUX
Widerstand ist zwecklos - Sie werden emuliert
Benutzeravatar
Daffy0815
Beiträge: 390
Registriert: 15.06.2005 00:44
Wohnort: 65719 Hofheim
Kontaktdaten:

Re: IsNumeric

Beitrag von Daffy0815 »

@RSBASIC

Einen Knopf mit der Bezeichnung "ändern" finde ich hier nicht!
Wo soll der sein?

Gruß

Daffy
Wir sind LINUX
Widerstand ist zwecklos - Sie werden emuliert
Benutzeravatar
RSBasic
Admin
Beiträge: 8047
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: IsNumeric

Beitrag von RSBasic »

Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Antworten