Announcement

Collapse
No announcement yet.

Double size letters on screen

Collapse
X
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • Gary Russell
    Guest replied
    The program I sent can produse print to the screen of any size.
    Jest change the SIZE$ = "24" to SIZE$ = "4" or whotever.

    ------------------

    Leave a comment:

  • Gary Russell
    Guest replied

    print large size letter on the screen.
    This program will print latters any size you wount.

    'gary.bas by gary russell
    '[email protected]
    DECLARE SUB NORMAL0 ()
    DECLARE SUB LAYER2 ()
    DECLARE SUB LAYER1 ()
    DECLARE SUB TRANSLATE ()
    DECLARE SUB LETTERS ()

    DEFINT A-Z '
    DIM P$(122)
    SHARED P$()
    SHARED P$, SIZE$
    SHARED C1$, C2$, C3$
    SHARED C4$, BGC, DOT$
    SHARED SPACING$, WORD$
    SHARED PFT, PFL
    CALL LETTERS '
    SCREEN 9 '''''''''''''''''''''

    EFFECT1:
    LINE (1, 1)-(590, 72), 4, BF
    LINE (202, 3)-(588, 70), 1, BF
    WORD$ = "GARY RUSSELL" '
    SPACING$ = "L1"
    SIZE$ = "24" '
    DOT$ = "N" '
    BGC = 4 '
    CALL TRANSLATE '
    C1$ = "C14": C2$ = "C 8": C3$ = "C 0": C4$ = "C15" '
    PFT = 52: PFL = 13: CALL LAYER1 '
    PFT = 52: PFL = 9: CALL LAYER1 '
    PFT = 51: PFL = 10: CALL LAYER1 '
    PFT = 51: PFL = 11: CALL LAYER1
    t$ = INPUT$(1)

    EFFECT2:
    LINE (3, 78)-(494, 130), 13, B
    LINE (5, 80)-(492, 128), 7, BF
    WORD$ = "DAVID RUSSELL"
    SPACING$ = "L1"
    SIZE$ = "20"
    DOT$ = "N"
    BGC = 7
    CALL TRANSLATE
    C1$ = "C 5": C2$ = "C 8": C3$ = "C 8": C4$ = "C 8"
    PFT = 117: PFL = 17: CALL LAYER2
    PFT = 117: PFL = 15: CALL LAYER2
    PFT = 117: PFL = 13: CALL LAYER2
    C1$ = "C 5": C2$ = "C 0": C3$ = "C 0": C4$ = "C15"
    PFT = 115: PFL = 19: CALL LAYER2
    PFT = 115: PFL = 18: CALL LAYER2
    t$ = INPUT$(1)

    EFFECT3:
    LINE (3, 136)-(178, 192), 8, BF
    LINE (3, 136)-(415, 192), 9, B
    WORD$ = "JAMES RUSSELL"
    SPACING$ = "L1"
    SIZE$ = "16"
    DOT$ = "N"
    BGC = 8
    CALL TRANSLATE
    C1$ = "C 0": C2$ = "C 0": C3$ = "C 0": C4$ = "C 0"
    PFT = 167: PFL = 12: CALL LAYER1
    C1$ = "C 8": C2$ = "C 7": C3$ = "C15": C4$ = "C 0"
    PFT = 167: PFL = 13: CALL LAYER2
    PFT = 167: PFL = 12: CALL LAYER2
    PFT = 166: PFL = 13: CALL LAYER2
    PFT = 167: PFL = 11: CALL LAYER2
    t$ = INPUT$(1)

    EFFECT4:
    LINE (2, 206)-(636, 303), 12, BF
    LINE (1, 204)-(639, 306), 15, B
    LINE (19, 280)-(620, 280), 14, B
    LINE (20, 281)-(619, 281), 0, B
    LINE (21, 282)-(618, 282), 0, B
    WORD$ = "JOHN RUSSELL"
    SPACING$ = "L1"
    SIZE$ = "28"
    DOT$ = "N"
    BGC = 12
    CALL TRANSLATE
    C1$ = "C12": C2$ = "C 4": C3$ = "C 0": C4$ = "C 0"
    PFT = 266: PFL = 24: CALL LAYER1
    C1$ = "C12": C2$ = "C 4": C3$ = "C 0": C4$ = "C 0"
    PFT = 265
    FOR XX = 25 TO 33 STEP 2
    PFL = XX: CALL LAYER1
    PFT = PFT - 1
    NEXT
    C1$ = "C15": C2$ = "C 6": C3$ = "C 6": C4$ = "C14"
    PFT = 259: PFL = 40: CALL LAYER1
    PFT = 259: PFL = 36: CALL LAYER1
    PFT = 258: PFL = 38: CALL LAYER1
    t$ = INPUT$(1)

    ALPHABET:
    LINE (1, 315)-(639, 331), 7, B
    LINE (2, 316)-(638, 330), 15, BF
    WORD$ = " THE RUSSELL BOYS MOMY JULIE ANN RUSSELL"
    SPACING$ = "R0"
    SIZE$ = "4"
    DOT$ = "N"
    BGC = 15
    CALL TRANSLATE
    C1$ = "C 1"
    PFT = 324: PFL = 5: CALL NORMAL0
    t$ = INPUT$(1)

    SUB LAYER1
    PSET (PFL + 2, PFT + 5), BGC: DRAW C3$ + P$
    PSET (PFL + 0, PFT + 5), BGC: DRAW C3$ + P$
    PSET (PFL + 1, PFT + 5), BGC: DRAW C3$ + P$
    PSET (PFL + 0, PFT + 4), BGC: DRAW C3$ + P$
    PSET (PFL + 1, PFT + 2), BGC: DRAW C2$ + P$
    PSET (PFL + 2, PFT + 4), BGC: DRAW C1$ + P$
    PSET (PFL + 3, PFT + 3), BGC: DRAW C4$ + P$
    PSET (PFL + 3, PFT + 2), BGC: DRAW C2$ + P$
    PSET (PFL + 4, PFT + 4), BGC: DRAW C2$ + P$
    PSET (PFL + 5, PFT + 2), BGC: DRAW C3$ + P$
    PSET (PFL + 5, PFT + 3), BGC: DRAW C2$ + P$
    PSET (PFL + 4, PFT + 3), BGC: DRAW C1$ + P$
    END SUB

    SUB LAYER2
    PSET (PFL + 0, PFT + 5), BGC: DRAW C4$ + P$
    PSET (PFL + 0, PFT + 3), BGC: DRAW C4$ + P$
    PSET (PFL + 2, PFT + 3), BGC: DRAW C1$ + P$
    PSET (PFL + 1, PFT + 2), BGC: DRAW C1$ + P$
    PSET (PFL + 2, PFT + 4), BGC: DRAW C4$ + P$
    PSET (PFL + 3, PFT + 3), BGC: DRAW C3$ + P$
    PSET (PFL + 3, PFT + 2), BGC: DRAW C1$ + P$
    PSET (PFL + 4, PFT + 4), BGC: DRAW C1$ + P$
    PSET (PFL + 5, PFT + 2), BGC: DRAW C1$ + P$
    PSET (PFL + 5, PFT + 3), BGC: DRAW C2$ + P$
    PSET (PFL + 4, PFT + 3), BGC: DRAW C1$ + P$
    END SUB

    SUB LETTERS
    P$(32) = "BR4" 'space
    P$(65) = "BD1U7E1R3F1D3L5R5D4BR4BU1" 'A
    P$(66) = "BD1U8R4F1D2G1L4R4F1D2G1L4BU1BR9" 'B
    P$(67) = "BD1BU1U6E1R3F1BD6G1L3H1F1R3BR4BU1" 'C
    P$(68) = "BD1U8R4F1D6G1L4BR9BU1" 'D
    P$(69) = "BD1U8R4L4D4R3L3D4R4BU1BR4" 'E
    P$(70) = "BD1U8R5L5D4R4L4D4BR8BU1" 'F
    P$(71) = "BD1BU1U6E1R3F1BD6G1L3H1F1R3E1U3L2RD3BR4" 'G
    P$(72) = "BD1U8D4R4U4D8BR4BU1" 'H
    P$(73) = "BD1BR1U8L1R2L1D8L1R2BR4BU1" 'I
    P$(74) = "BD1BU1F1R2E1U7L1R2L1D7BR5" 'J
    P$(75) = "BD1BU8D8U4R1E4G4F4BR4BU1" 'K
    P$(76) = "BD1BU8D8R4BU1BR4" 'L
    P$(77) = "BD1U7E1R2F1D7U7E1R2F1D7BU1BR4" 'M
    P$(78) = "BD1U8F7D1U8D8BR4BU1" 'N
    P$(79) = "BD1BU1U6E1R3F1BD6G1L3H1BR5U6D6BR4" 'O
    P$(80) = "BD1U8R4F1D2G1L4D4BR9BU1" 'P
    P$(81) = "BD1BU1U6E1R3F1BD6G1L3H1BR5U6BL3BD5F3BG3BR7BU5" 'Q
    P$(82) = "BD1U8R4F1D2G1L4R1F4BR4BU1" 'R
    P$(83) = "BD1BU5U2E1R3F1BD2BL5F1R3F1D2G1L3H1BR9" 'S
    P$(84) = "BR3BD1BU8L4R6L3D8BR6BU1" 'T
    P$(85) = "BD1BU1U7D7F1R3E1U7D7BR4" 'U
    P$(86) = "BD1BU8D5F2D1U1E2U5D5BR5BD2" 'V 'P$(86) = "BD1BU8D5F2D1U1E2U5D5BR5BD2"
    P$(87) = "BD1BU1U7D7F1R2E1U7D7F1R2E1U7D7BD1BR4BU1" 'W
    P$(88) = "BD1BU8D1F3E3U1D1G6D1U1E3F3D1BU1BR5" 'X
    P$(89) = "BL1BU5U2D2F3E3U2D2G3D3BU1BR7" 'Y
    P$(90) = "BU7R5D2G5D1R5BR4BU1" 'Z
    END SUB

    SUB NORMAL0
    PSET (PFL + 0, PFT + 0), BGC: DRAW C1$ + P$
    END SUB

    SUB TRANSLATE
    SPACING$ = "B" + UCASE$(SPACING$)
    SIZE$ = "S" + UCASE$(SIZE$)
    P$(105) = "BR0BD1U6BU2BD7BR4" 'i
    P$(106) = "BR1BD1U6BU2BD7D3G1L2BU4BR8" 'j
    IF DOT$ = "Y" THEN P$(105) = "BR0BD1U6BU1U1BD7BR4"
    IF DOT$ = "Y" THEN P$(106) = "BR1BD1U6BU1U1BD7D3G1L2BU4BR8"
    P$ = SIZE$
    FOR J = 1 TO LEN(WORD$)
    P$ = P$ + P$(ASC(MID$(WORD$, J, 1))) + SPACING$
    NEXT J
    END SUB



    ------------------

    Leave a comment:

  • Hanns Ackermann
    replied
    Hi Fred,

    just found the code mentioned in my last post, hope that helps.
    Please feel free to use and modify it. The code is not up-to-date,
    however, six years ago I had much fun with it. I think it's no
    problem to write some lines for double-high-double-width and so on.
    The code is fairly long for this thread, sorry, Lance ...

    Cheers, Hanns.


    Code:
    ' --------------------------------------------------------------------------
' EXAMPLE MAIN PROG: Writing characters to screen (graphics mode)
' Styles: Normal, Small, Double-width, Double-high, Double-width-Shadowed
' DOS >= 3.3 only, Screen>3 incl. HGC (good old days)
' --------------------------------------------------------------------------

' Pfad$= Path of ASCII-Table listed below (if char.set not found, cf. below)
' CALL VersionDos(DosVersion)       ' DOS version
' CALL WoBinIch(DosVersion,Pfad$)   ' Find app's path

  Screenmodus%=12
  SCREEN Screenmodus%
  COLOR 1,1 : CLS
  WINDOW (0,0)-(100,100)

  CALL WoIstFont(Screenmodus%)             ' Searching address of characters

  Xpos=10 : Ypos=15                        ' Position of your text
  VX%=0 : VY%=0                            ' Shift units (half character)
  CO%=15                                   ' Text color
  Cs%=7                                    ' Shadow color
  Text$="PowerBasic. That's all you need." ' Your text

  CALL FontKlein (Text$,Xpos,Ypos   ,VX%,VY%,Co%)        ' Small
  CALL FontNormal(Text$,Xpos,Ypos+10,VX%,VY%,Co%-1)      ' Normal
  CALL FontHoch  (Text$,Xpos,Ypos+20,VX%,VY%,Co%-2)      ' Double-high
  CALL FontBreitX(Text$,Xpos,Ypos+30,VX%,VY%,Co%-3,0)    ' Double-width
  CALL FontBreitX(Text$,Xpos,Ypos+40,VX%,VY%,Co%-4,Cs%)  ' Double-w. shadow
' CALL HGCFont   (Text$,Xpos,Ypos   ,VX%,VY%,Co%)        ' Hercules !!!!

END


' ---------------------------------------------------------------------------

' WoIstFont:                                          6.3.1994   LV: 5.5.1994
'
' Lokalisiert die Zeichentabellen 8*8 und 8*14 bzw. 8*16: Tischer p. 1185
' Segmentadresse: FontSen&,FontSek&  Offset: FontOfn&,FontOfk&

' ---------------------------------------------------------------------------

SUB WoIstFont(ScreenModus%)

  SHARED FontSen&,FontOfn&,FontSem&,FontOfm&,FontSek&,FontOfk&
  LOCAL  I%,X%,X$

  If ScreenModus%<=3 then
    FontSen&=-1 : FontOfn&=-1
  Else
    REG 1, &H1130        ' Funktion 11, Unterfunktion 30 fr INT &H10
    REG 2, &H0600        ' 8*16-Zeichensatz Tischer p.1185
    CALL INTERRUPT &H10  ' Info ber Z-Generator holen
    FontSen&=REG(9) : FontSen&=FontSen&-65536*(FontSen&<0) ' REG(9)=ES
    FontOfn&=REG(7) : FontOfn&=FontOfn&-65536*(FontOfn&<0) ' REG(7)=BP
    REG 1, &H1130        ' Funktion 11, Unterfunktion 30 fr INT &H10
    REG 2, &H0200        ' 8*14-Zeichensatz Tischer p.1185
    CALL INTERRUPT &H10  ' Info ber Z-Generator holen
    FontSem&=REG(9) : FontSem&=FontSem&-65536*(FontSem&<0) ' REG(9)=ES
    FontOfm&=REG(7) : FontOfm&=FontOfm&-65536*(FontOfm&<0) ' REG(7)=BP
    REG 1, &H1130        ' Funktion 11, Unterfunktion 30 fr INT &H10
    REG 2, &H0300        ' 8*8-Zeichensatz Tischer p.1185
    CALL INTERRUPT &H10  ' Info ber Z-Generator holen
    FontSek&=REG(9) : FontSek&=FontSek&-65536*(FontSek&<0) ' REG(9)=ES
    FontOfk&=REG(7) : FontOfk&=FontOfk&-65536*(FontOfk&<0) ' REG(7)=BP
  End If

END SUB


' ---------------------------------------------------------------------------
'
' FONTS:                                               6.3.1994  LV 10.5.1996
'
' FONTS setzt die Lokalisation der Zeichentabelle voraus.
' Segmentadresse: Normal: FontSen&, Klein: FontSek&
' Offset:         Normal: FontOfn&, Klein: FontOfk&
'
' ---------------------------------------------------------------------------
' Umstellung von 8*14 auf 8*16 am 10.5.96:
' Nur vertikal jede 13 durch 15, jede 14 durch 16 ersetzt, horizontal bleibt!
' ---------------------------------------------------------------------------


SUB FontNormal(X$,XX,YY,VX%,VY%,Co%)                 ' Font 8*16 horizontal

  LOCAL  X%,Y%,Ad&,Y,Y1%,X0%,Z%,Vert%,Hori%,Zeich%
  SHARED FontSen&,FontOfn&

  DEF SEG = FontSen&
  X%=PMAP(XX,0)-3+VX%*4
  Y%=PMAP(YY,1)-6-VY%*7
  For Zeich%=1 to LEN(X$)
    X1%=ASC(MID$(X$,Zeich%,1))
    Ad&=FontOfn&+16*X1%
    X0%=X%+8*(Zeich%-1)
    For Vert%=0 to 15
      Z%=PEEK(Ad&+Vert%)
      Y=PMAP(Y%+Vert%,3)
      For Hori%=0 to 7
        If BIT(Z%,Hori%) then PSET (PMAP(X0%+7-Hori%,2),Y),Co%
      Next Hori%
    Next Vert%
  Next Zeich%

END SUB


SUB FontHoch(X$,XX,YY,VX%,VY%,Co%)                ' Font 8*28 hoch

  SHARED FontSen&,FontOfn&,FontSem&,FontOfm& , Pfad$
  STATIC Gelesen?,Font?()
  LOCAL  X%,Y%,I%,J%,F%,I1%,I2%,I3%,I4%

  If FontSen&<>FontSem& or FontOfn&<>FontOfm& then  ' Zeichensatz 8*14 vorh.!
    X%=PMAP(XX,0)-3+VX%*4 : Y%=PMAP(YY,1)-7-VY%*13
    DEF SEG = FontSem&
    Ad& = FontOfm&+14*65 ' Zeichenanfang via 'A'!
    V%=0: DO: Z%=PEEK(Ad&+V%): V%=V%+1: LOOP UNTIL Z%<>0: V%=V%-1
    For Zch% = 1 to LEN(X$)
      X1% = ASC(MID$(X$,Zch%,1))
      Ad& = FontOfm&+14*X1%
      X0% = X%+8*(Zch%-1)
      For Ve% = 0 to 13-V%
        Z% = PEEK(Ad&+V%+Ve%)
        For Ho% = 0 to 7
          If (Z% AND 2^Ho%)<>0 then
            PSET (PMAP(X0%+7-Ho%,2),PMAP(Y%+2*Ve%  ,3)),Co%
            PSET (PMAP(X0%+7-Ho%,2),PMAP(Y%+2*Ve%-1,3)),Co%
          End If
        Next Ho%
      Next Ve%
    Next Zch%
  Else   ' falls 8*14 nicht vorhanden, HGC-Font 8*14 verwenden
    If Gelesen?=0 then                           ' 1. Lauf: einlesen
      Gelesen?=1
      I1%=32:I2%=123:I3%=0:I4%=13 : DIM Font?(I1%:I2%,I3%:I4%)
      F%=FREEFILE
      OPEN Pfad$+"HGCFONTS.BIN" for Input as #F%
      For I%=32 to 123
        For J%=0 to 13
          Input #F%, Font?(I%,J%)  ' ASCII32-122, Font?(123)=ASCII0!
        Next J%
      Next I%
      CLOSE #F%
    End If
    X%=PMAP(XX,0)-3+VX%*4
    Y%=PMAP(YY,1)-13-VY%*13
    For Zeich%=1 to LEN(X$)
      X1%=ASC(MID$(X$, Zeich%, 1)) : If X1%<32 or X1%>122 then X1%=123 ' ASCII0
      X0%=X%+8*(Zeich%-1)
      For Vert%=0 to 13
        Z%=Font?(X1%,Vert%)
        For Hori%=0 to 7
          If BIT(Z%,Hori%) then
            PSET (PMAP(X0%+7-Hori%,2),PMAP(Y%+2*Vert%  ,3)),Co%
            PSET (PMAP(X0%+7-Hori%,2),PMAP(Y%+2*Vert%-1,3)),Co%
          End If
        Next Hori%
      Next Vert%
    Next Zeich%
  End If

END SUB


SUB FontBreitX(X$,XX,YY,VX%,VY%,Co%,Cs%)  ' Font 2*8*16 breit incl. Schatten

  SHARED FontSen&,FontOfn&
  LOCAL  X%,Y%,Zeich%,X1%,X0%,Y1,Y2,Ad&,Vert%,Hori%,X00%

  DEF SEG = FontSen&
  X%=PMAP(XX,0)-6+VX%*8
  Y%=PMAP(YY,1)-6-VY%*7
  For Zeich%=1 to LEN(X$)
  X1%=ASC(MID$(X$,Zeich%,1))
  Ad&=FontOfn&+16*X1%
  X0%=X%+16*(Zeich%-1)
  For Vert%=15 to 0 Step -1
  Z%=PEEK(Ad&+Vert%)
  Y1=PMAP(Y%+Vert%-1,3)
  Y2=PMAP(Y%+Vert%  ,3)
  For Hori%=0 to 7
  If BIT(Z%,Hori%) then    ' BIT()=(Z% AND 2^Hori%)
    X00%=X0%+14-2*Hori%
    If Cs%>0 then
      PSET (PMAP(X00%+1,2),Y1),Cs%
      PSET (PMAP(X00%+2,2),Y1),Cs%
    End If
    PSET (PMAP(X00%  ,2),Y2),Co%
    PSET (PMAP(X00%+1,2),Y2),Co%
  End If
  Next Hori%
  Next Vert%
  Next Zeich%

END SUB


SUB FontKlein(X$,XX,YY,VX%,VY%,Co%)             ' Font 8*8 klein

  SHARED FontSen&,FontOfn&,FontSek&,FontOfk& , Pfad$
  STATIC Gelesen?,Font?()
  LOCAL  X%,Y%,I%,J%,F%,I1%,I2%,I3%,I4%

  If FontSen&<>FontSek& or FontOfn&<>FontOfk& then  ' Zeichensatz 8*8 vorh.!
    X%=PMAP(XX,0)-3+VX%*4 : Y%=PMAP(YY,1)-3-VY%*4
    DEF SEG = FontSek&
    For Zeich%=1 to LEN(X$)
      X1%=ASC(MID$(X$,Zeich%,1))
      Ad&=FontOfk&+8*X1%
      X0%=X%+8*(Zeich%-1)
      For Vert%=0 to 7
        Z%=PEEK(Ad&+Vert%)
        For Hori%=0 to 7
          If (Z% AND 2^Hori%)>0 then PSET (PMAP(X0%+7-Hori%,2),PMAP(Y%+Vert%,3)),Co%
        Next Hori%
      Next Vert%
    Next Zeich%
  Else                ' falls 8*14 nicht vorhanden, HGC-Font 8*14 verwenden!
    If Gelesen?=0 then                           ' 1. Lauf: einlesen
      Gelesen?=1
      I1%=32:I2%=123:I3%=0:I4%=13 : DIM Font?(I1%:I2%,I3%:I4%)
      F%=FREEFILE
      OPEN Pfad$+"HGCFONTS.BIN" for Input as #F%
      For I%=32 to 123
        For J%=0 to 13
          Input #F%, Font?(I%,J%)  ' ASCII32-122, Font?(123)=ASCII0!
        Next J%
      Next I%
      CLOSE #F%
    End If
    X%=PMAP(XX,0)-3+VX%*4
    Y%=PMAP(YY,1)-7-VY%*7
    For Zeich%=1 to LEN(X$)
      X1%=ASC(MID$(X$, Zeich%, 1)) : If X1%<32 or X1%>122 then X1%=123 ' ASCII0
      X0%=X%+8*(Zeich%-1)
      For Vert%=0 to 13
        Z%=Font?(X1%,Vert%)
        For Hori%=0 to 7
          If BIT(Z%,Hori%) then PSET (PMAP(X0%+7-Hori%,2),PMAP(Y%+Vert%,3)),Co%
        Next Hori%
      Next Vert%
    Next Zeich%
  End If

END SUB

SUB HGCFont(X$,XX,YY,VX%,VY%,Co%)            ' HGC&CGA-Font 8*14 horizontal

  STATIC Gelesen?,Font?()
  LOCAL  X%,Y%,I%,J%,F%,I1%,I2%,I3%,I4%
  SHARED Pfad$

  If Gelesen?=0 then                           ' 1. Lauf: einlesen
    Gelesen?=1
    I1%=32:I2%=123:I3%=0:I4%=13 : DIM Font?(I1%:I2%,I3%:I4%)
    F%=FREEFILE
    OPEN Pfad$+"HGCFONTS.BIN" for Input as #F%
    For I%=32 to 123
    For J%=0 to 13
      Input #F%, Font?(I%,J%)  ' ASCII32-122, Font?(123)=ASCII254!
    Next J%
    Next I%
    CLOSE #F%
  End If
  X%=PMAP(XX,0)-3+VX%*4
  Y%=PMAP(YY,1)-7-VY%*7
  For Zeich%=1 to LEN(X$)
  X1%=ASC(MID$(X$, Zeich%, 1)) : If X1%<32 or X1%>122 then X1%=123 ' ASCII254
  X0%=X%+8*(Zeich%-1)
  For Vert%=0 to 13
  Z%=Font?(X1%,Vert%)
  Y=PMAP(Y%+Vert%,3)
  For Hori%=0 to 7
  If BIT(Z%,Hori%) then PSET (PMAP(X0%+7-Hori%,2),Y),Co%  ' BIT()=(Z% AND 2^Hori%)
  Next Hori%
  Next Vert%
  Next Zeich%

END SUB


'----------------------------------------------------------------------------
'  WoBinIch() gibt den Pfad des aktuellen Programms zurck.        12.04.1994
'  Programmgrundlage ist Tischer, PC-Intern pp. 756,849,1295.
'----------------------------------------------------------------------------

SUB WoBinIch(DosVersion,Pfad$)

  LOCAL BX&,EB&,Z%,L%

  If DosVersion<3.3 then
    Pfad$=""
  Else
    REG 1, &H6200              ' Adresse PSP ermitteln (BX&)
    CALL INTERRUPT &H21
    BX&=REG(2)      : BX&=BX&-2^16*(BX&<0)
    DEF SEG = BX&              ' Segmentadresse (EB&) Environment-Block holen
    EB&=PEEKI(&H2C) : EB&=EB&-2^16*(EB&<0)

    DEF SEG = EB&              ' Environment:
    Z%=0                       ' Offset immer Null!
    DO                         ' Bei DoppelNUL: Env-Block Ende
      INCR Z%
    LOOP UNTIL PEEK(Z%)=0 AND PEEK(Z%+1)=0
    Pfad$=""
    If PEEK(Z%+2)=1 AND PEEK(Z%+3)=0 then
      Z%=Z%+4
      DO                       ' Name von DoppelNUL,1,NUL bis n„chste NUL!
        Pfad$=Pfad$+CHR$(PEEK(Z%))
        INCR Z%
      LOOP UNTIL PEEK(Z%)=0
      L%=LEN(Pfad$)            ' Nur Pfad, Name weg!
      WHILE MID$(Pfad$,L%,1)<>"\"
        DECR L%
      WEND
      Pfad$=UCASE$(MID$(Pfad$,1,L%))
    End If
  End If
END SUB


'----------------------------------------------------------------------------
'  DOS-Version ermitteln
'----------------------------------------------------------------------------

   SUB VersionDos(DosVersion)
'  DOS-Version: Tischer p. 1238
   REG 1, &H3000
   CALL INTERRUPT &H21
   AH%=(REG(1)/&H0100) AND &HFF    ' AH: Unterversion
   AL%= REG(1)         AND &HFF    ' AL: Hauptversion
   DosVersion=AL%+AH%/100
   END SUB

'============================================================================

$IF 0
' PLEASE WRITE THIS TO >> HGCFONTS.BIN << AS ASCII --------------------------
   0   0   0   0   0   0   0   0   0   0   0   0   0   0
   0   0   0  24  60  60  60  24  24   0  24  24   0   0
   0   0 102 102 102  36   0   0   0   0   0   0   0   0
   0   0   0 108 108 254 108 108 108 254 108 108   0   0
   0  24  24 124 198 194 192 124   6 134 198 124  24  24
   0   0   0   0   0 194 198  12  24  48 102 198   0   0
   0   0   0  56 108 108  56 118 220 204 204 118   0   0
   0   0  48  48  48  96   0   0   0   0   0   0   0   0
   0   0   0  12  24  48  48  48  48  48  24  12   0   0
   0   0   0  48  24  12  12  12  12  12  24  48   0   0
   0   0   0   0   0 102  60 255  60 102   0   0   0   0
   0   0   0   0   0  24  24 126  24  24   0   0   0   0
   0   0   0   0   0   0   0   0   0  24  24  24  48   0
   0   0   0   0   0   0   0 254   0   0   0   0   0   0
   0   0   0   0   0   0   0   0   0   0  24  24   0   0
   0   0   0   2   6  12  24  48  96 192 128   0   0   0
   0   0   0 124 198 206 222 246 230 198 198 124   0   0
   0   0   0  24  56 120  24  24  24  24  24 126   0   0
   0   0   0 124 198   6  12  24  48  96 198 254   0   0
   0   0   0 124 198   6   6  60   6   6 198 124   0   0
   0   0   0  12  28  60 108 204 254  12  12  30   0   0
   0   0   0 254 192 192 252  14   6   6 198 124   0   0
   0   0   0  56  96 192 192 252 198 198 198 124   0   0
   0   0   0 254 198   6  12  24  48  48  48  48   0   0
   0   0   0 124 198 198 198 124 198 198 198 124   0   0
   0   0   0 124 198 198 198 126   6   6  12 120   0   0
   0   0   0   0  24  24   0   0   0  24  24   0   0   0
   0   0   0   0  24  24   0   0   0  24  24  48   0   0
   0   0   0   6  12  24  48  96  48  24  12   6   0   0
   0   0   0   0   0   0 254   0   0 254   0   0   0   0
   0   0   0  96  48  24  12   6  12  24  48  96   0   0
   0   0   0 124 198 198  12  24  24   0  24  24   0   0
   0   0   0 124 198 198 222 222 222 220 192 124   0   0
   0   0   0  16  56 108 198 198 254 198 198 198   0   0
   0   0   0 252 102 102 102 124 102 102 102 252   0   0
   0   0   0  60 102 194 192 192 192 194 102  60   0   0
   0   0   0 248 108 102 102 102 102 102 108 248   0   0
   0   0   0 254 102  98 104 120 104  98 102 254   0   0
   0   0   0 254 102  98 104 120 104  96  96 240   0   0
   0   0   0  60 102 194 192 192 222 198 102  58   0   0
   0   0   0 198 198 198 198 254 198 198 198 198   0   0
   0   0   0  60  24  24  24  24  24  24  24  60   0   0
   0   0   0  30  12  12  12  12  12 204 204 120   0   0
   0   0   0 230 102 108 108 120 108 108 102 230   0   0
   0   0   0 240  96  96  96  96  96  98 102 254   0   0
   0   0   0 198 238 254 254 214 198 198 198 198   0   0
   0   0   0 198 230 246 254 222 206 198 198 198   0   0
   0   0   0  56 108 198 198 198 198 198 108  56   0   0
   0   0   0 252 102 102 102 124  96  96  96 240   0   0
   0   0   0 124 198 198 198 198 214 222 124  12   0   0
   0   0   0 252 102 102 102 124 108 102 102 230   0   0
   0   0   0 124 198 198  96  56  12 198 198 124   0   0
   0   0   0 126 126  90  24  24  24  24  24  60   0   0
   0   0   0 198 198 198 198 198 198 198 198 124   0   0
   0   0   0 198 198 198 198 198 198 108  56  16   0   0
   0   0   0 198 198 198 198 214 214 254 124 108   0   0
   0   0   0 198 198 108  56  56  56 108 198 198   0   0
   0   0   0 102 102 102 102  60  24  24  24  60   0   0
   0   0   0 254 198 140  24  48  96 194 198 254   0   0
   0   0   0  60  48  48  48  48  48  48  48  60   0   0
   0   0   0 128 192 224 112  56  28  14   6   2   0   0
   0   0   0  60  12  12  12  12  12  12  12  60   0   0
   0  16  56 108 198   0   0   0   0   0   0   0   0   0
   0   0   0   0   0   0   0   0   0   0   0   0   0 255
   0  48  48  24   0   0   0   0   0   0   0   0   0   0
   0   0   0   0   0   0 120  12 124 204 204 118   0   0
   0   0   0 224  96  96 120 108 102 102 102 220   0   0
   0   0   0   0   0   0 124 198 192 192 198 124   0   0
   0   0   0  28  12  12  60 108 204 204 204 118   0   0
   0   0   0   0   0   0 124 198 254 192 198 124   0   0
   0   0   0  56 108 100  96 240  96  96  96 240   0   0
   0   0   0   0   0   0 118 204 204 204 124  12 204 120
   0   0   0 224  96  96 108 118 102 102 102 230   0   0
   0   0   0  24  24   0  56  24  24  24  24  60   0   0
   0   0   0   6   6   0  14   6   6   6   6 102 102  60
   0   0   0 224  96  96 102 108 120 108 102 230   0   0
   0   0   0  56  24  24  24  24  24  24  24  60   0   0
   0   0   0   0   0   0 236 254 214 214 214 214   0   0
   0   0   0   0   0   0 220 102 102 102 102 102   0   0
   0   0   0   0   0   0 124 198 198 198 198 124   0   0
   0   0   0   0   0   0 220 102 102 102 124  96  96 240
   0   0   0   0   0   0 118 204 204 204 124  12  12  30
   0   0   0   0   0   0 220 118  98  96  96 240   0   0
   0   0   0   0   0   0 124 198 112  28 198 124   0   0
   0   0   0  16  48  48 252  48  48  48  54  28   0   0
   0   0   0   0   0   0 204 204 204 204 204 118   0   0
   0   0   0   0   0   0 102 102 102 102  60  24   0   0
   0   0   0   0   0   0 198 198 214 214 254 108   0   0
   0   0   0   0   0   0 198 108  56  56 108 198   0   0
   0   0   0   0   0   0 198 198 198 198 126   6  12 248
   0   0   0   0   0   0 254 204  24  48 102 254   0   0
   0   0   0   0   0   0   0   0   0   0   0   0   0   0
'--------   END OF FILE ------------------------------------------
$ENDIF

    ------------------




    [This message has been edited by Hanns Ackermann (edited April 01, 2000).]

    Leave a comment:

  • Hanns Ackermann
    replied
    Fred,

    years ago I wrote a program displaying text double-width,
    double-high and shaddowed in graphic mode (screen 12 etc.),
    however, it doesn't work for screen 0. (If I remember well, I
    used some code from PB-Xtra and a textbook by Tischer.) If you
    are (or someone else is!) interested in this, please let me know.
    I think it should be no problem to find the code in a desert
    corner of my HD.

    Hanns.


    ------------------

    Leave a comment:

  • Lance Edmonds
    replied
    What about 40 character wide mode?
    Code:
    SCREEN 0
WIDTH 40
PRINT "Hello PB/DOS at 40 characters!"

    ------------------
    Lance
    PowerBASIC Support
    mailto:[email protected][email protected]</A>

    Leave a comment:

  • Matthew Berg
    replied
    In what screen/video mode(s)?

    Leave a comment:

  • Shawn Tartaglia
    Guest replied
    I don't know if this will be possible. (I am not trying to speak for PB) The printer when printing Double Wide is set to graphics mode. There is no way of setting a section of a DOS screen to graphics mode. Either the whole screen is graphic or not. You can use the extended ASCII chr set to make large chars but these would be quite big to be readable.


    Another way I can think of to get this functionality is to draw with line statements the letters. You could then make a routine that when passed the Row,Col and Letter it would draw the letter.

    And yet another, you could redefine what the ASCII char are in video memory. Then taking a piece of each one draw the char. There are used to be several DOS based programs that you could load and replace the ASCII chr map. I may have one or two on an old backup if you would like to email me I will check.

    mailto[email protected][email protected]</A>

    ------------------


    [This message has been edited by Shawn Tartaglia (edited March 27, 2000).]

    Leave a comment:

  • Fred Katzel
    started a topic Double size letters on screen

    Double size letters on screen

    A few months ago I submitted a request for a program that would print large size letter on the screen or printer. While I produced a fairly good program to produce large letters for my printer, when it came to the screen they were all too big, 8 times the normal type. I am looking for something that would produce about twice the high and width on the screen. I wander if PowerBASIC could come up with a command that would accomplish this, such as:
    PRINT DOUBLE "This line is Double High & Wide"
    where: the command DOUBLE would accomplish the double high and wide screen presentation.

    I can accomplish this on my printer by using printer commands. I would like to see PowerBASIC come up with something equaled.
    Tags: None
Previous template Next
Working...
X

We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.

By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.

I Agree