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)
Outer Court
Echo Basic Postings

Books at Amazon:

Back to BASIC: The History, Corruption, and Future of the Language

Hackers: Heroes of the Computer Revolution (including Tiny BASIC)

Go to: The Story of the Math Majors, Bridge Players, Engineers, Chess Wizards, Scientists and Iconoclasts who were the Hero Programmers of the Software Revolution

The Advent of the Algorithm: The Idea that Rules the World

Moths in the Machine: The Power and Perils of Programming

Mastering Visual Basic .NET