Announcement

Collapse
No announcement yet.

PBCC: COLOR initialising

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBCC: COLOR initialising

    Hi I wrote a program for intizate color and textstyle for some programs


    ' BK_COL - COLoreinstellung - Version 24.12.2010
    '

    #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"
    pkt = 20
    art = 0


    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 / points per letter
    INPUT #3,art ' Verifizierung / 0 - normal, 1 - fat, 2 - cursiv and so on
    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:
    ' L”scht die letzte gedrckte 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


Working...
X