SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00021 TEXT/GRAPHICS COLORS 1 05-28-9313:34ALL SWAG SUPPORT TEAM Change Background Colors IMPORT 6 ^╫┌Ñ {π>Hello, I am writing an application that is some what colorπ>coordinated. I would like to have the background changed (usuallyπ>black) to one of the background colors without affecting theπ>foreground (so I do not have to reWrite the foreground screen). Soπ}ππUsesπ Dos;ππProcedure ChangeBG(Color : Byte);πVar i : Word;πbeginπ For i := 0 to 3999 doπ If Odd(i) thenπ Mem[$b800:i] := (Mem[$b800:i] and 15) or ((Color and 7) shl 4)πend;ππVarπ ColChar : String;πbeginπ ColChar := ParamStr(1);π ChangeBg(Ord(ColChar[1]));πend. 2 05-28-9313:34ALL MICHAEL NICOLAI Colors Bits IMPORT 21 ^╫ö▐ {πMICHAEL NICOLAIππ> I need to extract the foreground color (black) and the background colorπ> (cyan) and insert them into vars for another procedure, that calls aπ> picklist with Fg,Bg attributes. I can't change the way the procedure/π> function works, so I need to feed it =my= colors in =its= format.π>ππDo you know the format of the attribute-byte? If not, here it is:ππ Bit 7 6 5 4 3 2 1 0π B b b b I f f fππB - 0 do not blinkπ 1 character is blinkingππbbb - backgroundcolor (3 Bit, giving you a total of 8 different values.)ππI - 0 foregroundcolor is not intensifiedπ 1 foregroundcolor is intensifiedππfff - foregroundcolor (3 Bit + I, giving you a total of 16 different values.)πππIf you now want to extract the fore- or backgroundcolor you can easily doπthat by performing an AND with either 70h, 0Fh or 07h.ππThe operator AND (if you don't know it):ππ AND a b | x a & b = x (or in Pascal: x := a and b;π ---------π 0 0 | 0π 0 1 | 0π 1 0 | 0π 1 1 | 1ππAs you see, only when b is set to 1, the value in a is "getting through".ππFor example: a = 1011000111010111, b = 0001011011110110πthenππ 1011000111010111π & 0001011011110110π --------------------π 0001000011010110ππWhen you look at it for a while you will see that, only where there is a 1πin the lower number, the value in the upper number is represented in theπresult. Hence, you can use the AND operator to mask a portion of a number.ππNow, let's get back to your colors: You mentioned 48 or NORM.π48 decimal equals to 00110000b. That is 'Not Blink', 'Color 3 forπBackground', 'Color 0 for Foreground' and 'Foregroundcolor not intensified'.ππWhat do you get, if you perform NORM & 70h? Let's see:ππ NORM 00110000π & 70h 01110000π ---------------------π 00110000 (= Backgroundcolor or Bg)ππNot much you think, hm? Ok, but that has to do with the initial number NORM.πYou will see "the light" as we proceed. :-)ππNow, let us perform NORM & 0Fh:ππ NORM 00110000π & 0Fh 00001111π ---------------------π 00000000 (= Foregroundcolor WITH I)ππand NORM & 07h:ππ NORM 00110000π & 07h 00000111π ---------------------π 00000000 (= Foregroundcolor WITHOUT I)πππHm, somewhat NORM was a bad choice as an example. But if you try it withπother values you will see how easy it is to "get a few bits out of a byte"!π}ππ 3 05-28-9313:34ALL SWAG SUPPORT TEAM Detect Display Type IMPORT 3 ^╫M─ {π> know a good, easy way to detect mono/color?π}ππProgram CheckDisplay;πVarπ Display: Byte Absolute $40:$10;ππbeginπ if ((Display and $30) = $30) thenπ Writeln('Monochrome display')π ELSEπ Writeln('Color display');πend.π 4 05-28-9313:34ALL SWAG SUPPORT TEAM DOS Colors IMPORT 9 ^╫aU {π> I want to be able to read a users Text Attrib and store them so i canπ> restore them when my Program ends. How can I do this?ππIt seems strange you would only want to save Text attribute andπnot the Dos screen, but that is what you ask -- as I understand it.ππYou need to read the attribute of Character at or one columnπbeFore the current cursor position, directly from the screen. Somethingπlike this should do:π}ππUsesπ Crt;ππFunction UserAttr: Byte;πVar VSeg: Word;πbeginπ if LastMode = 7 thenπ VSeg := $B000 { Monochrome }π elseπ VSeg := $B800; { Color }π if (WhereX = 1) and (WhereY = 1) thenπ UserAttr := Hi(MemW[VSeg:0])π elseπ UserAttr := Hi(MemW[VSeg:(WhereX -1) + (MemW[$40:$4A] * (WhereY -1)) -2]);πend;ππ(*πBeFore returning to Dos, Write one space With given attribute andπbackspace over it (this will cause Dos to continue in the same color):ππTextAttr := OldAttr; { OldAttr initialized at Program startup }πWrite(#20#8);π*)ππ 5 05-28-9313:34ALL SWAG SUPPORT TEAM Get Palette IMPORT 9 ^╫a {π> Is it Possible to find out what the colors are that areπ> currently being used? I don't know how else to phrase it, Iπ> know you can find out the Values of the Various pixels onπ> the screen. But how can I find out the Various red, greenπ> and blue Values that correspond to the specific color?ππ}ππProcedure ReadPalette(Start,Finish:Byte;P:Pointer);πVarπ I,π NumColors : Word;π InByte : Byte;πbeginπ P := Ptr (Seg(P^),Ofs(P^)+Start*3);π NumColors := (Finish - Start + 1) * 3;ππ Port [$03C7] := Start;ππ For I := 0 to NumColors do beginπ InByte := Port [$03C9];π Mem [Seg(P^):Ofs(P^)+I] := InByte;π end;ππend;ππ{π> But, how do I find out exactly what color #200 is? It mustπ> be held in memory some place. Can anyone supply a Procedure,π> Function or some insight into this?ππ You would just supply the Start as 200, finish as 200, and Ptr P wouldπpoint to your data... You could easily Change this routine to Supply only oneπcolor as Variables if needed.... Hope this helped..π} 6 05-28-9313:34ALL SWAG SUPPORT TEAM Get VGA Palette IMPORT 11 ^╫0 {π>A VGA's screen values can be found by defining something like:ππ> VGAScreen : Array[1..64000] of Byte Absolute $A000:0000ππ>But, how do I find out exactly what color #200 is? It must be held in memoryπ>some place. Can anyone supply a Procedure, Function or someππI've written this short Program quite a While ago For some testing,πit should compile and work ok. Just note that it Uses slow BIOSπFunction, it's not a good choice For fast palette animations butπotherwise works fine.π}ππProgram Palette256;πUses Dos;ππTypeπ VGAColour = Recordπ RByte, GByte, BByte : Byte;π end;ππ VGAPal = Array[0..$FF] of VGAColour;ππVarπ Palette : VGAPal;π i : Byte;ππProcedure GetVGAPal(Var Pal : VGAPal);πVarπ CPUregs : Registers;πbeginπwith CPUregs doπ beginπ ax:=$1017;π bx:=$00;π cx:=$100;π es:=Seg(Pal);π dx:=Ofs(Pal);π end;π Intr($10,CPUregs);πend; {GetVGAPal}ππProcedure SVMode(vmod : Byte);πVarπ CPUregs : Registers;πbeginπCPUregs.ah:=0;πCPUregs.al:=vmod;πIntr($10,CPUregs);πend; {SVMode}ππbeginπSVMode($13);πGetVGAPal(Palette);πSVMode($02);πfor i:=0 to $FF doπ Writeln('Entry ',i:3,' Red : ',Palette[i].RByte:3,' Green : ',π Palette[i].GByte:3,' Blue : ',Palette[i].BByte:3);πend.π 7 05-28-9313:34ALL SWAG SUPPORT TEAM Hi Intensity Colors IMPORT 8 ^╫σÑ Program HiBack; {Demonstrate use of "High-Intensity" bgd colors}ππUses Crt, Dos;ππVarπ Fgd,Bgd : Integer;π Regs : Registers;ππProcedure EnableHighBgd;πbeginπ Regs.ax:=$1003;π Regs.bx:=0;π Intr($10,Regs);πend; {Procedure EnableHighBgd}ππProcedure DisableHighBgd;πbeginπ Regs.ax:=$1003;π Regs.bx:=1;π Intr($10,Regs);πend; {Procedure DisableHighBgd}ππProcedure ShowAllCombos;πbeginπ TextMode(CO80);π For Fgd := 0 to 15 DOπ beginπ TextColor(Fgd);π For Bgd := 0 to 15 DOπ beginπ TextAttr := Fgd + (16 * Bgd);π Write(' Hi ');π end;π Writeln;π end;π TextAttr := 15;πend; {Procedure ShowAllCombos}ππbeginπ ShowAllCombos;π Writeln; Write('Press return...'); Readln;π EnableHighBgd;π Writeln; Write('Press it again...'); Readln;π DisableHighBgd;π Writeln; Write('One last time...'); Readln;πend.π 8 05-28-9313:34ALL SWAG SUPPORT TEAM Hi Intensity Colors #2 IMPORT 5 ^╫òö {π> I have seen a lot of applications that use highintensity backgroundπ> colors in Text mode. How do they do it??????π}ππUses Crt ;ππProcedure DisableHiBackGround(SetHi : Boolean); Assembler;πAsmπ Mov AX, $1003π Mov BL, SetHiπ Int $10πend ;ππbeginπ ClrScr;π TextAttr := White + (LightRed ShL 4);π DisableHiBackGround(True) ;π Write('Blinking...[Enter]') ;π ReadLn ;π DisableHiBackGround(False) ;π Write(' WOW !!! ') ;π ReadLn ;πend.π 9 05-28-9313:34ALL ROBERT MASHLAN Hi Inetnsity Colors #3 IMPORT 16 ^╫╝∩ {πI have seen a lot of applications that use highintensity backgroundπcolors in Text mode. How do they do it??????π}ππProgram HighInt; { 91-5-30 Robert Mashlanπ Public Domainππ The following Program is an example of how to set the CrtC controllerπ in in order that high intensity backgrounds may be displayed insteadπ of blinking Characters, or use the the EGA/VGA BIOS to do the sameπ thing.π}ππUsesπ Dos, Crt;ππConstπ HighIntesity = Blink; (* high intesity attribute mask *)πππProcedure HighIntensity( state : Boolean );π(* enables or disables high intensity background colors *)ππConstπ BlinkBit = $20; (* For mode select port, bit 5 *)π ModeSelofs = 4; (* offset from CrtC port base *)ππVarπ R : Registers;π (* BIOS data area Variables *)π CrtMode : Byte Absolute $0040:$0065; (* current CrtC mode *)π CrtPortBase : Word Absolute $0040:$0063; (* CrtC port base addr *)ππ Function EgaBios : Boolean;π { test For the existance of EGA/VGA BIOS }π Var R : Registers;π beginπ With R do beginπ AH := $12;π BX := $ff10;π Intr($10,R);π EgaBios := BX <> $ff10;π end;π end;ππbeginπ if EgaBios then With R do begin (* use EGA/VGA BIOS Function *)π R.AX := $1003;π if state then BL := 0π else BL := 1;π Intr($10,R);π end else begin (* Program CGA/MDA/Herc CrtC controller *)π if state then CrtMode := CrtMode and not BlinkBitπ else CrtMode := CrtMode or BlinkBit;π Port[ CrtPortBase + ModeSelofs ] := CrtMode;π end;πend;πππbeginπ HighIntensity(True);π if LastMode = 7 thenπ TextAttr := $80 + $7Eπ elseπ Textattr := $80 + $6D;π ClrScr;π TextBackGround(green);π GotoXY(20,11);π Writeln('What do you think of this background?');π GotoXY(1,25);π Repeat Until ReadKey <> #0;π HighIntensity(False);π ClrScr;πend.π 10 05-28-9313:34ALL SWAG SUPPORT TEAM Hi Intensity Colors #4 IMPORT 7 ^╫ {π I have seen a lot of applications that use highintensityπ background colors in Text mode. How do they do it??????ππif you are using an EGA/VGA adapter then you can try :-π}ππProcedure SelectIntensity(Intense:Boolean);πVarπ R : Registers;ππbeginπ if Intense thenπ R.BL := 0π elseπ R.BL := 1;π R.AX := $1003;π Intr($10, R);πend;ππ{π TextBackGround wont do anything higher than 8 without blinking.π I want to be able to use colors like Black on Yellow andπ things like that. Anyone have any ideas???ππNow, if you call "SelectIntensity(True)" then you can use high intensityπbackground colours. to display, say White On Darkgray, you can useπ"White+Darkgray*16" as your Textattr.π} 11 05-28-9313:34ALL SWAG SUPPORT TEAM Hi Intensity Colors #5 IMPORT 5 ^╫z╪ {π> How would I implement the high intensity colors For the TextBACKGROUNDπ> Procedure in the Crt Unit?π}ππProcedure LightEGAVGA(TurnOn : Boolean);πVar Regs : Registers;πbeginπ Regs.AH := $10;π Regs.AL := $03;π Regs.BL := Byte(TurnOn);π Int($10,Regs);πend;ππProcedure LightHGC(TurnOn : Boolean);πbeginπ if TurnOn then Port[$3b8] := $29π else Port[$3b8] := $09;πend;ππProcedure LightCGA(TurnOn : Boolean);πbeginπ if TurnOn then Port[$3d8] := $29π else Port[$3d8] := $09;πend;ππ 12 05-28-9313:34ALL GEOFF WATTS Palette Control IMPORT 56 ^╫i╚ {π Hello, could somone tell me how to fade a screen out..π}ππ{ --------------------------------------------------------------------- }π{ Palette Unit (Text and Graphics modes) }π{ Author: Geoff Watts, 27-07-92 }π{ Usable Procedures: }π{ fadeup -- fade the palette up }π{ fadedown -- fade the palette down }π{ getpal256 -- fill the parameter Pal With the palette values }π{ setpal256 -- fill the palette values With the parameter Pal }π{ cpuType -- determines wether the cpu is 8086/88 or different }π{ --------------------------------------------------------------------- }ππUnit Palette;πInterfaceπUses Dos;π{ structure in which the palette inFormation is stored }πTypeπ PaletteType = Array[0..255,1..3] of Byte; { 256 Red/Green/Blue (RGB) }πVarπ OlPlt : PaletteType; { internal palette structure }π { which contains the standard }π { palette }π SetPal256: Procedure (Var Pal : PaletteType); { the Procedure determined }π { at run time }π{ Forward declarations }πProcedure SetPal86 (Var Pal : PaletteType);πProcedure SetPal286 (Var Pal : PaletteType);πProcedure FadeUp;πProcedure FadeDown;πFunction CpuType : Boolean;πImplementationπ{π GetPal256:π Load Pal Structure With the 256 RGB paletteπ values.π}πProcedure GetPal256 (Var Pal : PaletteType);πVarπ loope : Word;πbeginπ port[$3C7] := 0;π { when a read is made on port $3C9 it increment port $3C7 so no changing }π { of the register port ($3C7) needs to be perFormed here }π For loope := 0 to 255 doπ beginπ Pal[loope,1] := port[$3C9]; { Read red value }π Pal[loope,2] := port[$3C9]; { Read green value }π Pal[loope,3] := port[$3C9]; { Read blue value }π end;πend;π{π SetPal86:π Loads the palette Registers With the values inπ Pal.π 86/88 instructions.π}πProcedure SetPal86 (Var Pal : PaletteType);πbeginπ Asmπ push ds { preserve segment Registers }π push esπ mov cx,256 * 3 { 256 RBG values }π mov dx,03DAhπ { by waiting For the retrace to end it avoids static }π { when the palette is altered }π@retrace1:π in al,dx { wait For no retrace }π and al,8 { check For retrace }π jnz @retrace1 { so loop Until it goes low }π@retrace2:π in al,dx { wait For retrace }π and al,8 { check For retrace }π jz @retrace2 { so loop Until it goes high }π lds si, Pal { ds:si = @Pal }π mov dx,3c8h { set up For a blitz-white }π mov al,0 { from this register }π cli { disable interrupts }π out dx,al { starting register }π inc dx { set up to update DAC }π cld { clear direction flag }π@outnext:π { the following code is what I have found to be the }π { most efficient way to emulate the "rep outsb" }π { instructions on the 8086/88 }π lodsb { load al With ds:[si] }π out dx,al { out al to port in dx }π loop @outnext { loop cx times }π sti { end of critical section }π pop esπ pop ds { restore segment Registers }π end;πend;π{$G+} { turn on 286 instruction generation }ππ{ --------------------------------------------------------------------- }π{ Palette Unit (Text and Graphics modes) }π{ --------------------------------------------------------------------- }π{π SetPal286:π Loads the palette Registers With the values inπ Pal.π 286+ instructions.π}πProcedure SetPal286 (Var Pal : PaletteType);πbeginπ Asmπ push ds { preserve segment Registers }π push esπ mov cx,256 * 3 { 256 RBG values }π mov dx,03dahπ { by waiting For the retrace to end it avoids static }π { when the palette is altered }π@retrace1:π in al,dx { wait For no retrace }π and al,8 { check For retrace }π jnz @retrace1 { so loop Until it goes low }π@retrace2:π in al,dx { wait For retrace }π and al,8 { check For retrace }π jz @retrace2 { so loop Until it goes high }π lds si, Pal { ds:si = @Pal }π mov dx,3c8h { set up For a blitz-white }π mov al,0 { from this register }π cli { disable interrupts }π out dx,al { starting register }π inc dx { set up to update DAC }π cld { clear direction flag }π rep outsb { 768 multiple out's }π { rapid update acheived }π sti { end of critical section }π pop esπ pop ds { restore segment Registers }π end; { Asm }πend; { SetPal286 }π{$G-} { turn off 286 instructions }π{π fadedown:π fades the palette down With little or no staticπ}πProcedure fadedown;πVarπ Plt : PaletteType;π i, j, k : Integer;πbeginπ plt := olplt;π For k := 0 to 63 doπ beginπ For j := 0 to 255 doπ For i := 1 to 3 doπ if Plt[j,i] <> 0 thenπ dec(Plt[j,i]); { decrease palette numbers gradually }π SetPal256(Plt); { gradually fade down the palette }π end;πend;π{π fadeup:π fades the palette up With little or no staticπ}πProcedure fadeup;πVarπ Plt : PaletteType;π i, j, k : Integer;πbeginπ GetPal256(Plt); { Load current palette }π For k := 1 to 63 doπ beginπ For j := 0 to 255 doπ For i := 1 to 3 doπ if Plt[j,i] <> OlPlt[j,i] thenπ inc(Plt[j,i]); { bring palette back to the norm }π SetPal256(Plt); { gradually fades up the palette }π { to the normal values }π end;πend;π{π CpuType:π determines cpu Type so that we can use 286 instructionsπ}πFunction CpuType : Boolean;πVar cpu : Byte;πbeginπ Asmπ push spπ pop axπ cmp sp,ax { stack Pointer treated differently on }π je @cpu8086 { the 8086 Compared to all others }π mov cpu,0π jmp @cpufoundπ@cpu8086:π mov cpu,1π@cpufound:π end; { Asm }π cpuType := (cpu = 1);πend;πbeginπ { determine the cpu Type so that we can use faster routines }π if CpuType thenπ SetPal256 := SetPal286π elseπ SetPal256 := SetPal86;π { load the standard palette }π GetPal256(OlPlt);πend.π 13 05-28-9313:34ALL SWAG SUPPORT TEAM Palette Control #2 IMPORT 33 ^╫Σ Unit palette;π{$O+}πInterfaceππUses Dos,Crt;ππProcedure Set_palette(slot:Word; sred,sgreen,sblue : Byte);πProcedure Get_palette(Var slot,gred,ggreen,gblue : Byte);πProcedure fade_in(dly : Word ; dvsr : Byte); {Delay (ms),divisor (10-64)}πProcedure fade_out(dly : Word ; dvsr : Byte);πProcedure restore_palette;πProcedure swap_color(first,last:Byte);πFunction VGASystem: Boolean;πProcedure remap;πProcedure restoremap;ππConstπ sl : Array[0..15] of Byte =(0,1,2,3,4,5,20,7,56,57,58,59,60,61,62,63);π v_red : Array[0..15] of Byte =(0,0,0,0,42,42,42,42,21,21,21,21,63,63,63,63);π v_green: Array[0..15] of Byte =(0,0,42,42,0,0,21,42,21,21,63,63,21,21,63,63);π v_blue : Array[0..15] of Byte =(0,42,0,42,0,42,0,42,21,63,21,63,21,63,21,63);ππVarπ s_red, s_green, s_blue : Array[0..15] of Real;ππImplementationππProcedure disable_refresh;πVarπ regs : Registers;πbeginπ With regs doπ beginπ AH:=$12;π BL:=$36;π AL:=$01;π end;π Intr($10,regs);πend;ππProcedure enable_refresh;πVarπ regs : Registers;πbeginπ With regs doπ beginπ AH:=$12;π BL:=$36;π AL:=$00;π end;π Intr($10,regs);πend;ππFunction VGASystem: Boolean;π{}πVar Regs : Registers;πbeginπ With Regs doπ beginπ Ax := $1C00;π Cx := 7;π Intr($10,Regs);π If Al = $1C then {VGA}π beginπ VGASystem := True;π Exit;π end;π Ax := $1200;π Bl := $32;π Intr($10,Regs);π If Al = $12 then {MCGA}π beginπ VGASystem := True;π Exit;π end;π end; {with}πend; {of func NoSnowSystem}ππProcedure remap;πVarπ regs : Registers;π idx : Byte;πbeginπ if VGASystem thenπ beginπ With regs doπ beginπ AL:=0;π AH:=11;π end;π For idx:=0 to 15 doπ beginπ regs.BH:=idx;π regs.BL:=idx;π Intr($10,Regs);π end;π end;πend;ππProcedure restoremap;πVarπ regs : Registers;π idx : Byte;πbeginπ if VGASystem thenπ beginπ With regs doπ beginπ AL:=0;π AH:=11;π end;π For idx:=0 to 15 doπ beginπ regs.BH:=sl[idx];π regs.BL:=idx;π Intr($10,Regs);π end;π end;πend;ππProcedure Set_palette(slot:Word; sred,sgreen,sblue : Byte);πVarπ regs : Registers;πbeginπ With regs doπ beginπ AL:=$10;π AH:=$10;π BX:=slot;π DH:=sred;π CH:=sgreen;π CL:=sblue;π end;π Intr($10,Regs);πend;ππProcedure Get_palette(Var slot,gred,ggreen,gblue : Byte);πVarπ regs : Registers;πbeginπ With regs doπ beginπ AL:=21;π AH:=16;π BX:=slot;π end;π Intr($10,Regs);π With regs doπ beginπ gred:=DH;π ggreen:=CH;π gblue:=CL;π end;πend;ππProcedure restore_palette;πVar index:Byte;πbeginπ For index:=0 to 15 doπ set_palette(sl[index],v_red[index],v_green[index],v_blue[index]);πend;πProcedure fade_out(dly : Word ; dvsr : Byte);πVar index,idx : Byte;πbeginπ For index:=0 to 15 doπ beginπ s_red[index]:=v_red[index];π s_green[index]:=v_green[index];π s_blue[index]:=v_blue[index];π end;π For idx:=1 to dvsr doπ beginπ For index:=0 to 15 doπ beginπ set_palette(sl[index],trunc(s_red[index]),trunc(s_green[index]),trunc(s_blue[index]));π s_red[index]:=s_red[index]-(v_red[index]/dvsr);π s_green[index]:=s_green[index]-(v_green[index]/dvsr);π s_blue[index]:=s_blue[index]-(v_blue[index]/dvsr);π end;π Delay(dly)π end;πend;ππProcedure fade_in(dly : Word ; dvsr : Byte);πVar index,idx2:Byte;πbeginπ FillChar(s_red,Sizeof(S_red),#0);π FillChar(s_green,Sizeof(S_green),#0);π FillChar(s_blue,Sizeof(s_blue),#0);π For idx2:=1 to dvsr doπ beginπ For index:=0 to 15 doπ beginπ set_palette(sl[index],trunc(s_red[index]),trunc(s_green[index]),trunc(s_blue[index]));π s_red[index]:=s_red[index]+(v_red[index]/dvsr);π s_green[index]:=s_green[index]+(v_green[index]/dvsr);π s_blue[index]:=s_blue[index]+(v_blue[index]/dvsr);π end;π Delay(dly);π end;πend;ππProcedure swap_color(first,last:Byte);πVar f1,f2,f3,l1,l2,l3:Byte;πbeginπ Get_Palette(sl[first],f1,f2,f3);π Get_Palette(sl[last],l1,l2,l3);π Set_Palette(sl[first],l1,l2,l3);π Set_Palette(sl[last],f1,f2,f3);πend;ππbeginπ restoremap;πend.π 14 05-28-9313:34ALL SWAG SUPPORT TEAM Palette Control #3 IMPORT 81 ^╫╨n Unit Palette;ππInterfaceππTypeπ PalType = Array [0..768] of Byte;πVarπ FadePal : Array [0..768] of Real;π Fadeend,π FadeStep,π FadeCount,π FadeStart : Byte;π FadeToPal : ^PalType;π DoneFade : Boolean;ππProcedure GetPCXPalettePas (PCXBuf,P:Pointer;PalOffset:Word);πProcedure GetPCXPaletteAsm (PCXBuf,P:Pointer;PalOffset:Word);ππProcedure WritePalettePas (Start,Finish:Byte;P:Pointer);πProcedure WritePaletteAsm (Start,Finish:Byte;P:Pointer);ππProcedure ReadPalettePas (Start,Finish:Byte;P:Pointer);πProcedure ReadPaletteAsm (Start,Finish:Byte;P:Pointer);ππProcedure SetupFade (Start,Finish:Byte;P:Pointer;Step:Byte);πProcedure FadePalette;πProcedure Oreo (Start,Finish:Integer);ππImplementationππProcedure CLI; Inline ($FA);πProcedure STI; Inline ($FB);ππProcedure SetupFade (Start,Finish:Byte;P:Pointer;Step:Byte);πVarπ CurPal : Array [0..767] of Byte;π ToPal : ^PalType;π I,PalOfs,π NumColors : Word;π RealStep,π RealToColor,π RealCurColor : Real;πbeginπ ToPal := Ptr (Seg(P^),Ofs(P^));π ReadPaletteAsm (0,255,@CurPal);π PalOfs := Start * 3;π NumColors := (Finish - Start + 1) * 3;ππ RealStep := Step;ππ For I := 0 to NumColors-1 do beginπ RealCurColor := CurPal [PalOfs+I];π RealToColor := ToPal^[PalOfs+I];π FadePal [PalOfs+I] := (RealCurColor - RealToColor) / RealStep;π end;ππ FadeStep := 0;π FadeCount := Step;π FadeStart := Start;π Fadeend := Finish;π FadeToPal := P;π DoneFade := False;πend;ππProcedure FadePalette;πVarπ I,π PalOfs,π NumColors : Word;π CurPal : Array [0..767] of Byte;π Fact,π RealToColor : Real;πbeginπ Inc (FadeStep);π Fact := FadeCount - FadeStep;π NumColors := (Fadeend - FadeStart + 1) * 3;π ReadPaletteAsm (0,255,@CurPal);π PalOfs := FadeStart * 3;ππ For I := 0 to NumColors - 1 do beginπ RealToColor := FadeToPal^[PalOfs+I];π CurPal[PalOfs+I] := Round (RealToColor + Fact * FadePal[PalOfs+I]);π end;ππ WritePaletteAsm (FadeStart,Fadeend,@CurPal);π DoneFade := FadeStep = FadeCount;πend;ππProcedure Oreo (Start,Finish:Integer);πVarπ I,PalOfs : Word;π CurPal : Array [0..767] of Byte;π Red,π Blue,π Green : Real;π Gray : Byte;πbeginπ ReadPaletteAsm (0,255,@CurPal);ππ For I := Start to Finish do beginπ PalOfs := I * 3;π Red := CurPal[PalOfs + 0];π Green := CurPal[PalOfs + 1];π Blue := CurPal[PalOfs + 2];ππ Gray := Round ((0.30 * Red) + (0.59 * Green) + (0.11 * Blue));ππ CurPal[PalOfs + 0] := Gray;π CurPal[PalOfs + 1] := Gray;π CurPal[PalOfs + 2] := Gray;π end;π WritePaletteAsm (Start,Finish,@CurPal);πend;ππProcedure GetPCXPalettePas (PCXBuf,P:Pointer;PalOffset:Word);πVarπ I : Word;π InByte : Byte;πbeginπ PCXBuf := Ptr (Seg(PCXBuf^),Ofs(PCXBuf^)+PalOffset);π For I := 0 to 767 do beginπ InByte := Mem [Seg(PCXBuf^):Ofs(PCXBuf^)+I];π InByte := InByte shr 2;π Mem [Seg(P^):Ofs(P^)+I] := InByte;π end;πend;ππProcedure WritePalettePas (Start,Finish:Byte;P:Pointer);πVarπ I,π NumColors : Word;π InByte : Byte;πbeginπ P := Ptr (Seg(P^),Ofs(P^)+Start*3);π NumColors := (Finish - Start + 1) * 3;ππ CLI;ππ Port [$03C8] := Start;ππ For I := 0 to NumColors do beginπ InByte := Mem [Seg(P^):Ofs(P^)+I];π Port [$03C9] := InByte;π end;ππ STI;πend;ππProcedure ReadPalettePas (Start,Finish:Byte;P:Pointer);πVarπ I,π NumColors : Word;π InByte : Byte;πbeginπ P := Ptr (Seg(P^),Ofs(P^)+Start*3);π NumColors := (Finish - Start + 1) * 3;ππ CLI;ππ Port [$03C7] := Start;ππ For I := 0 to NumColors do beginπ InByte := Port [$03C9];π Mem [Seg(P^):Ofs(P^)+I] := InByte;π end;ππ STI;πend;ππProcedure GetPCXPaletteAsm (PCXBuf,P:Pointer;PalOffset:Word);πAssembler;πAsmπ push dsππ lds si,PCXBufπ mov ax,PalOffsetπ add si,axππ les di,Pππ mov cx,768π @@1:π lodsbπ shr al,1π shr al,1π stosbπ loop @@1ππ pop dsπend;ππProcedure WritePaletteAsm (Start,Finish:Byte;P:Pointer); Assembler;πAsmπ push dsππ lds si,Pππ cldππ xor bh,bh { P^ points to the beginning of the palette }π mov bl,Start { data. Since we can specify the Start and }π xor ax,ax { Finish color nums, we have to point our }π mov al,Start { Pointer to the Start color. There are 3 }π shl ax,1 { Bytes per color, so the Start color is: }π add ax,bx { Palette Ofs = @P + Start * 3 }π add si,ax { ds:si -> offset in color data }ππ xor ch,ch { Next, we have to determine how many colors}π mov cl,Finish { we will be updating. This simply is: }π sub cl,Start { NumColors = Finish - Start + 1 }π inc cxππ(*π push esπ push dxπ push axππ xor ax,ax { get address of status register }π mov es,ax { from segment 0 }π mov dx,3BAh { assume monochrome addressing }π test Byte ptr es:[487h],2 { is mono display attached? }π jnz @@11 { yes, address is OK }π mov dx,3DAh { no, must set color addressing }π @@11:π in al,dx { read in status }π jmp @@21π @@21:π test al,08h { is retrace on> (if ON, bit = 1) }π jz @@13 { no, go wait For start }π @@12:π { yes, wait For it to go off }π in al,dxπ jmp @@22π @@22:π test al,08h { is retrace off? }π jnz @@12 { no, keep waiting }π @@13:π in al,dxπ jmp @@23π @@23:π test al,08h { is retrace on? }π jz @@13 { no, keep on waiting }ππ pop axπ pop dxπ pop es *)ππ mov al,Start { We are going to bypass the BIOS routines }π mov dx,03C8h { to update the palette Registers. For the }π out dx,al { smoothest fades, there is no substitute }ππ cli { turn off interrupts temporarily }π inc dxππ @@1:π lodsb { Get the red color Byte }π jmp @@2 { Delay For a few clock cycles }π @@2:π out dx,al { Write the red register directly }ππ lodsb { Get the green color Byte }π jmp @@3 { Delay For a few clock cycles }π @@3:π out dx,al { Write the green register directly }ππ lodsb { Get the blue color Byte }π jmp @@4 { Delay For a few clock cycles }π @@4:π out dx,al { Write the blue register directly }ππ loop @@1ππ sti { turn interrupts back on }π pop dsπend;ππProcedure ReadPaletteAsm (Start,Finish:Byte;P:Pointer); Assembler;πAsmπ les di,Pππ cldππ xor bh,bh { P^ points to the beginning of the palette }π mov bl,Start { buffer. We have to calculate where in the}π xor ax,ax { buffer we need to start at. Because each }π mov al,Start { color has three Bytes associated With it }π shl ax,1 { the starting ofs is: }π add ax,bx { Palette Ofs = @P + Start * 3 }π add si,ax { es:di -> offset in color data }ππ xor ch,ch { Next, we have to determine how many colors}π mov cl,Finish { we will be reading. This simply is: }π sub cl,Start { NumColors = Finish - Start + 1 }π inc cxππ mov al,Start { We are going to bypass the BIOS routines }π mov dx,03C7h { to read in from the palette Registers. }π out dx,al { This is the fastest method to do this. }π mov dx,03C9hππ cli { turn off interrupts temporarily }ππ @@1:π in al,dx { Read in the red color Byte }π jmp @@2 { Delay For a few clock cycles }π @@2:π stosb { Store the Byte in the buffer }ππ in al,dx { Read in the green color Byte }π jmp @@3 { Delay For a few clock cycles }π @@3:π stosb { Store the Byte in the buffer }ππ in al,dx { Read in the blue color Byte }π jmp @@4 { Delay For a few clock cycles }π @@4:π stosb { Store the Byte in the buffer }π loop @@1ππ sti { turn interrupts back on }πend;ππend.π{ππ**********************************************πHere's the testing Programπ**********************************************π}πProgram MCGATest;ππUsesπ Crt,Dos,MCGALib,Palette;ππVarπ Stop,π Start : LongInt;π Regs : Registers;π PicBuf,π StorageBuf : Pointer;π FileLength : Word;π Pal,π BlackPal : Array [1..768] of Byte;ππConstπ NumTimes = 100;ππProcedure LoadBuffer (S:String;Buf:Pointer);πVarπ F : File;π BlocksRead : Word;πbeginπ Assign (F,S);π Reset (F,1);π BlockRead (F,Buf^,65000,FileLength);π Close (F);πend;ππProcedure Pause;πVarπ Ch : Char;πbeginπ Repeat Until KeyPressed;π While KeyPressed do Ch := ReadKey;πend;ππProcedure Control;πbeginπ SetGraphMode ($13);ππ LoadBuffer ('E:\NAVAJO.PCX',PicBuf);ππ GetPCXPaletteAsm (PicBuf,@Pal,FileLength-768);π WritePalettePas (0,255,@Pal);π DisplayPCX (0,0,PicBuf);ππ FillChar (BlackPal,SizeOf(BlackPal),0);π Pause;ππ SetupFade (0,255,@BlackPal,20);π Repeat FadePalette Until DoneFade;π Pause;ππ SetupFade (0,255,@Pal,20);π Repeat FadePalette Until DoneFade;π Pause;ππ Oreo (0,255);π Pause;ππ SetupFade (0,255,@Pal,20);π Repeat FadePalette Until DoneFade;π Pause;πend;ππProcedure Init;πbeginπ GetMem (PicBuf,65500);πend;ππbeginπ Init;π Control;πend.ππ 15 05-28-9313:34ALL SWAG SUPPORT TEAM Some More Palette ControlIMPORT 15 ^╫┬╧ {π>The utility I wrote, just Writes the contents of the $A000 from one toπ>63999 (ya know 320x200), to a File. then I bring it to an Array, andπ>then I try to reWrite it to the video. HOWEVER, I noticed that theπ>palette inFormation is incorrect. Is there any way to fix this, sinceπ>it comes out in a messed up color.ππHow about writing also the palette info to the File ? You're probablyπBlockWriting, so this should not be a big problem. You just have toπfetch the palette info through inT $10, Function $1017 :π}ππTypeπ TCouleurVGA =π Recordπ Rouge,π Vert,π Bleu : Byte ;π end ;ππ TPaletteVGA = Array[0..255] of TCouleurVGA ;ππProcedure LitPalette(Var p : TPaletteVGA) ; Assembler ;πAsmπ { Lecture table couleurs }π Mov AX, $1017π Mov BX, 0π Mov CX, 256π LES DX, pπ Int $10πend ;ππ{πThe reverse :π}ππProcedure AffectePalette(Var Palette : TPaletteVGA) ; Assembler ;πAsmπ Mov AX, $1012π Xor BX, BXπ Mov CX, 256π LES DX, Paletteπ Int $10πend ;ππ{π>Also, I have successfully written color cycling, by changing each colorπ>index in a loop. Only problem is that you can see it 'redrawing'. Isπ>there anyway ot change them all simultaneously, instead of a loop? I amπ>working in Pascal, using bits and chunks of Inline Asm.ππI'm _not_ sure the following is the answer you expect :π}ππProcedure AffectePaletteDeA(Var Palette ; De, A : Integer) ; Assembler ;πAsmπ Mov AX, $1012π Mov BX, Deπ Mov CX, Aπ Sub CX, BXπ Inc CXπ LES DX, Paletteπ Int $10πend ;ππVarπ Pal : TPaletteVGA ;ππbeginπ { Here, fill the colors you need }π { Say, you modified colors 37 to 124 into Pal Array }π AffectePaletteDeA(Pal[37], 37, 124) ;πend.ππ 16 05-28-9313:34ALL SWAG SUPPORT TEAM Setting Text Attr IMPORT 6 ^╫ñ {YZ> Does anyone know how to "extract" the foreground and backgroundπYZ> colours from TextAttr?π}ππ Foreground := TextAttr and $0f;π Background := (TextAttr and $f0) shr 4;ππ{A few days ago, I read a message from someone who was trying to extractπforeground and background colors from one Byte Variable. I have sinceπlost the mail packet, and forgotten the user's name, but here's aπroutine that will do that anyways. Hope it gets to the person who wasπasking For it......π}πProcedure GetColors(Color : Byte; Var BackGr : Byte; Var ForeGr : Byte);πbeginπ BackGr := Color shr 4;π ForeGr := Color xor (Background shl 4);πend;ππ 17 05-28-9313:34ALL SWAG SUPPORT TEAM Background/Foreground IMPORT 3 ^╫╞h YZ> Does anyone know how to "extract" the Foreground andπYZ> background colours fromπYZ> TextAttr?ππor, For simplicity, use:ππ FC := TextAttr MOD 16;π BC := TextAttr div 16;ππ 18 06-22-9309:17ALL SWAG SUPPORT TEAM Select HIGH Back Colors IMPORT 16 ^╫Ñ¥ PROGRAM HighBack;ππUSES Dos,Crt;ππTYPEπ AttrType = (Blinking,HighInt);ππPROCEDURE SelectAttribute(Attribute: AttrType);πVARπ Reg :Registers;πBEGINπ Reg.ah := $10;π Reg.al := 3;π CASE Attribute OFπ HighInt : Reg.bl := 0;π Blinking : Reg.bl := 1π END;π Intr($10,Reg)π END;ππPROCEDURE SetBackground(BG: Byte);πBEGINπ BG := (BG AND $F) SHL 4; {Limit to range 0 - 15, then shift up}π Crt.TextAttr := (Crt.TextAttr MOD 16) + BG;π END;ππPROCEDURE SetForeground(FG: Byte);πBEGINπ FG := (FG AND $F); {Limit to range 0 - 15}π Crt.TextAttr := (Crt.TextAttr AND $F0) + FG;π END;ππFUNCTION GetBackground: Byte;πBEGINπ GetBackground := Crt.TextAttr DIV 16;π END;ππFUNCTION GetForeground: Byte;πBEGINπ GetForeground := Crt.TextAttr MOD 16;π END;ππCONSTπ Flip : Integer = 0;π BGM : Byte = Black;π FGM : Byte = White;πVARπ BG, FG : Byte;π A : Char;ππBEGINππ{Initialize screen}π TextMode(CO80);π TextBackGround(BGM);π TextColor(FGM);π ClrScr;ππ{Display demo color combinations}π GotoXY(35,1);WriteLn('Foreground');π Write('Background ');π FOR FG := 0 TO $F DO Write(FG:3,' ');π WriteLn;WriteLn;ππ FOR BG:= 0 TO $F DO BEGIN {Cycle through colors}π SetBackground(BGM);π Write(BG:5,' ');π SetBackground(BG);π FOR FG := 0 TO $F DO BEGINπ SetForeground(FG); {Adjust FG for visibilty}π Write(Crt.TextAttr:4);π END;π WriteLn;π END;ππ GotoXY(18,25); {Create prompt}π SetBackground(LightCyan);π SetForeground(Black);π Write('Press <Esc> to quit, any other key to swap attributes');ππ A := ' '; {Loop to swap attributes}π WHILE Ord(A) <> 27 DO BEGINπ CASE Flip OFπ 0 : SelectAttribute(HighInt);π -1 : SelectAttribute(Blinking);π END;π Flip := NOT Flip;π A := ReadKey;π END;π TextMode(CO80);π ClrScrπ END.π 19 08-18-9312:25ALL JOSE ALMEIDA Complete color constants IMPORT 90 ^╫@ÿ πUNIT HTcolors;ππ{ Complete set of all color attributes contants by their own names.π Part of the Heartware Toolkit v2.00 (HTcolors.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππINTERFACEππconstππ { black background }ππ BlackOnBlack : byte = $00;π BlueOnBlack : byte = $01;π GreenOnBlack : byte = $02;π CyanOnBlack : byte = $03;π RedOnBlack : byte = $04;π MagentaOnBlack : byte = $05;π BrownOnBlack : byte = $06;π LtGrayOnBlack : byte = $07;π DkGrayOnBlack : byte = $08;π LtBlueOnBlack : byte = $09;π LtGreenOnBlack : byte = $0A;π LtCyanOnBlack : byte = $0B;π LtRedOnBlack : byte = $0C;π LtMagentaOnBlack : byte = $0D;π YellowOnBlack : byte = $0E;π WhiteOnBlack : byte = $0F;ππ { blue background }ππ BlackOnBlue : byte = $10;π BlueOnBlue : byte = $11;π GreenOnBlue : byte = $12;π CyanOnBlue : byte = $13;π RedOnBlue : byte = $14;π MagentaOnBlue : byte = $15;π BrownOnBlue : byte = $16;π LtGrayOnBlue : byte = $17;π DkGrayOnBlue : byte = $18;π LtBlueOnBlue : byte = $19;π LtGreenOnBlue : byte = $1A;π LtCyanOnBlue : byte = $1B;π LtRedOnBlue : byte = $1C;π LtMagentaOnBlue : byte = $1D;π YellowOnBlue : byte = $1E;π WhiteOnBlue : byte = $1F;ππ { green background }ππ BlackOnGreen : byte = $20;π BlueOnGreen : byte = $21;π GreenOnGreen : byte = $22;π CyanOnGreen : byte = $23;π RedOnGreen : byte = $24;π MagentaOnGreen : byte = $25;π BrownOnGreen : byte = $26;π LtGrayOnGreen : byte = $27;π DkGrayOnGreen : byte = $28;π LtBlueOnGreen : byte = $29;π LtGreenOnGreen : byte = $2A;π LtCyanOnGreen : byte = $2B;π LtRedOnGreen : byte = $2C;π LtMagentaOnGreen : byte = $2D;π YellowOnGreen : byte = $2E;π WhiteOnGreen : byte = $2F;ππ { cyan background }ππ BlackOnCyan : byte = $30;π BlueOnCyan : byte = $31;π GreenOnCyan : byte = $32;π CyanOnCyan : byte = $33;π RedOnCyan : byte = $34;π MagentaOnCyan : byte = $35;π BrownOnCyan : byte = $36;π LtGrayOnCyan : byte = $37;π DkGrayOnCyan : byte = $38;π LtBlueOnCyan : byte = $39;π LtGreenOnCyan : byte = $3A;π LtCyanOnCyan : byte = $3B;π LtRedOnCyan : byte = $3C;π LtMagentaOnCyan : byte = $3D;π YellowOnCyan : byte = $3E;π WhiteOnCyan : byte = $3F;ππ { red background }ππ BlackOnRed : byte = $40;π BlueOnRed : byte = $41;π GreenOnRed : byte = $42;π CyanOnRed : byte = $43;π RedOnRed : byte = $44;π MagentaOnRed : byte = $45;π BrownOnRed : byte = $46;π LtGrayOnRed : byte = $47;π DkGrayOnRed : byte = $48;π LtBlueOnRed : byte = $49;π LtGreenOnRed : byte = $4A;π LtCyanOnRed : byte = $4B;π LtRedOnRed : byte = $4C;π LtMagentaOnRed : byte = $4D;π YellowOnRed : byte = $4E;π WhiteOnRed : byte = $4F;ππ { magenta background }ππ BlackOnMagenta : byte = $50;π BlueOnMagenta : byte = $51;π GreenOnMagenta : byte = $52;π CyanOnMagenta : byte = $53;π RedOnMagenta : byte = $54;π MagentaOnMagenta : byte = $55;π BrownOnMagenta : byte = $56;π LtGrayOnMagenta : byte = $57;π DkGrayOnMagenta : byte = $58;π LtBlueOnMagenta : byte = $59;π LtGreenOnMagenta : byte = $5A;π LtCyanOnMagenta : byte = $5B;π LtRedOnMagenta : byte = $5C;π LtMagentaOnMagenta : byte = $5D;π YellowOnMagenta : byte = $5E;π WhiteOnMagenta : byte = $5F;ππ { brown background }ππ BlackOnBrown : byte = $60;π BlueOnBrown : byte = $61;π GreenOnBrown : byte = $62;π CyanOnBrown : byte = $63;π RedOnBrown : byte = $64;π MagentaOnBrown : byte = $65;π BrownOnBrown : byte = $66;π LtGrayOnBrown : byte = $67;π DkGrayOnBrown : byte = $68;π LtBlueOnBrown : byte = $69;π LtGreenOnBrown : byte = $6A;π LtCyanOnBrown : byte = $6B;π LtRedOnBrown : byte = $6C;π LtMagentaOnBrown : byte = $6D;π YellowOnBrown : byte = $6E;π WhiteOnBrown : byte = $6F;ππ { light gray background }ππ BlackOnLtGray : byte = $70;π BlueOnLtGray : byte = $71;π GreenOnLtGray : byte = $72;π CyanOnLtGray : byte = $73;π RedOnLtGray : byte = $74;π MagentaOnLtGray : byte = $75;π BrownOnLtGray : byte = $76;π LtGrayOnLtGray : byte = $77;π DkGrayOnLtGray : byte = $78;π LtBlueOnLtGray : byte = $79;π LtGreenOnLtGray : byte = $7A;π LtCyanOnLtGray : byte = $7B;π LtRedOnLtGray : byte = $7C;π LtMagentaOnLtGray : byte = $7D;π YellowOnLtGray : byte = $7E;π WhiteOnLtGray : byte = $7F;ππ {·········································································}ππ { black background blinking }ππ BlackOnBlackBlink : byte = $80;π BlueOnBlackBlink : byte = $81;π GreenOnBlackBlink : byte = $82;π CyanOnBlackBlink : byte = $83;π RedOnBlackBlink : byte = $84;π MagentaOnBlackBlink : byte = $85;π BrownOnBlackBlink : byte = $86;π LtGrayOnBlackBlink : byte = $87;π DkGrayOnBlackBlink : byte = $88;π LtBlueOnBlackBlink : byte = $89;π LtGreenOnBlackBlink : byte = $8A;π LtCyanOnBlackBlink : byte = $8B;π LtRedOnBlackBlink : byte = $8C;π LtMagentaOnBlackBlink : byte = $8D;π YellowOnBlackBlink : byte = $8E;π WhiteOnBlackBlink : byte = $8F;ππ { blue background blinking }ππ BlackOnBlueBlink : byte = $90;π BlueOnBlueBlink : byte = $91;π GreenOnBlueBlink : byte = $92;π CyanOnBlueBlink : byte = $93;π RedOnBlueBlink : byte = $94;π MagentaOnBlueBlink : byte = $95;π BrownOnBlueBlink : byte = $96;π LtGrayOnBlueBlink : byte = $97;π DkGrayOnBlueBlink : byte = $98;π LtBlueOnBlueBlink : byte = $99;π LtGreenOnBlueBlink : byte = $9A;π LtCyanOnBlueBlink : byte = $9B;π LtRedOnBlueBlink : byte = $9C;π LtMagentaOnBlueBlink : byte = $9D;π YellowOnBlueBlink : byte = $9E;π WhiteOnBlueBlink : byte = $9F;ππ { green background blinking }ππ BlackOnGreenBlink : byte = $A0;π BlueOnGreenBlink : byte = $A1;π GreenOnGreenBlink : byte = $A2;π CyanOnGreenBlink : byte = $A3;π RedOnGreenBlink : byte = $A4;π MagentaOnGreenBlink : byte = $A5;π BrownOnGreenBlink : byte = $A6;π LtGrayOnGreenBlink : byte = $A7;π DkGrayOnGreenBlink : byte = $A8;π LtBlueOnGreenBlink : byte = $A9;π LtGreenOnGreenBlink : byte = $AA;π LtCyanOnGreenBlink : byte = $AB;π LtRedOnGreenBlink : byte = $AC;π LtMagentaOnGreenBlink : byte = $AD;π YellowOnGreenBlink : byte = $AE;π WhiteOnGreenBlink : byte = $AF;ππ { cyan background blinking }ππ BlackOnCyanBlink : byte = $B0;π BlueOnCyanBlink : byte = $B1;π GreenOnCyanBlink : byte = $B2;π CyanOnCyanBlink : byte = $B3;π RedOnCyanBlink : byte = $B4;π MagentaOnCyanBlink : byte = $B5;π BrownOnCyanBlink : byte = $B6;π LtGrayOnCyanBlink : byte = $B7;π DkGrayOnCyanBlink : byte = $B8;π LtBlueOnCyanBlink : byte = $B9;π LtGreenOnCyanBlink : byte = $BA;π LtCyanOnCyanBlink : byte = $BB;π LtRedOnCyanBlink : byte = $BC;π LtMagentaOnCyanBlink : byte = $BD;π YellowOnCyanBlink : byte = $BE;π WhiteOnCyanBlink : byte = $BF;ππ { red background blinking }ππ BlackOnRedBlink : byte = $C0;π BlueOnRedBlink : byte = $C1;π GreenOnRedBlink : byte = $C2;π CyanOnRedBlink : byte = $C3;π RedOnRedBlink : byte = $C4;π MagentaOnRedBlink : byte = $C5;π BrownOnRedBlink : byte = $C6;π LtGrayOnRedBlink : byte = $C7;π DkGrayOnRedBlink : byte = $C8;π LtBlueOnRedBlink : byte = $C9;π LtGreenOnRedBlink : byte = $CA;π LtCyanOnRedBlink : byte = $CB;π LtRedOnRedBlink : byte = $CC;π LtMagentaOnRedBlink : byte = $CD;π YellowOnRedBlink : byte = $CE;π WhiteOnRedBlink : byte = $CF;ππ { magenta background blinking }ππ BlackOnMagentaBlink : byte = $D0;π BlueOnMagentaBlink : byte = $D1;π GreenOnMagentaBlink : byte = $D2;π CyanOnMagentaBlink : byte = $D3;π RedOnMagentaBlink : byte = $D4;π MagentaOnMagentaBlink : byte = $D5;π BrownOnMagentaBlink : byte = $D6;π LtGrayOnMagentaBlink : byte = $D7;π DkGrayOnMagentaBlink : byte = $D8;π LtBlueOnMagentaBlink : byte = $D9;π LtGreenOnMagentaBlink : byte = $DA;π LtCyanOnMagentaBlink : byte = $DB;π LtRedOnMagentaBlink : byte = $DC;π LtMagentaOnMagentaBlink : byte = $DD;π YellowOnMagentaBlink : byte = $DE;π WhiteOnMagentaBlink : byte = $DF;ππ { brown background blinking }ππ BlackOnBrownBlink : byte = $E0;π BlueOnBrownBlink : byte = $E1;π GreenOnBrownBlink : byte = $E2;π CyanOnBrownBlink : byte = $E3;π RedOnBrownBlink : byte = $E4;π MagentaOnBrownBlink : byte = $E5;π BrownOnBrownBlink : byte = $E6;π LtGrayOnBrownBlink : byte = $E7;π DkGrayOnBrownBlink : byte = $E8;π LtBlueOnBrownBlink : byte = $E9;π LtGreenOnBrownBlink : byte = $EA;π LtCyanOnBrownBlink : byte = $EB;π LtRedOnBrownBlink : byte = $EC;π LtMagentaOnBrownBlink : byte = $ED;π YellowOnBrownBlink : byte = $EE;π WhiteOnBrownBlink : byte = $EF;ππ { light gray background blinking }ππ BlackOnLtGrayBlink : byte = $F0;π BlueOnLtGrayBlink : byte = $F1;π GreenOnLtGrayBlink : byte = $F2;π CyanOnLtGrayBlink : byte = $F3;π RedOnLtGrayBlink : byte = $F4;π MagentaOnLtGrayBlink : byte = $F5;π BrownOnLtGrayBlink : byte = $F6;π LtGrayOnLtGrayBlink : byte = $F7;π DkGrayOnLtGrayBlink : byte = $F8;π LtBlueOnLtGrayBlink : byte = $F9;π LtGreenOnLtGrayBlink : byte = $FA;π LtCyanOnLtGrayBlink : byte = $FB;π LtRedOnLtGrayBlink : byte = $FC;π LtMagentaOnLtGrayBlink : byte = $FD;π YellowOnLtGrayBlink : byte = $FE;π WhiteOnLtGrayBlink : byte = $FF;ππππIMPLEMENTATIONππππEND. { HTcolors.PAS }πππ 20 05-25-9408:01ALL STEVEN DEBRUYN Change Colors SWAG9405 13 ^╫@÷ πPROGRAM Change_Color;πUSES Crt;πVAR Tel, Tel2 : Byte;ππ(**********************************************************************)π(* Copyright for this procedure by Steven Debruyn 1994 *)π(* Hereby donated to Public Domain *)π(* Feel free to put this in the SWAG if you think it's any good *)π(**********************************************************************)πPROCEDURE Say(Zin : String);πVAR Kleur : Byte;π Code : Integer;π Zin1 : String;π Zin2 : String;π TempZin : String;π Gedaan : Boolean;πBEGINπ WHILE Pos('\\',Zin) <> 0 DO BEGINπ Zin1 := Copy(Zin, Pos('\\',Zin)+2, Pos('\\',Zin)+Pos(' ',Zin)-4);π Val(Zin1,Kleur,Code);π TextAttr:= Kleur;π Zin2 := Copy(Zin, Pos('\\',Zin)+Length(Zin1)+2,Length(Zin));π TempZin := Copy(Zin2, Pos(' ',Zin2), Pos('\\',Zin2)-1);π Write(TempZin);π Zin := Copy(Zin2, Pos(TempZin,Zin2)+Length(TempZin), Length(Zin2));π END;π WriteLn;πEND;ππBEGINπ TextAttr:=0;π ClrScr;π Say('\\5 Hello\\9 World out there,\\79 this is a test\\154 !\\');π Say('\\14 I can change color\\23 and \\220 background.\\138 and'+π ' BLINK at the same time.\\');π Say('\\15 Press\\11 [\\14 ENTER\\11 ]\\');π ReadLn;π ClrScr;π Tel2:=1;π FOR Tel := 1 TO 255 DOπ BEGINπ TextAttr := Tel;π WriteLn('This is Color : ',Tel);π Inc(Tel2);π IF Tel2 = 24 THENπ BEGINπ ReadLn;π TextAttr:=0;π ClrScr;π Tel2 := 1;π END;π ENDπEND.π 21 05-26-9406:18ALL MICHAEL HOENIE Color Codes IMPORT 21 ^╫R[ {π ├─>I would like to implement color codes into my on-line doors. You knowπ ├─>the type that Wildcat or PCB have. The @ codes. Does anyone have aπ ├─>routine that would (I assume) read in a file bite by bite and when itπ ├─>comes across the @ char it would read the next 3 bits and determine whatπ ├─>action to take?ππHi Larry! Sure do have one for 'ya!ππTry this one out for size. It can be optimized to be smaller, but as anπexample, this one works for sure! You'll have to incorporate it into yourπcode to dump out to the modem (no problem I hope!)ππGive this a try: }ππ typeπ string255=string[255];ππ procedure outgoing(stream:string255; ret:integer);π varπ _retval:integer;π out,out1:string[5];π beginπ for _retval:=1 to length(stream) doπ beginπ out:=copy(stream,_retval,1);π case out[1] ofπ '@':begin { COLOR CODE ---> @X1F or other }π out1:=copy(stream,_retval+2,1);π case out1[1] ofπ '0':textbackground(0);π '1':textbackground(1);π '2':textbackground(2);π '3':textbackground(3);π '4':textbackground(4);π '5':textbackground(5);π '6':textbackground(6);π '7':textbackground(7);π '8':textbackground(8);π '9':textbackground(9);π 'A':textbackground(10);π 'B':textbackground(11);π 'C':textbackground(12);π 'D':textbackground(13);π 'E':textbackground(14);π 'F':textbackground(15);π end;π out1:=copy(stream,_retval+3,1);π case out1[1] ofπ '0':textcolor(0);π '1':textcolor(1);π '2':textcolor(2);π '3':textcolor(3);π '4':textcolor(4);π '5':textcolor(5);π '6':textcolor(6);π '7':textcolor(7);π '8':textcolor(8);π '9':textcolor(9);π 'A':textcolor(10);π 'B':textcolor(11);π 'C':textcolor(12);π 'D':textcolor(13);π 'E':textcolor(14);π 'F':textcolor(15);π end;π _retval:=_retval+3;π end;π else write(out[1]);π end;π end;π if ret=2 then writeln;π end;ππ
