Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!Umstieg von Power Basic zu Free Basic
| Projektzusammenfassung | ||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| ||||||||||||||
------------------------
------------------------
------------------------
------------------------
Startprogramm
' BK_2010 - GRAPHIC Version 24.12.2010
' #RESOURCE "BK_2020.PBR" ' - RC-Resource-Datei in Vorbereitung
#COMPILE EXE
#DIM ALL
' #CONSOLE OFF
' #RESOURCE WAVE, 1, "telephone.wav" ' funzt nich
GLOBAL n,f,crack AS STRING
GLOBAL NV,PV,LV,RV,BV,HH AS LONG
GLOBAL PixW,PixH,x1,y1,x2,y2,hwin,bkgr,CarW,CarH,MaxCol,MaxRow AS LONG
GLOBAL fn,cp,fnt,z,n,fr0,fr4,fr5 AS STRING
GLOBAL pt,o,a,ca,cr,pkt,art AS INTEGER
FUNCTION PBMAIN () AS LONG
NV = &HF0D631 ' Bernstein / Amber
PV = &H00CC00 ' Grün / Green
LV = &HC480FC ' Lila / Purple
RV = &HFF0000 ' Rot / Red
BV = &H0000FF ' Blau / Blue
HH = &H000000 ' Schwarz / Black
OPEN "COLOR.DAT" FOR INPUT AS #3
INPUT #3,NV
INPUT #3,PV
INPUT #3,LV
INPUT #3,RV
INPUT #3,BV
INPUT #3,HH
INPUT #3,fnt ' Schrifttype / Font
INPUT #3,pkt ' Punkt / Point
INPUT #3,art ' Verifizierung / 0 = normal, 1 = fett, 3 = kursiv ...
CLOSE #3
' Monitor 1920 x 1050 pix
DESKTOP GET CLIENT TO PixW,PixH: x1=0: y1=0: x2=PixW-10: y2=PixH-34
cp="BK_2010 --- Die Betriebskostenabrechnung!"
o=0
GRAPHIC WINDOW cp,x1,y1,x2,y2 TO hwin
GRAPHIC ATTACH hwin,0
GRAPHIC CLEAR RGB(HH),RGB(NV)
GRAPHIC COLOR RGB(NV),RGB(HH) ' Black background with Green text like old time
GRAPHIC GET PIXEL (2,2) TO bkgr ' Find Background color if other colors used instead of black
GRAPHIC FONT fnt,pkt,art ' Select font
GRAPHIC CHR SIZE TO CarW,CarH ' Find pixel width and height of chosen graphic font
MaxCol=PixW/CarW
MaxRow=PixH/CarH
GOTO start
Hilfetext:
GRAPHIC COLOR RGB(RV),RGB(HH)
GRAPHIC SET POS (1*CarW,(1+o)*CarH) : GRAPHIC PRINT "-------------------------------------------------------------------------------------"
GRAPHIC SET POS (1*CarW,(2+o)*CarH) : GRAPHIC PRINT "| 00 Hilfetext: |"
GRAPHIC SET POS (1*CarW,(3+o)*CarH) : GRAPHIC PRINT "-------------------------------------------------------------------------------------"
GRAPHIC SET POS (1*CarW,(4+o)*CarH) : GRAPHIC PRINT "| Verwenden Sie den Zweizifferncode für die Ansteuerung der Menüpunkte! |"
GRAPHIC SET POS (1*CarW,(5+o)*CarH) : GRAPHIC PRINT "| |"
GRAPHIC SET POS (1*CarW,(6+o)*CarH) : GRAPHIC PRINT "| |"
GRAPHIC SET POS (1*CarW,(7+o)*CarH) : GRAPHIC PRINT "-------------------------------------------------------------------------------------"
GRAPHIC SET POS (1*CarW,(8+o)*CarH) : GRAPHIC PRINT "| ENDE = [RETURN] |"
GRAPHIC SET POS (1*CarW,(9+o)*CarH) : GRAPHIC PRINT "-------------------------------------------------------------------------------------"
GRAPHIC REDRAW
ff:
GRAPHIC INKEY$ TO fr0
IF fr0<>CHR$(13) THEN ff
menue:
'
'
start:
GRAPHIC COLOR RGB(NV),RGB(HH)
GRAPHIC SET POS (1*CarW,(1+o)*CarH) : GRAPHIC PRINT "-------------------------------------------------------------------------------------"
GRAPHIC SET POS (1*CarW,(2+o)*CarH) : GRAPHIC PRINT "| (c) 24.12.2020 Betriebskostenabrechnung 2020 |"
GRAPHIC SET POS (1*CarW,(3+o)*CarH) : GRAPHIC PRINT "| Detlev Wulff Wählen Sie das entsprechende Programm über den |"
GRAPHIC SET POS (1*CarW,(4+o)*CarH) : GRAPHIC PRINT "| Zwei-Ziffen-Code an (Ziffernblock): |"
GRAPHIC SET POS (1*CarW,(5+o)*CarH) : GRAPHIC PRINT "-------------------------------------------------------------------------------------"
GRAPHIC SET POS (1*CarW,(6+o)*CarH) : GRAPHIC PRINT "| |"
GRAPHIC SET POS (1*CarW,(7+o)*CarH) : GRAPHIC PRINT "-------------------------------------------------------------------------------------"
GRAPHIC SET POS (1*CarW,(8+o)*CarH) : GRAPHIC PRINT "| 01 : Vermieterabsender 09 : HZ Zahlerliste drucken |"
GRAPHIC SET POS (1*CarW,(9+o)*CarH) : GRAPHIC PRINT "-------------------------------------------------------------------------------------"
GRAPHIC SET POS (1*CarW,(10+o)*CarH) : GRAPHIC PRINT "| 02 : Rotationsdatenerbearbeitung 10 : HZ Abrechnung drucken |"
GRAPHIC SET POS (1*CarW,(11+o)*CarH) : GRAPHIC PRINT "-------------------------------------------------------------------------------------"
GRAPHIC SET POS (1*CarW,(12+o)*CarH) : GRAPHIC PRINT "|*03 : Drucken BK/HK 11 : Heizkosten-Zusammenführung |"
GRAPHIC SET POS (1*CarW,(13+o)*CarH) : GRAPHIC PRINT "-------------------------------------------------------------------------------------"
GRAPHIC SET POS (1*CarW,(14+o)*CarH) : GRAPHIC PRINT "| 04 : Kostenerfassung + Deckblatt drucken 12 : Ausdruck-Zusammenfuhrung |"
GRAPHIC SET POS (1*CarW,(15+o)*CarH) : GRAPHIC PRINT "-------------------------------------------------------------------------------------"
GRAPHIC SET POS (1*CarW,(16+o)*CarH) : GRAPHIC PRINT "| 05 : BK Abschlags- u. Zeitverknüpfung 13 : Mietsicherheit ausschütten |"
GRAPHIC SET POS (1*CarW,(17+o)*CarH) : GRAPHIC PRINT "-------------------------------------------------------------------------------------"
GRAPHIC SET POS (1*CarW,(18+o)*CarH) : GRAPHIC PRINT "| 06 : BK Zahlerliste drucken 14 : Datumsdifferenz |"
GRAPHIC SET POS (1*CarW,(19+o)*CarH) : GRAPHIC PRINT "-------------------------------------------------------------------------------------"
GRAPHIC SET POS (1*CarW,(20+o)*CarH) : GRAPHIC PRINT "| 07 : BK Abrechnung drucken 15 : Farb- u. Gestaltungswahl |"
GRAPHIC SET POS (1*CarW,(21+o)*CarH) : GRAPHIC PRINT "-------------------------------------------------------------------------------------"
GRAPHIC SET POS (1*CarW,(22+o)*CarH) : GRAPHIC PRINT "|*08 : Betriebskostenabr. modifizieren 16 : E N D E |"
GRAPHIC SET POS (1*CarW,(23+o)*CarH) : GRAPHIC PRINT "-------------------------------------------------------------------------------------"
GRAPHIC REDRAW
GOTO slf
'
sage:
n=""
GRAPHIC COLOR RGB(RV),RGB(HH)
GRAPHIC SET POS (5*CarW,6*CarH) : GRAPHIC PRINT "Zugriff nicht möglich! "
GRAPHIC REDRAW
SLEEP 1000
GRAPHIC SET POS (5*CarW,6*CarH) : GRAPHIC PRINT SPACE$(60)
GRAPHIC REDRAW
'
slf:
FOR a=1 TO 2
fr1:
GRAPHIC INKEY$ TO f
LOCAL PID AS DWORD
SLEEP 1
GRAPHIC GET DC TO hwin
IF hwin = 0 THEN ex ' Abbruch des Programms über Windows-Close-Symbol
IF f="" THEN fr1
IF ASC(f)<48 OR ASC(f)>57 THEN fr1
n=n+f
NEXT a
IF VAL(n)<=-1 OR VAL(n)>16 THEN sage:
'
ca=VAL(n)
'
SELECT CASE ca
CASE 0
GOTO Hilfetext
'
CASE 1
'
' Vermieterdaten erfassen
GRAPHIC COLOR RGB(BV),RGB(HH)
GRAPHIC SET POS (3*CarW,8*CarH) : GRAPHIC PRINT "01" : GRAPHIC REDRAW
SLEEP 2000
PID=SHELL("BK_ABS_2020")
GRAPHIC WINDOW END
CASE 2
'
' Mieterdatenerfassung
GRAPHIC COLOR RGB(BV),RGB(HH)
GRAPHIC SET POS (3*CarW,(10+o)*CarH) : GRAPHIC PRINT "02" : GRAPHIC REDRAW
SLEEP 2000
PID=SHELL("BK_GDA_2020")
GRAPHIC WINDOW END
CASE 3
GRAPHIC COLOR RGB(BV),RGB(HH)
GRAPHIC SET POS (3*CarW,(12+o)*CarH) : GRAPHIC PRINT "03" : GRAPHIC REDRAW
SLEEP 1000
GRAPHIC COLOR RGB(RV),RGB(HH)
GRAPHIC SET POS (3*CarW,(12+o)*CarH) : GRAPHIC PRINT "03 : Zahlerliste [1] / Statusliste = [2] "
f4:
GRAPHIC INKEY$ TO fr4
IF fr4<>"1" AND fr4<>"2" THEN f4
SELECT CASE fr4
CASE "1"
SLEEP 2000
PID=SHELL("BK_PRN_2020")
GRAPHIC WINDOW END
CASE "2"
SLEEP 2000
PID=SHELL("BK_STATUS_2020")
GRAPHIC WINDOW END
END SELECT
CASE 4
'
' Kostenerfassung
GRAPHIC COLOR RGB(BV),RGB(HH)
GRAPHIC SET POS (3*CarW,(14+o)*CarH) : GRAPHIC PRINT "04" : GRAPHIC REDRAW
SLEEP 2000
PID=SHELL("P27A3BV2_2020")
GRAPHIC WINDOW END
CASE 5
'
' Zeitverknüpfung
GRAPHIC COLOR RGB(BV),RGB(HH)
GRAPHIC SET POS (3*CarW,(16+o)*CarH) : GRAPHIC PRINT "05" : GRAPHIC REDRAW
SLEEP 2000
PID=SHELL("BK_STF_2020")
GRAPHIC WINDOW END
CASE 6
'
' BK Zahleriste drucken
GRAPHIC COLOR RGB(BV),RGB(HH)
GRAPHIC SET POS (3*CarW,(18+o)*CarH) : GRAPHIC PRINT "06" : GRAPHIC REDRAW
SLEEP 2000
PID=SHELL("BK_MO1_2020")
GRAPHIC WINDOW END
CASE 7
'
' BK Abrechnung drucken
GRAPHIC COLOR RGB(BV),RGB(HH)
GRAPHIC SET POS (3*CarW,(20+o)*CarH) : GRAPHIC PRINT "07" : GRAPHIC REDRAW
SLEEP 2000
PID=SHELL("BK_MO2_2020")
GRAPHIC WINDOW END
CASE 8
'
GRAPHIC COLOR RGB(BV),RGB(HH)
GRAPHIC SET POS (3*CarW,(22+o)*CarH) : GRAPHIC PRINT "08" : GRAPHIC REDRAW
SLEEP 1000
GRAPHIC COLOR RGB(RV),RGB(HH)
GRAPHIC SET POS (3*CarW,(22+o)*CarH) : GRAPHIC PRINT "08 : modifiziere BK = [1] / HK = [2] "
f5:
GRAPHIC INKEY$ TO fr5
IF fr5<>"1" AND fr5<>"2" THEN f5
SELECT CASE fr5
CASE "1"
SLEEP 2000
PID=SHELL("BK_STX_2020")
GRAPHIC WINDOW END
CASE "2"
SLEEP 2000
PID=SHELL("HK_STY_2020")
GRAPHIC WINDOW END
END SELECT
CASE 9
'
' HK Zahlerliste drucken
GRAPHIC COLOR RGB(BV),RGB(HH)
GRAPHIC SET POS (46*CarW,(8+o)*CarH) : GRAPHIC PRINT "09" : GRAPHIC REDRAW
SLEEP 2000
PID=SHELL("HK_MO3_2020")
GRAPHIC WINDOW END
CASE 10
'
' HK Abrechnung drucken
GRAPHIC COLOR RGB(BV),RGB(HH)
GRAPHIC SET POS (46*CarW,(10+o)*CarH) : GRAPHIC PRINT "10" : GRAPHIC REDRAW
SLEEP 2000
PID=SHELL("HK_MO4_2020")
GRAPHIC WINDOW END
CASE 11
'
' --
GRAPHIC COLOR RGB(BV),RGB(HH)
GRAPHIC SET POS (46*CarW,(12+o)*CarH) : GRAPHIC PRINT "11" : GRAPHIC REDRAW
SLEEP 2000
PID=SHELL("BK_ZUS_2020")
GRAPHIC WINDOW END
CASE 12
'
GRAPHIC COLOR RGB(BV),RGB(HH)
GRAPHIC SET POS (46*CarW,(14+o)*CarH) : GRAPHIC PRINT "12" : GRAPHIC REDRAW
SLEEP 2000
PID=SHELL("BK_ZUP_2020")
GRAPHIC WINDOW END
CASE 13
'
' Mietsicherheit berechnen
GRAPHIC COLOR RGB(BV),RGB(HH)
GRAPHIC SET POS (46*CarW,(16+o)*CarH) : GRAPHIC PRINT "13" : GRAPHIC REDRAW
SLEEP 2000
PID=SHELL("BK_MSH")
GRAPHIC WINDOW END
CASE 14
GRAPHIC COLOR RGB(BV),RGB(HH)
GRAPHIC SET POS (46*CarW,(18+o)*CarH) : GRAPHIC PRINT "14" : GRAPHIC REDRAW
SLEEP 2000
PID=SHELL("BK_DIF_2020")
GRAPHIC WINDOW END
CASE 15
'
' NebenKosten_COLor
GRAPHIC COLOR RGB(BV),RGB(HH)
GRAPHIC SET POS (46*CarW,(20+o)*CarH) : GRAPHIC PRINT "15" : GRAPHIC REDRAW
SLEEP 2000
PID=SHELL("BK_COL_2020")
GRAPHIC WINDOW END
CASE 16
GRAPHIC COLOR RGB(BV),RGB(HH)
GRAPHIC SET POS (46*CarW,(22+o)*CarH) : GRAPHIC PRINT "16" : GRAPHIC REDRAW
'
GRAPHIC COLOR RGB(PV),RGB(HH)
FOR cr = 1 TO 80
crack = STRING$(cr,32)+"E N D E"
GRAPHIC SET POS (5*CarW,6*CarH) : GRAPHIC PRINT USING$("\ \",crack) : GRAPHIC REDRAW
SLEEP 130
NEXT cr
GRAPHIC WINDOW END
END SELECT
ex:
PLAY WAVE "#1"
END FUNCTION
' ohne Funktion
' GRAPHIC COLOR RGB(LV),RGB(HH)
' GRAPHIC SET POS (46*CarW,(16+o)*CarH) : GRAPHIC PRINT "13" : GRAPHIC REDRAW
' GRAPHIC COLOR RGB(RV),RGB(HH)
' GRAPHIC SET POS (5*CarW,(6+o)*CarH) : GRAPHIC PRINT "Zugriff nicht möglich! "
' GRAPHIC REDRAW
' SLEEP 2000
' GRAPHIC SET POS (5*CarW,(6+o)*CarH) : GRAPHIC PRINT SPACE$(60)
' GRAPHIC REDRAW
' GOTO start'
Farbinitierungsprogramm
' BK_COL_2020 - COLoreinstellung - Version 24.12.2010
'
' #RESOURCE "BK_COL.PBR"
#COMPILE EXE
#DIM ALL
#CONSOLE OFF
GLOBAL PixW,PixH,x1,y1,x2,y2,hwin,bkgr,CarW,CarH,MaxCol,MaxRow AS LONG
GLOBAL fn,cp,fnt,z,n,taste,tx,TXT AS STRING
GLOBAL pkt,art,zeile,spalte,le,sc,dummy,lge,kurz,la,RES,nle,tenu,vl AS INTEGER
GLOBAL I AS INTEGER
GLOBAL NV,GV,LV,RV,BV,HH,dy AS LONG
GLOBAL cNV,cGV,cLV,cRV,cBV,cHH,nix AS STRING
GLOBAL fr0,fr1,TYP AS STRING
FUNCTION PBMAIN () AS LONG
NV = &HF0D631 ' Bernstein / Amber
GV = &H00CC00 ' Grün / Green
LV = &HC480FC ' Lila / Purple
RV = &HFF0000 ' Rot / Red
BV = &H0000FF ' Blau / Blue
HH = &H000000 ' Schwarz / Black
fnt = "Courier New"
art = 0
pkt = 20
OPEN "COLOR.DAT" FOR INPUT AS #3
INPUT #3,NV
INPUT #3,GV
INPUT #3,LV
INPUT #3,RV
INPUT #3,BV
INPUT #3,HH
INPUT #3,fnt ' Schrifttype / Font
INPUT #3,pkt ' Punkt / Point
INPUT #3,art ' Verifizierung /
CLOSE #3
CALL hex (NV,cNV)
CALL hex (GV,cGV)
CALL hex (LV,cLV)
CALL hex (RV,cRV)
CALL hex (BV,cBV)
CALL hex (HH,cHH)
' Monitor 1920 x 1050 pix
DESKTOP GET CLIENT TO PixW,PixH: x1=0: y1=0: x2=PixW-10: y2=PixH-34
cp="BK_COL_2020 --- Farbe u. Gestaltung"
GRAPHIC WINDOW cp,x1,y1,x2,y2 TO hwin
GRAPHIC ATTACH hwin,0
GRAPHIC CLEAR RGB(HH),RGB(NV)
GRAPHIC COLOR RGB(NV),RGB(HH) ' Black background with Green text like old time
GRAPHIC GET PIXEL (2,2) TO bkgr ' Find Background color if other colors used instead of black
GRAPHIC FONT fnt,pkt,art ' Select: font, point, art
GRAPHIC CHR SIZE TO CarW,CarH ' Find pixel width and height of chosen graphic font
MaxCol=PixW/CarW
MaxRow=PixH/CarH
start:
GRAPHIC FONT fnt,pkt,art
GRAPHIC CLEAR RGB(HH),RGB(NV)
GRAPHIC SET POS (1*CarW,2*CarH) : GRAPHIC PRINT "* Farb- u. Gestaltungswahl *"
'
GRAPHIC SET POS (1*CarW,25*CarH) : GRAPHIC PRINT STRING$(78,32)
GRAPHIC SET POS (1*CarW,25*CarH) : GRAPHIC PRINT"[Esc] = Abbruch [1] = Farbeladen [2] = Reset [3] = Invert [S]icherung" : GRAPHIC REDRAW
'
f0:
GRAPHIC INKEY$ TO fr0
IF fr0<>CHR$(27) AND _
fr0<>"1" AND _
fr0<>"2" AND _
fr0<>"3" AND _
fr0<>"s" AND fr0<>"S" THEN f0
'
SELECT CASE fr0
CASE "1"
TYP=" - - -> > > Alte Farbeinstellung < < <- - -"
OPEN "COLOR.DAT" FOR INPUT AS #3
INPUT #3,NV
INPUT #3,GV
INPUT #3,LV
INPUT #3,RV
INPUT #3,BV
INPUT #3,HH
INPUT #3,fnt ' Schrifttype / Font
INPUT #3,pkt ' Punkt / Point
INPUT #3,art ' Verifizierung /
CLOSE #3
CALL hex (NV,cNV)
CALL hex (GV,cGV)
CALL hex (LV,cLV)
CALL hex (RV,cRV)
CALL hex (BV,cBV)
CALL hex (HH,cHH)
GOTO bild0
CASE "2"
TYP=" - - -> > > R e s e t < < <- - -"
NV = &HF0D631 ' Bernstein / Amber
GV = &H00CC00 ' Grün / Green
LV = &HC480FC ' Lila / Purple
RV = &HFF0000 ' Rot / Red
BV = &H0000FF ' Blau / Blue
HH = &H000000 ' Schwarz / Black
art = 0
CALL hex (NV,cNV)
CALL hex (GV,cGV)
CALL hex (LV,cLV)
CALL hex (RV,cRV)
CALL hex (BV,cBV)
CALL hex (HH,cHH)
GOTO bild0
CASE "3"
TYP=" - - -> > > I n v e r t < < <- - -"
NV = &H000000 ' Schwarz / Black
GV = &H00FF00 ' Grün / Green
LV = &HC480FC ' Lila / Purple
RV = &HFF0000 ' Rot / Red
BV = &H0000FF ' Blau / Blue
HH = &HFFFFFF ' Weiss / White
art = 1
CALL hex (NV,cNV)
CALL hex (GV,cGV)
CALL hex (LV,cLV)
CALL hex (RV,cRV)
CALL hex (BV,cBV)
CALL hex (HH,cHH)
GOTO bild0
bild0:
GRAPHIC CLEAR RGB(HH),RGB(NV)
GRAPHIC FONT fnt,pkt,art
GRAPHIC COLOR RGB(NV),RGB(HH)
GRAPHIC SET POS (1*CarW,1*CarH) : GRAPHIC PRINT " Farb- u. Textparametrierung "
GRAPHIC SET POS (1*CarW,3*CarH) : GRAPHIC PRINT USING$("\ \",TYP)
GRAPHIC COLOR RGB(NV),RGB(HH)
GRAPHIC SET POS (1*CarW,5*CarH) : GRAPHIC PRINT USING$("[1] Vordergrund Normaltext &H\ \",cNV)
'
GRAPHIC COLOR RGB(GV),RGB(HH)
GRAPHIC SET POS (1*CarW,7*CarH) : GRAPHIC PRINT USING$("[2] Vordergrund Markertext &H\ \",cGV)
'
GRAPHIC COLOR RGB(LV),RGB(HH)
GRAPHIC SET POS (1*CarW,9*CarH) : GRAPHIC PRINT USING$("[3] Vordergrund Hilfstext &H\ \",cLV)
'
GRAPHIC COLOR RGB(RV),RGB(HH)
GRAPHIC SET POS (1*CarW,11*CarH) : GRAPHIC PRINT USING$("[4] Vordergrund Hilfstext &H\ \",cRV)
'
GRAPHIC COLOR RGB(BV),RGB(HH)
GRAPHIC SET POS (1*CarW,13*CarH) : GRAPHIC PRINT USING$("[5] Vordergrund Hilfstext &H\ \",cBV)
'
GRAPHIC COLOR RGB(HH),RGB(NV)
GRAPHIC SET POS (1*CarW,15*CarH) : GRAPHIC PRINT USING$("[6] Hintergrund &H\ \",cHH)
'
GRAPHIC COLOR RGB(NV),RGB(HH)
GRAPHIC SET POS (1*CarW,17*CarH) : GRAPHIC PRINT USING$("[7] Texttyp \ \",fnt)
'
GRAPHIC COLOR RGB(NV),RGB(HH)
GRAPHIC SET POS (1*CarW,19*CarH) : GRAPHIC PRINT USING$("[8] Textgröße ###",pkt)
'
GRAPHIC COLOR RGB(NV),RGB(HH)
GRAPHIC SET POS (1*CarW,21*CarH) : GRAPHIC PRINT USING$("[9] Textmodi #",art)
GRAPHIC COLOR RGB(NV),RGB(HH)
GRAPHIC SET POS (1*CarW,25*CarH) : GRAPHIC PRINT STRING$(78,32)
GRAPHIC SET POS (1*CarW,25*CarH) : GRAPHIC PRINT"[Esc] = Abbruch Eingaben => [1] .. [9] [S]icherung"
GRAPHIC REDRAW
'
f1:
GRAPHIC INKEY$ TO fr1
LOCAL hDC,PID AS DWORD
SLEEP 1
GRAPHIC GET DC TO hDC
IF hDC = 0 THEN exi
IF fr1<>CHR$(27) AND _
fr1<>"s" AND fr1<>"S" AND _
fr1<>"1" AND _
fr1<>"2" AND _
fr1<>"3" AND _
fr1<>"4" AND _
fr1<>"5" AND _
fr1<>"6" AND _
fr1<>"7" AND _
fr1<>"8" AND _
fr1<>"9" GOTO f1
'
SELECT CASE fr1
CASE "1"
cNV=""
NV=0
CALL ceditor(NV,HH,GV,HH,CarW,CarH,5,38,6,3,cNV,NV)
GOTO bild0
CASE "2"
cGV=""
GV=0
CALL ceditor(NV,HH,GV,HH,CarW,CarH,7,38,6,3,cGV,GV)
GOTO bild0
CASE "3"
cLV=""
LV=0
CALL ceditor(NV,HH,GV,HH,CarW,CarH,9,38,6,3,cLV,LV)
GOTO bild0
CASE "4"
cRV=""
RV=0
CALL ceditor(NV,HH,GV,HH,CarW,CarH,11,38,6,3,cRV,RV)
GOTO bild0
CASE "5"
cBV=""
BV=0
CALL ceditor(NV,HH,GV,HH,CarW,CarH,13,38,6,3,cBV,BV)
GOTO bild0
CASE "6"
cHH=""
HH=0
CALL ceditor(NV,HH,GV,HH,CarW,CarH,15,38,6,3,cHH,HH)
GOTO bild0
CASE "7"
fn=""
dy=0
CALL ceditor(NV,HH,GV,HH,CarW,CarH,17,38,20,1,fn,dy)
IF fn="" THEN GOTO bild0 ELSE fnt=fn
GOTO bild0
CASE "8"
nix=""
pkt=0
dy=0
CALL ceditor(NV,HH,GV,HH,CarW,CarH,19,38,2,2,nix,dy)
pkt=dy
GOTO bild0
CASE "9"
nix=""
art=0
dy=0
CALL ceditor(NV,HH,GV,HH,CarW,CarH,21,38,1,2,nix,dy)
art=dy
GOTO bild0
CASE CHR$(27)
GOTO start
CASE "s","S"
GOTO sichern
END SELECT
' CASE CHR$(0,68)
sichern:
OPEN "COLOR.DAT" FOR OUTPUT AS #3
PRINT #3,NV
PRINT #3,GV
PRINT #3,LV
PRINT #3,RV
PRINT #3,BV
PRINT #3,HH
PRINT #3,fnt ' Schrifttype
PRINT #3,pkt ' Punktgröße
PRINT #3,art ' Verifizierung
CLOSE #3
GOTO start
'
CASE CHR$(27)
GOTO exi
END SELECT
exi:
PID=SHELL("BK_2020")
GRAPHIC WINDOW END
END FUNCTION
'
' GR_C_ED.INC
'
' cv1 = Color Vordergrund )
' ch1 = Color Hintergrund ) - einschalten
' cv2 = Color Vordergrund )
' ch2 = Color Hintergrund ) - ausschalten
' CarW = Spalte pixeltechnisch
' CarH = Zeile pixeltechnisch
' y = Zeile
' x = Spalte
' vl = Feldlängenbeschränkung der Eingabe
' tenu = : Text = 1 Währung = 2
' txt = alphanum Ruckgabe
' num = numerische Rückgabe (Währung) -- LONG statt CURRENCY
'
SUB ceditor(cv1 AS LONG,ch1 AS LONG,cv2 AS LONG ,ch2 AS LONG,CarW AS LONG ,CarH AS LONG,y AS INTEGER ,x AS INTEGER,vl AS INTEGER,tenu AS INTEGER,TXT AS STRING,num AS LONG)
started:
GRAPHIC COLOR RGB(cv2),RGB(ch2)
LOCAL le,sc,n,tl,kurz,lg,result,nle AS INTEGER
LOCAL taste,tx AS STRING
le=LEN(TXT)+1
GRAPHIC SET POS (x*CarW,y*CarH) : GRAPHIC PRINT STRING$(le,32)
GRAPHIC SET POS (x*CarW,y*CarH) : GRAPHIC PRINT STRING$(vl,149)
GRAPHIC SET POS (x*CarW,y*CarH) : GRAPHIC PRINT TXT : GRAPHIC REDRAW
'
fraed:
GRAPHIC INKEY$ TO taste
IF taste="" THEN fraed
'
IF taste="," THEN taste="."
'
SELECT CASE tenu
CASE 1,3
GOTO weitered
CASE 2
sc=ASC(RIGHT$(taste,1))
IF (sc>31 AND sc<45) OR (sc>57 AND sc<256) THEN GOSUB jumped:GOTO backed
END SELECT
weitered:
' [Entf]
IF taste=CHR$(0)+CHR$(83) THEN
TXT=CHR$(238)
'
GRAPHIC COLOR RGB(cv2),RGB(ch2)
GRAPHIC SET POS (x*CarW,y*CarH) : GRAPHIC PRINT TXT
GRAPHIC REDRAW
GOTO exed
END IF
' [Einf]
IF taste=CHR$(0)+CHR$(82) THEN
TXT=CHR$(237)
'
GRAPHIC COLOR RGB(cv1),RGB(ch1)
GRAPHIC SET POS (x*CarW,y*CarH) : GRAPHIC PRINT TXT
GRAPHIC REDRAW
GOTO exed
END IF
IF ASC(RIGHT$(taste,1))=8 THEN n=5:GOSUB jumped:GOTO backed:' backspace
IF ASC(RIGHT$(taste,1))=13 THEN taste="":GOTO exed:' taste return
'
backed:
TXT=TXT+taste
tl=LEN(TXT)
IF tl>vl THEN BEEP:GOSUB jumped
GOTO started
'
jumped:
' Lscht die letzte gedrckte Taste
taste=""'
' Soll den mit LEN() gemessenen
' Text um 'ein' Zeichen reduzieren
kurz=1
lg=LEN(TXT)
result=lg-kurz
IF result<=0 THEN result=1:TXT="":tx=""
tx=LEFT$(TXT,result)
' bergabe des Stringergebnisses
TXT=tx
RETURN
'
exed:
' Berechnet den Zahlenwert des Textes mittels
' des internen Befehls VAL()
' If tenu=1 Then num=0 Else If tenu=2 Then num=Val(txt)
SELECT CASE tenu
CASE 1
num=0
num = VAL(TXT)
nle = vl - LEN(TXT)
GRAPHIC COLOR RGB(cv1),RGB(ch1)
GRAPHIC SET POS (x*CarW,y*CarH) : GRAPHIC PRINT STRING$(nle,32) + TXT
GRAPHIC REDRAW
GOTO ex
CASE 2
num=VAL(TXT)
nle=vl-LEN(TXT)
' COLOR cv1,ch1
GRAPHIC COLOR RGB(cv1),RGB(ch1)
GRAPHIC SET POS (x*CarW,y*CarH) : GRAPHIC PRINT STRING$(nle,32) + TXT
GRAPHIC REDRAW
GOTO ex
CASE 3
num=VAL("&H"+TXT)
TXT=HEX$(num)
LOCAL lang AS INTEGER
lang = LEN(TXT)
TXT = STRING$(6-lang,"0")+TXT
nle=vl-LEN(TXT)
GRAPHIC COLOR RGB(cv1),RGB(ch1)
GRAPHIC SET POS (x*CarW,y*CarH) : GRAPHIC PRINT STRING$(nle,32) + TXT
GRAPHIC REDRAW
GOTO ex
ex:
END SELECT
END SUB
' ---
SUB hex (num AS LONG,TXT AS STRING)
TXT=HEX$(num)
LOCAL lang AS INTEGER
lang = LEN(TXT)
TXT = STRING$(6-lang,"0")+TXT
END SUB
| Dateimanager |
|---|
| Es wurden bisher keine Sources abgelegt. |