What is this?

 BBS: Inland Empire Archive
Date: 07-20-92 (13:33)             Number: 99
From: GARY POOL                    Refer#: NONE
  To: LONNIE VONHOLDT               Recvd: NO  
Subj: What is this?                  Conf: (2) Quik_Bas

LV>as a user defined character editor? Not like the Draw (good program, not
LV>what I'm after) or any ideas how to come up with one without re-writing
LV>the bios? I'll be waiting for response from that with worms on my
LV>tounge! (IE---Baited Breath) Talk to ya later, I'm outta here for now!


Will this do the trick?  I don't remember for the life of me who came up
with this.  It was in PC Magazine, if I remeber correctly.  Actually,
this is more fonts than a character editor, but perhaps it will give you
some ideas.

- - - - - - 8< - C U T - H E R E - 8< - - - - - - --

DEFINT A-Z
DECLARE SUB SideWrite (Mot$, PosX, PosY, Couleur, Opt)  'this is for QB4 only

SCREEN 1                                            '320 x 200 x 4 graphics
DIM Temp(13)                                        'holds upper left corner
GET (0, 0)-(8, 7), Temp                             'save upper left corner

'SCREEN 9                                           '640 x 350 x 16 graphics
'DIM Temp(57)
'GET (0, 0)-(8, 13), Temp

CALL SideWrite("Side Writing", 0, 120, 1, 1)              '90ø up
CALL SideWrite("Italic Side Writing", 20, 160, 2, 2)      '90ø italic
CALL SideWrite("Vertical Writing", 40, 10, 3, 3)          '0ø down
CALL SideWrite("Side Writing", 55, 10, 1, 4)              '270ø down
CALL SideWrite("Italic Side Writing", 73, 10, 2, 5)       '270ø down italic
CALL SideWrite("Big Side Writing", 90, 190, 3, 6)         'big 90ø up
CALL SideWrite("Big Italic Side Writing", 115, 190, 1, 7) 'big 90ø up italic
CALL SideWrite("Big Vertical Writing", 145, 10, 2, 8)     'big 0ø down
CALL SideWrite("Normal", 10, 0, 3, 9)                     '0ø
CALL SideWrite("Normal Italic", 70, 0, 1, 10)             '0ø right italic
CALL SideWrite("Big ", 180, 0, 2, 11)                     'big 0ø right
CALL SideWrite("Big Italic", 220, 0, 3, 12)               'big 0ø right italic
CALL SideWrite("All This DEMO", 180, 50, 1, 10)
CALL SideWrite("was done", 195, 60, 2, 9)
CALL SideWrite("--> with <--", 180, 76, 3, 11)
CALL SideWrite("SideWrit.Bas!!", 180, 100, 1, 12)
CALL SideWrite("______________", 180, 102, 1, 12)

PUT (0, 0), Temp, PSET                              'restore upper left corner

SUB SideWrite (Mot$, PosX, PosY, Couleur, Opt) STATIC
FOR Nombre = 1 TO LEN(Mot$)
    LOCATE 1, 1
    PRINT MID$(Mot$, Nombre, 1)        'print word's letters one by one
    FOR X = 0 TO 7
      FOR Y = 0 TO 7                   'use 0 TO 13 for EGA
        IF POINT(X, Y) THEN            'read pixel on/off for sideways copy
           IF Opt = 1 THEN
              PSET (Y + PosX, 8 - X + PosY - (8 * Nombre)), Couleur
           ELSEIF Opt = 2 THEN
              PSET (Y + PosX, 8 - X + PosY - (8 * Nombre) + Y), Couleur
           ELSEIF Opt = 3 THEN
              PSET (X + PosX, PosY + (8 * Nombre) + Y), Couleur
           ELSEIF Opt = 4 THEN
              PSET (8 - Y + PosX, PosY + (8 * Nombre) + X), Couleur
           ELSEIF Opt = 5 THEN
              PSET (8 - Y + PosX, PosY + (8 * Nombre) + X - Y), Couleur
           ELSEIF Opt = 6 THEN
              PSET (Y + PosX + Y, 8 - X + PosY - (8 * Nombre)), Couleur
              PSET (1 + Y + PosX + Y, 8 - X + PosY - (8 * Nombre)), Couleur
           ELSEIF Opt = 7 THEN
              PSET (Y + PosX + Y, 8 - X + PosY - (8 * Nombre) + Y), Couleur
              PSET (1 + Y + PosX + Y, 8 - X + PosY - (8 *
Nombre) + Y), Couleur
           ELSEIF Opt = 8 THEN
              PSET (X + PosX + X, PosY + (8 * Nombre) + Y), Couleur
              PSET (1 + X + PosX + X, PosY + (8 * Nombre) + Y), Couleur
           ELSEIF Opt = 9 THEN
              PSET (X + PosX + (Nombre * 8), PosY + Y), Couleur
           ELSEIF Opt = 10 THEN
              PSET (X + PosX + (Nombre * 8) - Y, PosY + Y), Couleur
           ELSEIF Opt = 11 THEN
              PSET (X + PosX + (Nombre * 8), PosY + Y + Y), Couleur
              PSET (X + PosX + (Nombre * 8), 1 + PosY + Y + Y), Couleur
           ELSEIF Opt = 12 THEN
              PSET (X + PosX + (Nombre * 8) - Y, PosY + Y + Y), Couleur
              PSET (X + PosX + (Nombre * 8) - Y, 1 + PosY + Y + Y), Couleur
           END IF
        END IF
      NEXT Y
    NEXT X
NEXT Nombre
END SUB
---
 þ SLMR 2.1 þ Insist on integrity . . . sometimes.


--- WM v2.00/91-0231
 * Origin: The Modem Zone BBS (314) 893-5106 (1:289/2)