English
Source / code snippets

Beschr

 

Findus
One Input where one only numbers and comma prompt can
CompileMarkSeparation
'##########################
'Benötigte Header-Dateien einbinden
'##########################
 $H Windows.ph
 $H Messages.ph
'##########################
'Fenster anlegen
'##########################
WindowStyle 536'DialogStil setzen
WindowTitle "Berechne"
WINDOW 365,250
CLS ~GetSysColor(~COLOR_BTNFACE)
Set("Decimals",4)
setdialogfont ~GetStockObject(~DEFAULT_GUI_FONT)
'##########################
'das Fenster aufbauen
'##########################
Create("Text",%hWnd,"Eingabe X1:",10, 8,120,20)
Create("Text",%hWnd,"Eingabe X2 muss ungleich 0 sein:",10,33,300,20)
Create("Text",%hWnd,"Eingabe Y1:",10,58,120,20)
Create("Text",%hWnd,"Eingabe Y2:",10,83,120,20)
Create("Text",%hWnd,"Eingangssignal:",10,108,120,20)
Create("Text",%hWnd,"Die Steigung beträgt:",10,168,200,20)
Create("Text",%hWnd,"Das Ausgangssignal beträgt:",10,193,200,20)
Var  X1% = Create("Edit",%hWnd,"",250, 5,85,24)
Var  X2% = Create("Edit",%hWnd,"",250,30,85,24)
Var  Y1% = Create("Edit",%hWnd,"",250,55,85,24)
Var  Y2% = Create("Edit",%hWnd,"",250,80,85,24)
Var  ES% = Create("Edit",%hWnd,"",250,105,85,24)
Var  hB% = Create("Button",%hWnd,"&Berechnen",10,133,80,25)
Var  hA% = Create("Button",%hWnd,"&Schließen",250,133,80,25)
Var T1% = Create("Text",%hWnd,"",248,193,85,20)
Var T2% = Create("Text",%hWnd,"",248,168,85,20)
'##########################
'Subclassing für die Edits einschalten
'##########################
SubClass X1%, 1
SubClass X2%, 1
SubClass Y1%, 1
SubClass Y2%, 1
SubClass ES%, 1
SetFocus(X1%)
'##########################
'Hauptschleife
'##########################

While 1

    WaitInput
    Case %key = 2 : BREAK'Fenster soll geschlossen werden(ESC,ALT+F4,Schliessen-Kreuz,Systemmenu-Schliessen)

    If Clicked(hb%)

        If CheckValues()

            Berechnen()

        EndIf

    ElseIf Clicked(ha%)

        Break

    EndIf

EndWhile

End
'##########################
'die benötigten Prozeduren
'##########################

Subclassproc

    '##########################
    'hier wird die Eingabe in die Edits überwacht
    'nur Zahlen,Minus,Komma und Backspace werden erlaubt
    '##########################

    If (&swnd = X2%) or (&swnd = Y1%) or (&swnd = X1%) or (&swnd = Y2%) or (&swnd = ES%)

        If SubClassMessage(&swnd,~wm_char)

            Set("WinProc", 1)'weiterleiten

            If (&swParam > 47) and (&swParam < 58)'alle Zahlen bearbeiten

            ElseIf &swParam = 45'Minus

            ElseIf &swParam = 44'Komma

            ElseIf &swParam = ~VK_BACK'Backspace

            Else

                Set("WinProc", 0)'sonst nicht weiterleiten

            EndIf

            '#################
            'Rechte Maustast abfangen
            '#################

        Elseif SubClassMessage(&swnd,~WM_CONTEXTMENU)

            SendMessage(&swnd,~WM_LBUTTONDOWN,0,0)
            SendMessage(&swnd,~WM_LBUTTONUP,0,0)
            Set("WinProc", 0)'sonst nicht weiterleiten

        EndIf

    EndIf

EndProc

Proc Berechnen

    Var X1! = val(translate$(GetText$(X1%),",","."))
    Var X2! = val(translate$(GetText$(X2%),",","."))
    Var Y1! = val(translate$(GetText$(Y1%),",","."))
    Var Y2! = val(translate$(GetText$(Y2%),",","."))
    Var ES! = val(translate$(GetText$(ES%),",","."))
    Var ST! = ((Y2!-Y1!)/(X2!-X1!))
    Var AS!=(ES!*ST!)+Y1!
    Var ST$ = str$(@round(ST!,4))
    Var AS$ = str$(@round(AS!,4))
    Settext T1%,AS$+" %"
    Settext T2%,ST$

EndProc

Proc CheckValues

    '##########################
    'hier werden die zwei Edits überprüft die keine NULL erlauben
    '##########################

    If Val(Gettext$(X2%)) = 0

        Messagebox("unkorrekte Eingabe - bitte prüfen","Feld1",0)
        SetFocus(X2%)
        Return 0

    ElseIf Val(Gettext$(Y1%)) = 0

        Messagebox("unkorrekte Eingabe - bitte prüfen","Feld2",0)
        SetFocus(Y1%)
        Return 0

    EndIf

    Return 1

ENDPROC


the has Andreas Miethe prepares.
 
12/29/12  
 



Regards and cordial Glückwunsch To Your first Snippet!

have whom Topictitle something adjusted, here with whom Quelltexten in the cover only
whom View source concerned Schlagworte, for but quiet a couple More.
 
12/29/12  
 




Findus
iF (29.12.12)

Regards and cordial Glückwunsch To Your first Snippet!

have whom Topictitle something adjusted, here with whom Quelltexten in the cover only
whom View source concerned Schlagworte, for but quiet a couple More.


OK the observe I me.
 
12/29/12  
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

6.955 Views

Untitledvor 0 min.
Erhard Wirth06/14/24
p.specht11/20/21
Uwe Lang11/20/21
Manfred Barei11/19/21
More...

Themeninformationen

this Topic has 2 subscriber:

Findus (2x)
iF (1x)


Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.


all rightDatenschutzerklärung
i want none Cookie