SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00005 CHARACTER HANDLING 1 05-28-9313:33ALL SWAG SUPPORT TEAM Manipulating the VGA FontIMPORT 18 {πDAVID DRZYZGAππ> Is there any way to create or use your own fonts inπ> regular Text mode With Pascal?ππHere's a demo of a routine originally posted by Bernie P and revised by me:π}ππProgram UpsideDown;π{-upsidedown and backwards Text aka redefining the Text mode font}πVarπ newCharset,π oldCharset : Array[0..255,1..16] of Byte;ππProcedure getoldCharset;πVarπ b : Byte;π w : Word;πbeginπ For b := 0 to 255 doπ beginπ w := b * 32;π Inline($FA);π PortW[$3C4] := $0402;π PortW[$3C4] := $0704;π PortW[$3CE] := $0204;π PortW[$3CE] := $0005;π PortW[$3CE] := $0006;π Move(Ptr($A000, w)^, oldCharset[b, 1], 16);π PortW[$3C4] := $0302;π PortW[$3C4] := $0304;π PortW[$3CE] := $0004;π PortW[$3CE] := $1005;π PortW[$3CE] := $0E06;π Inline($FB);π end;πend;ππProcedure restoreoldCharset;πVarπ b : Byte;π w : Word;πbeginπ For b := 0 to 255 doπ beginπ w := b * 32;π Inline($FA);π PortW[$3C4] := $0402;π PortW[$3C4] := $0704;π PortW[$3CE] := $0204;π PortW[$3CE] := $0005;π PortW[$3CE] := $0006;π Move(oldCharset[b, 1], Ptr($A000, w)^, 16);π PortW[$3C4] := $0302;π PortW[$3C4] := $0304;π PortW[$3CE] := $0004;π PortW[$3CE] := $1005;π PortW[$3CE] := $0E06;π Inline($FB);π end;πend;ππProcedure setasciiChar(Charnum : Byte; Var data);πVarπ offset : Word;πbeginπ offset := CharNum * 32;π Inline($FA);π PortW[$3C4] := $0402;π PortW[$3C4] := $0704;π PortW[$3CE] := $0204;π PortW[$3CE] := $0005;π PortW[$3CE] := $0006;π Move(data, Ptr($A000, offset)^, 16);π PortW[$3C4] := $0302;π PortW[$3C4] := $0304;π PortW[$3CE] := $0004;π PortW[$3CE] := $1005;π PortW[$3CE] := $0E06;π Inline($FB);πend;ππProcedure newWriteln(s : String);π {- Reverses order of Characters written}πVarπ b : Byte;πbeginπ For b := length(s) downto 1 doπ Write(s[b]);π Writeln;πend;ππVarπ b, c : Byte;ππbeginπ getoldCharset;π For b := 0 to 255 doπ For c := 1 to 16 doπ newCharset[b, c] := oldCharset[b, (17 - c)];π For b := 0 to 255 doπ setasciiChar(b, newCharset[b, 1]);π newWriteln('Hello World!');π readln;π restoreoldCharset;πend.π 2 05-28-9313:33ALL SWAG SUPPORT TEAM Character Case IMPORT 23 {πBO BendTSENππ Upper/lower changing of Strings are always a difficult problem,π but as a person living in Denmark i must normally care aboutπ danish Characters, i know a lot of developers does not care aboutπ international Character and just use the normal UPCASE routines.π I advise you to use these routines or make some that has theπ same effect, so we will not have any problems when searching forπ uppercased Strings.ππ Made available to everyone 1993 by Bo Bendtsen 2:231/111 +4542643827ππ Lowcase Upper/high/capital lettersπ Æπ ¢ ¥π å Åπ ä Äπ ç Çπ é Éπ ö Öπ ñ Ñπ ü Üππ}ππFunction UpChar(Ch : Char) : Char;π{ Uppercase a Char }πbeginπ If Ord(Ch) In [97..122] Then Ch := Chr(Ord(Ch) - 32)π Else If Ord(Ch) > 90 Thenπ If Ch='' Then Ch:='Æ'π Else If Ch='¢' Then Ch:='¥' Else If Ch='å' Then Ch:='Å'π Else If Ch='ä' Then Ch:='Ä' Else If Ch='ç' Then Ch:='Ç'π Else If Ch='é' Then Ch:='É' Else If Ch='ö' Then Ch:='Ö'π Else If Ch='ñ' Then Ch:='Ñ' Else If Ch='ü' Then Ch:='Ü';π UpChar:=Ch;πend;ππFunction StUpCase(S : String) : String;π{ Uppercase a String }πVarπ SLen : Byte Absolute S;π x : Integer;πbeginπ For x := 1 To SLen Do S[x]:=UpChar(S[x]);π StUpCase := S;πend;ππFunction LowChar(Ch : Char) : Char;π{ lowercase a Char }πbeginπ If Ord(Ch) In [65..90] Then Ch := Chr(Ord(Ch) + 32)π Else If Ord(Ch) > 122 Thenπ If Ch='Æ' Then Ch := ' 'π Else If Ch='¥' Then Ch:='¢' Else If Ch='Å' Then Ch:='å'π Else If Ch='Ä' Then Ch:='ä' Else If Ch='Ç' Then Ch:='ç'π Else If Ch='É' Then Ch:='é' Else If Ch='Ö' Then Ch:='ö'π Else If Ch='Ñ' Then Ch:='ñ' Else If Ch='Ü' Then Ch:='ü';π LowChar := Ch;πend;ππFunction StLowCase(S : String) : String;π{ Lowercase a String }πVarπ SLen : Byte Absolute S;π i : Integer;πbeginπ For i := 1 To SLen Do S[i]:=LowChar(S[i]);π StLowCase := S;πend;ππFunction StToggleCase(S : String) : String;π{ lower = upper and upper = lower }πVarπ SLen : Byte Absolute S;π i : Integer;πbeginπ For i := 1 To SLen Doπ beginπ If Ord(S[i]) In [65..90] Then S[i] := Chr(Ord(S[i]) + 32)π Else If Ord(S[i]) In [97..122] Then S[i] := Chr(Ord(S[i]) - 32)π Else If Pos(S[i],'¢åäçéöñü') <> 0 Then S[i]:=UpChar(S[i])π Else If Pos(S[i],'ÆÅ¥ÇÄÖÉÜÑ')<> 0 Then S[i]:=LowChar(S[i]);π end;π StToggleCase := S;πend;ππFunction StSmartCase(S : String) : String;π{ bO bEnDTSen will be converted into : Bo Bendtsen }πVarπ SLen : Byte Absolute S;π i : Integer;πbeginπ s:=StLowCase(s);π For i := 1 To SLen Doπ beginπ If i=1 Then S[1]:=UpChar(S[1])π Else if S[i-1]=' ' Then S[i]:=UpChar(S[i])π Else if (Ord(S[i-1]) In [32..64]) And (S[i-1]<>'''') ThenπS[i]:=UpChar(S[i]);π end;π StSmartCase := S;πend;π 3 05-28-9313:33ALL SWAG SUPPORT TEAM Switch Font Characters IMPORT 27 {π> How can I redefine the ASCII Chars. For example how canπ> I make the ASCII code 65 become a "weird form" insteadπ> of an "A".ππYou want it, you got it. Here are the two Procedures you need, plus someπinfo. First, you need to make a data Type With an Array of [1..16] of Byte,πso the best idea would be this: Make a Record as follows:π}ππTypeπ CharRec = Recordπ data : Array[1..16] of Byte;π end;ππ{ Now, make a Variable to contain the entire Character set. }ππVarπ CharSet : Array[0..255] of CharRec;ππ{ Next, you'll need the two Procedures: }ππProcedure GetImageChar(chrVal : Byte; Var CharInfo);πVarπ offset : Word;πbeginπ offset := chrVal * 32;π Inline($FA);π PortW[$3C4] := $0402;π PortW[$3C4] := $0704;π PortW[$3CE] := $0204;π PortW[$3CE] := $0005;π PortW[$3CE] := $0006;π (* refer to following notes For info about the next line *)π Move(Ptr($A000, offset)^, CharInfo, 16);π PortW[$3C4] := $0302;π PortW[$3C4] := $0304;π PortW[$3CE] := $0004;π PortW[$3CE] := $1005;π PortW[$3CE] := $0E06;π Inline($FB);πend;ππ{πOK. That's the Procedure to GET a Character bitmap, and store it in aπVariable. So, if you use the Type and Var I defined at the top, do this:ππGetImageChar(65, CharSet[65]);ππThis example will copy the bitmap from Character 65 (A) into the Record of 65,πso you'll have copied the bitmap For 'A'. Now, you can edit the bitmap (Iπwrote my own font editor) and Write it to memory With a second Procedure.ππHere's the tricky part. I didn't Write the 2nd Procedure because it isπidentical to the first *EXCEPT* For ONE line. Copy the Procedure and changeπit's name to SetImageChar, and change this line:ππMove(Ptr($A000, offset)^, CharInfo, 16);ππand make it read:ππMove(CharInfo, Ptr($A000, offset)^, 16);ππThat's it! Have fun! TTYL.π}ππ{πOK, 'data' is an Array [1..16] of Byte. So, you just draw your Character onπGraph paper in binary, convert to decimal Bytes, put them in the Array, andπfeed it into this Procedure. 'CharNum' is the ASCII value of the Character youπwant to remap. To make a Procedure that READS the bitmap instead of writing,πjust change the line With 'Move(data, Ptr($A000, offset)^, 16)' and make it sayπ'Move(Ptr($A000, offset)^, data, 16);' and you will now be able to read bitmapsπfrom the Character set. I'm running out of time, so I can't explain it veryπwell, but I hope this helps. TTYL.π}π{ππ I ran that in a loop and after a While it screwed up the wholeπ font - might just be my EGA card, but my opinion is that thisπ method stinks...there are Registers For getting/setting theπ font; I found code from a Program called Display Font Editorπ (DFE). DFE edits font Files, and it came With source toπ load these font Files. Following is a bit from settingπ the Registers to load a font (don't have getting a font)ππ r.ax := $1110;π r.bh := 14; (* Bytes per Character *)π r.bl := 0; (* load to block 0 *)π r.cx := 256; (* 256 Characters *)π r.dx := 0; (* start With Character 0 *)π r.es := Seg(P^); (* segment of table *)π r.bp := Ofs(P^); (* offset of the table *)π intr($10, r);ππ With this, you can see, you can even do one Character at aπ time ( cx = 1, dx = ascii, P^ = Array[1..14] of Byte)π} 4 05-28-9313:33ALL SWAG SUPPORT TEAM Read Screen CHARS IMPORT 5 {πAuthor: A A OlowofoyekuππAs For reading the ASCII stuff from the screen, I have a routine thatπallows you to read a Character from any location on the screen.π}ππUsesπ Dos;ππ{-- read the Character at the cursor and return it as a Char --}πFunction ScreenChar : Char;πVarπ R : Registers;πbeginπ FillChar(R, SizeOf(R), 0);π R.AH := 8;π R.BH := 0;π Intr($10, R);π ScreenChar := Chr(R.AL);πend;π 5 05-28-9313:33ALL SWAG SUPPORT TEAM Redefine FONT Chars IMPORT 22 {π>> I know this can be done - in fact I've seen posts on it before, but itπ>> didn't strike me as something to save at the time. . .π> Does anyone know how to redefine the Characters used in Text mode? Iπ>> don't want to use a whole new set; rather I'd like to change just about aπ>> dozen or so Characters to my own.ππThis is a little routine I developed sometime ago to redefine some of theπascii Chars as 'smileys'. The Arrays of hex values are Characterπbitmaps. There is a rather good article about doing this sort of thing in PCπMagazine,Volume 9 number 2 (Jan 30, 1990)π}ππProgram Redefine;ππUsesπ Dos,Crt;ππProcedure loadChar;πConstπ numnewChars = 6;πTypeπ ByteArray = Array[0..15] of Byte;π CharArray = Array[1..numnewChars] of Recordπ CharNum : Byte;π CharData : ByteArray;π end;ππConst newChars : CharArray = (π (CharNum : 21;π CharData : ($00,$00,$E7,$A5,$E7,$00,$00,$08,$18,$38,$00,$00,$C3,$C3,$7E,$00)),π (Charnum : 4;π CharData : ($00,$00,$E7,$A5,$E7,$00,$00,$08,$18,$38,$00,$00,$7E,$C3,$C3,$00)),π (Charnum : 19;π CharData : ($AA,$AA,$FE,$00,$EE,$AA,$EE,$00,$08,$18,$38,$00,$C6,$C6,$7C,$00)),π (Charnum : 17;π CharData : ($03,$07,$FF,$00,$0E,$0A,$0E,$00,$00,$01,$03,$00,$08,$07,$00,$00)),π (Charnum : 23;π CharData : ($C0,$E0,$FF,$00,$E0,$A0,$E0,$00,$80,$80,$80,$10,$10,$E0,$00,$00)),π (Charnum : 24;π CharData : ($E7,$42,$00,$C3,$A5,$E7,$00,$08,$18,$38,$00,$00,$7E,$FF,$81,$00))π );ππVarπ r : Registers;π i : Byte;ππbeginπfor i := 1 to numnewChars doπ With r doπ beginπ ah := $11; { video sub-Function $11 }π al := $0; { Load Chars to table }π bh := $10; { number of Bytes per Char }π bl := 0; { Character table to edit }π cx := 1; { number of Chars we're definig }π dx := NewChars[i].CharNum; { ascii value of the Char }π es := seg(NewChars[i].CharData); { es:bp --> table we're loading }π bp := ofs(NewChars[i].CharData);π intr($10,r);π end;πend;ππbeginπ loadChar;π Writeln('Char(21) is now ',chr(21));Writeln;π Writeln('Char(04) is now ',chr(04));Writeln;π Writeln('Char(19) is now ',chr(19));Writeln;π Writeln('Char(17) is now ',chr(17));Writeln;π Writeln('Char(23) is now ',chr(23));Writeln;π Writeln('Char(24) is now ',chr(24));Writeln;π readln;π Textmode(co80);π Writeln('Char(21) is now ',chr(21));Writeln;π Writeln('Char(04) is now ',chr(04));Writeln;π Writeln('Char(19) is now ',chr(19));Writeln;π Writeln('Char(17) is now ',chr(17));Writeln;π Writeln('Char(23) is now ',chr(23));Writeln;π Writeln('Char(24) is now ',chr(24));Writeln;πend.π
