Hallo zusammen,
Es handelt sich hier um einen MwSt.-Rechner welcher Live reagiert, wenn im Netto oder Brutto-Feld eine Zahl eingegeben wird.
Beim ersten Programmstart läuft das Programm mit dem Schweizer-MwSt-Satz von 7.7%. Sobald Ihr einen anderen Prozentsatz eingibt und das Programm beendet wird eine INI-Datei (mwst.ini) abgelegt und beim nächsten Start eingelesen.
Code
Declare ende%, bruttoCheck$, mwstCheck$, nettoCheck$, mwstProCheck$
Declare nettoTxt&, nettoInp&, mwstTxt&, mwstInp&, bruttoTxt&, bruttoInp&, c&, m&, n&, cadtecPngDrawn&, mwstProTxt&, mwstProInp&, mwstProTxt2&
Declare float!, floatInString$
Declare mwst$
Declare newnetto!, newmwst!, newbrutto!, newbrutto$, newnetto$, newmwst$, mwstProTxt$
Declare feld&, clipString$
Proc WindowInit
Parameters mwstIni$
WindowStyle 26
WindowTitle "MwStCalc (www.cadtec.ch)"
Set("Decimals", 2)
Window 320, 170
Cls Rgb (240,240,240)
nettoTxt& = Create("Text", %hwnd, "Netto:", 5, 5, 80, 20)
nettoInp& = Create("Edit", %hwnd, "0.00", 95, 5, 100, 20)
mwstTxt& = Create("Text", %hwnd, "MwSt. (CHF):", 5, 30, 100, 20)
mwstInp& = Create("Edit", %hwnd, "0.00", 95, 30, 100, 20)
bruttoTxt& = Create("Text", %hwnd, "Brutto:", 5, 55, 80, 20)
bruttoInp& = Create("Edit", %hwnd, "0.00", 95, 55, 100, 20)
n& = Create("Button", %hwnd, "Kopieren", 200, 5, 80, 20)
m& = Create("Button", %hwnd, "Kopieren", 200, 30, 80, 20)
c& = Create("Button", %hwnd, "Kopieren", 200, 55, 80, 20)
mwstProTxt& = Create("Text", %hwnd, "MwSt. (%):", 5, 80, 80, 20)
mwstProInp& = Create("Edit", %hwnd, mwstIni$, 95, 80, 35, 20)
mwstProTxt2& = Create("Text", %hwnd, "Änderung an MwSt. löscht Berechnungen!", 5, 110, 300, 40)
EndProc
Proc convertNumbers
Parameters stringToTest$
float! = Val(stringToTest$)
Return float!
EndProc
Proc Speichern
mwst$ = GetText$(mwstProInp&)
Assign #1, "mwst.ini"
ReWrite #1
Print #1, mwst$
Close #1
EndProc
Proc mwstCalc
Declare thisnetto!, thisbrutto!, thisnetto$, thisbrutto$
thisnetto$ = GetText$(nettoInp&)
thisbrutto$ = GetText$(bruttoInp&)
thisnetto! = convertNumbers(thisnetto$)
thisbrutto! = convertNumbers(thisbrutto$)
newmwst! = (thisbrutto! - thisnetto!)
Return Str$(newmwst!)
EndProc
Proc RECHNEN
Declare nettoTxt$, mwstTxt$, bruttoTxt$, nettoPro!, bruttoPro!, mwstPro!, mwstRate!
nettoTxt$ = GetText$(nettoInp&)
mwstTxt$ = GetText$(mwstInp&)
bruttoTxt$ = GetText$(bruttoInp&)
mwstProTxt$ = GetText$(mwstProInp&)
If mwstProCheck$ <> mwstProTxt$
Löschen
Speichern
EndIf
If bruttoTxt$ <> bruttoCheck$
newmwst! = convertNumbers (mwstProTxt$)
newbrutto! = convertNumbers (bruttoTxt$)
bruttoPro! = (newbrutto! / (100 + newmwst!))
newnetto! = (bruttoPro! * 100)
newnetto$ = Str$(newnetto!)
SetText nettoInp&, newnetto$
SetText mwstInp&, MwstCalc()
ElseIf nettoTxt$ <> nettoCheck$
newnetto! = convertNumbers (nettoTxt$)
newmwst! = convertNumbers (mwstProTxt$)
nettoPro! = (newnetto! / 100)
newbrutto! = (nettoPro! * (100 + newmwst!))
newbrutto$ = Str$(newbrutto!)
SetText bruttoInp&, newbrutto$
SetText mwstInp&, MwstCalc()
ElseIf mwstTxt$ <> mwstCheck$
mwstPro! = convertNumbers(mwstProTxt$)
newmwst! = convertNumbers(mwstTxt$)
mwstRate! = (newmwst! / mwstPro!)
newnetto! = (mwstRate! * 100)
newbrutto! = (mwstRate! * (100 + mwstPro!))
newnetto$ = Str$(newnetto!)
newbrutto$ = Str$(newbrutto!)
SetText bruttoInp&, newbrutto$
SetText nettoInp&, newnetto$
Else
Return
EndIf
EndProc
Proc kopieren
Parameters feld$
If feld$ = "netto"
feld& = nettoInp&
ElseIf feld$ = "mwst"
feld& = mwstInp&
ElseIf feld$ = "brutto"
feld& = bruttoInp&
EndIf
clipString$ = GetText$(feld&)
ClearClip
PutClip clipString$
EndProc
Proc Löschen
SetText nettoInp&, "0.00"
SetText mwstInp&, "0.00"
SetText bruttoInp&, "0.00"
EndProc
If FileExists("mwst.ini")
Assign #1, "mwst.ini"
Reset #1
Input #1, mwst$
Close #1
Else
mwst$ = "7.7"
EndIf
WindowInit mwst$
Clear ende%
WhileNot ende%
bruttoCheck$ = GetText$(bruttoInp&)
mwstCheck$ = GetText$(mwstInp&)
nettoCheck$ = GetText$(nettoInp&)
mwstProCheck$ = GetText$(mwstProInp&)
WaitInput
If (%key = 2)
ende% = 1
EndIf
If Clicked(n&)
kopieren "netto"
ElseIf Clicked(m&)
kopieren "mwst"
ElseIf Clicked(c&)
kopieren "brutto"
Else
RECHNEN
EndIf
EndWhile
End
Alles anzeigen
Einer unserer Lehrlinge hat das innerhalb ca. eines Tages gemacht, als er noch in der Schnupperlehre war und nur etwas HTML-Vorkenntnisse hatte XProfan ist einfach super!
PS: (Brauche das Miniteil heute noch regelmässig.)
Beste Grüsse,
André