[Back to CRT SWAG index] [Back to Main SWAG index] [Original]
{
AW> Does anybody know how one might make a color chart in Pascal where
AW> you can move the cursor around and select a new color, like some BBS
AW> programs do when you change text colors? Such as...
AW> XXXXXXXXXXXXXXX
AW> XXXXXXXXXXXXXXX
AW> XXXXXXXXXXXXXXX
AW> XXXXXXXXXXXXXXX
AW> Just like that ^^ ... have 15 across by 7 down, and you can use the
AW> cursors to select them. I am having a hell of a time...
AW> Thank you in advance...
Yes, this one knows, but I'm feeling a tad lazy, so I'll hand you a unit
+ example program. Only snag is you should have access to Turbo (or Object)
Professional. Sorry, them's the breaks !
{ -- TPCOLOR.PAS Copyright (C) 1988, by TurboPower Software.
-- May be distributed and used freely, with the aid of the
-- commercial product Turbo Professional 4.0 or 5.0. }
{$R-,S-,F-,B-}
UNIT TpColor;
{ -- Color selection routines. }
INTERFACE
CONST ColorFrameColor: byte = $0E; { -- Color of frame of selection window
} ColorBoxColor : byte = $0F; { -- Color of moving box }
NewColorProc : pointer = NIL; { -- User defined procedure }
FUNCTION InitColorBox(CONST BoxXL, BoxYL: byte;
VAR BoxXH, BoxYH: byte) : boolean;
{ -- Initialize the color box. }
PROCEDURE SelectNewColor(VAR Attr : byte);
{ -- Choose one color; ESC exits immediately. }
PROCEDURE EraseColorBox;
{ -- Erase and dispose of the color box. }
{ ---------------------------------------------------------------- }
IMPLEMENTATION
USES OPkey, OPcrt;
CONST BoxCharArray: ARRAY[-1..1, -2..2] OF char
= ('ÚÄÄÄ¿',
'³ * ³',
'ÀÄÄÄÙ');
Choice : STRING[3] = ' * ';
VAR YL : byte; { -- Coordinates of color window. }
XL : byte;
YH : byte;
XH : byte;
W : pointer; { -- Points to screen buffer for overall window. }
B : pointer; { -- Points to screen buffer for moving box window. }
ScanLines: word; { -- Saves cursor shape. }
XY : word; { -- Saves cursor position. }
{ -- Holds attributes row col}
BoxColorArray : ARRAY[0..17, 0..25] OF byte;
PROCEDURE CalcRowCol(CONST Attr: byte; VAR Row, Col: byte);
{ -- -Calculate the row and column for an attribute}
BEGIN Row:=YL+1+(Attr AND $0F);
Col:=XL+1+3*(Attr SHR 4);
END;
PROCEDURE DrawChart;
{ -- Draw the color chart and initialize BoxColorArray. }
VAR C :integer;
Row, Col, Attr, A: byte;
BEGIN fillchar(BoxColorArray, sizeof(BoxColorArray), ColorBoxColor);
FOR Attr:=0 TO 127
DO BEGIN CalcRowCol(Attr, Row, Col);
FastWrite(Choice, Row, Col, Attr);
A:=(Attr AND $F0) OR (ColorBoxColor AND $F);
FOR C:=Col TO Col+2 DO BoxColorArray[Row-YL, C-XL]:=A
END
END;
PROCEDURE DrawAttributeBox(CONST Attr, Row, Col: byte);
{ -- Draw box around current selection. }
VAR I, J, RowDelta, ColDelta: integer;
A : byte;
BEGIN FOR RowDelta:=-1 TO 1
DO BEGIN I:=Row+RowDelta;
FOR ColDelta:=-2 TO 2
DO BEGIN J:=Col+ColDelta;
A:=BoxColorArray[I-YL, J-XL];
{ -- Leave the attribute of ' * ' alone}
CASE ColDelta
OF -1..1 : IF RowDelta = 0 THEN A:=Attr
END;
FastWrite(BoxCharArray[RowDelta, ColDelta], I, J, A)
END
END
END;
PROCEDURE SaveBox(CONST Row, Col: byte);
{ -- Save screen under the moving box. }
BEGIN SaveWindow(Col-1, Row-1, Col+3, Row+1, FALSE, B) END;
PROCEDURE RestoreBox(CONST Row, Col : byte);
{ -- Restore screen under the moving box. }
BEGIN RestoreWindow(Col-1, Row-1, Col+3, Row+1, FALSE, B) END;
FUNCTION InitColorBox(CONST BoxXL, BoxYL: byte;
VAR BoxXH, BoxYH: byte): boolean;
BEGIN InitColorBox:=FALSE;
{ -- Check if window already active: }
IF W <> NIL THEN exit;
{ -- Compute coordinates of surrounding window. }
YL:=BoxYL;
XL:=BoxXL;
CalcRowCol(127, YH, XH);
inc(XH, 3);
inc(YH, 1);
BoxXH:=XH;
BoxYH:=YH;
IF (XH > ScreenWidth) OR (YH > ScreenHeight) THEN exit;
{ -- Allocate screen buffers. }
IF NOT SaveWindow(XL, YL, XH, YH, TRUE, W) THEN exit;
IF NOT SaveWindow(XL, YL, XL+4, YL+2, TRUE, B) THEN exit;
{ -- Initialize the box. }
GetCursorState(XY, ScanLines);
HiddenCursor;
FrameWindow(XL, YL, XH, YH, ColorFrameColor, 0, '');
DrawChart;
InitColorBox:=TRUE
END;
PROCEDURE CallNewColorProc(CONST Attr : byte);
{ -- -Call user routine when a new color is selected. }
INLINE($FF/$1E/>NewColorProc); { -- call dword ptr [>NewColorProc] }
PROCEDURE SelectNewColor(VAR Attr : byte);
VAR KW : word;
A, PrevA, Row, Col: byte;
Done : boolean;
BEGIN Done:=FALSE;
A:=Attr;
PrevA:=NOT A;
REPEAT { -- Update current color. }
IF A <> PrevA
THEN BEGIN CalcRowCol(A, Row, Col);
SaveBox(Row, Col);
DrawAttributeBox(A, Row, Col+1);
IF NewColorProc <> NIL THEN CallNewColorProc(A);
PrevA:=A;
END;
{ -- Evaluate command: }
KW:=ReadKeyWord;
CASE KW
OF Enter: BEGIN Attr:=A;
Done:=TRUE;
BoxCharArray[0, 0]:='';
DrawAttributeBox(A + Blink, Row, Col+1);
delay(1500)
END;
Up : IF (A AND $F) = 0 THEN inc(A, 15) ELSE dec(A);
Down : IF (A AND $F) = $F THEN dec(A, 15) ELSE inc(A);
Left : IF A <= 15 THEN inc(A, 112) ELSE dec(A, 16);
Right: IF A >= 112 THEN dec(A, 112) ELSE inc(A, 16);
ESC : Done:=TRUE
END;
{ -- Restore previous color: }
IF Done OR (A <> PrevA) THEN RestoreBox(Row, Col)
UNTIL Done
END;
PROCEDURE EraseColorBox;
BEGIN IF W <> NIL
THEN BEGIN RestoreWindow(XL, YL, XL+4, YL+2, TRUE, B);
RestoreWindow(XL, YL, XH, YH, TRUE, W);
W:=NIL;
RestoreCursorState(XY, ScanLines)
END
END;
BEGIN { -- Initialisatie: }
W:=NIL
END (* TPcolor *).
{ -------- Test with the following program: -------- }
PROGRAM ColorboxTest;
USES TPcolor;
CONST XLB = 5;
YLB = 5;
VAR xh, yh, attr: byte;
BEGIN IF NOT InitColorBox(XLB, YLB, xh, yh)
THEN BEGIN write(#7'Colorbox too big for screen !'); halt END;
attr:=$00; { -- Do not omit. }
SelectNewColor(attr);
EraseColorBox
END.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The following unit is public domain:
UNIT OpKey;
{ -- Keystroke definitions. }
{*********************************************************}
{* OPKEY.PAS 1.03 *}
{* TurboPower Software 1990. *}
{* Released to the public domain. *}
{*********************************************************}
INTERFACE
{Notes:
* keys returned only with OPCRT or OPENHKBD enhanced keyboard support
# keys returned only with OPENHKBD extra key support }
CONST
{ -- Function keys: }
F1 = $3B00; ShF1 = $5400; CtrlF1 = $5E00; AltF1 = $6800;
F2 = $3C00; ShF2 = $5500; CtrlF2 = $5F00; AltF2 = $6900;
F3 = $3D00; ShF3 = $5600; CtrlF3 = $6000; AltF3 = $6A00;
F4 = $3E00; ShF4 = $5700; CtrlF4 = $6100; AltF4 = $6B00;
F5 = $3F00; ShF5 = $5800; CtrlF5 = $6200; AltF5 = $6C00;
F6 = $4000; ShF6 = $5900; CtrlF6 = $6300; AltF6 = $6D00;
F7 = $4100; ShF7 = $5A00; CtrlF7 = $6400; AltF7 = $6E00;
F8 = $4200; ShF8 = $5B00; CtrlF8 = $6500; AltF8 = $6F00;
F9 = $4300; ShF9 = $5C00; CtrlF9 = $6600; AltF9 = $7000;
F10 = $4400; ShF10 = $5D00; CtrlF10 = $6700; AltF10 = $7100;
F11 = $8500;{*} ShF11 = $8700;{*} CtrlF11 = $8900;{*} AltF11 =
$8B00;{*} F12 = $8600;{*} ShF12 = $8800;{*} CtrlF12 = $8A00;{*} AltF12 =
$8C00;{*}
{ -- Numeric keypad: }
{ -- Note that ShUp is an "8", ShPad5 is a "5", and so on. }
Up = $4800; ShUp = $4838; CtrlUp = $8D00;{*} AltUp =
$9800;{#} Down = $5000; ShDown = $5032; CtrlDown = $9100;{*} AltDown =
$A000;{#} Left = $4B00; ShLeft = $4B34; CtrlLeft = $7300; AltLeft =
$9B00;{#} Right = $4D00; ShRight = $4D36; CtrlRight = $7400; AltRight =
$9D00;{#} Home = $4700; ShHome = $4737; CtrlHome = $7700; AltHome =
$9700;{#}EndKey = $4F00; ShEnd = $4F31; CtrlEnd = $7500; AltEnd =
$9F00;{#} PgUp = $4900; ShPgUp = $4939; CtrlPgUp = $8400; AltPgUp =
$9900;{#} PgDn = $5100; ShPgDn = $5133; CtrlPgDn = $7600; AltPgDn =
$A100;{#} Ins = $5200; ShIns = $5230; CtrlIns = $9200;{*} AltIns =
$A200;{#} Del = $5300; ShDel = $532E; CtrlDel = $9300;{*} AltDel =
$A300;{#} Pad5 = $4C00;{*} ShPad5 = $4C35; CtrlPad5 = $8F00;{*} AltPad5 =
$9C00;{#}
{ -- Alphabetic keys: }
LowA = $1E61; UpA = $1E41; CtrlA = $1E01; AltA = $1E00;
LowB = $3062; UpB = $3042; CtrlB = $3002; AltB = $3000;
LowC = $2E63; UpC = $2E43; CtrlC = $2E03; AltC = $2E00;
LowD = $2064; UpD = $2044; CtrlD = $2004; AltD = $2000;
LowE = $1265; UpE = $1245; CtrlE = $1205; AltE = $1200;
LowF = $2166; UpF = $2146; CtrlF = $2106; AltF = $2100;
LowG = $2267; UpG = $2247; CtrlG = $2207; AltG = $2200;
LowH = $2368; UpH = $2348; CtrlH = $2308; AltH = $2300;
LowI = $1769; UpI = $1749; CtrlI = $1709; AltI = $1700;
LowJ = $246A; UpJ = $244A; CtrlJ = $240A; AltJ = $2400;
LowK = $256B; UpK = $254B; CtrlK = $250B; AltK = $2500;
LowL = $266C; UpL = $264C; CtrlL = $260C; AltL = $2600;
LowM = $326D; UpM = $324D; CtrlM = $320D; AltM = $3200;
LowN = $316E; UpN = $314E; CtrlN = $310E; AltN = $3100;
LowO = $186F; UpO = $184F; CtrlO = $180F; AltO = $1800;
LowP = $1970; UpP = $1950; CtrlP = $1910; AltP = $1900;
LowQ = $1071; UpQ = $1051; CtrlQ = $1011; AltQ = $1000;
LowR = $1372; UpR = $1352; CtrlR = $1312; AltR = $1300;
LowS = $1F73; UpS = $1F53; CtrlS = $1F13; AltS = $1F00;
LowT = $1474; UpT = $1454; CtrlT = $1414; AltT = $1400;
LowU = $1675; UpU = $1655; CtrlU = $1615; AltU = $1600;
LowV = $2F76; UpV = $2F56; CtrlV = $2F16; AltV = $2F00;
LowW = $1177; UpW = $1157; CtrlW = $1117; AltW = $1100;
LowX = $2D78; UpX = $2D58; CtrlX = $2D18; AltX = $2D00;
LowY = $1579; UpY = $1559; CtrlY = $1519; AltY = $1500;
LowZ = $2C7A; UpZ = $2C5A; CtrlZ = $2C1A; AltZ = $2C00;
{ -- Number keys, on top row of keyboard: }
Num1 = $0231; Alt1 = $7800;
Num2 = $0332; Ctrl2 = $0300; Alt2 = $7900;
Num3 = $0433; Alt3 = $7A00;
Num4 = $0534; Alt4 = $7B00;
Num5 = $0635; Alt5 = $7C00;
Num6 = $0736; Ctrl6 = $071E; Alt6 = $7D00;
Num7 = $0837; Alt7 = $7E00;
Num8 = $0938; Alt8 = $7F00;
Num9 = $0A39; Alt9 = $8000;
Num0 = $0B30; Alt0 = $8100;
{ -- Miscellaneous: }
Space = $3920; {!!.03}
BkSp = $0E08; CtrlBkSp = $0E7F; AltBkSp =
$0E00;{*} Tab = $0F09; ShTab = $0F00; CtrlTab = $9400;{*} AltTab =
$A500;{*} Enter = $1C0D; CtrlEnter= $1C0A; AltEnter =
$1C00;{*} Esc = $011B; AltEsc =
$0100;{*}
Minus = $0C2D; CtrlMinus = $0C1F; AltMinus = $8200;
Plus = $0D2B; AltPlus = $8300;
PadMinus = $4A2D; CtrlPadMinus = $8E00;{*} AltPadMinus=
$4A00;{#} PadPlus = $4E2B; CtrlPadPlus = $9000;{*} AltPadPlus =
$4E00;{#} Star = $092A;
PadStar = $372A; AltPadStar =
$3700;{#}
CtrlBreak = $0000;
{ -- The following are the standard hardware scan codes (in hex) generated
-- by the keyboard. This table is especially useful for calculating
-- TSR hotkeys: }
CONST hsc_Esc = $01;
hsc_1 = $02;
hsc_2 = $03;
hsc_3 = $04;
hsc_4 = $05;
hsc_5 = $06;
hsc_6 = $07;
hsc_7 = $08;
hsc_8 = $09;
hsc_9 = $0A;
hsc_0 = $0B;
hsc_Minus = $0C; { -- '-'. }
hsc_Equals = $0D; { -- '='. }
hsc_Bksp = $0E;
hsc_Tab = $0F;
hsc_Q = $10;
hsc_W = $11;
hsc_E = $12;
hsc_R = $13;
hsc_T = $14;
hsc_Y = $15;
hsc_U = $16;
hsc_I = $17;
hsc_O = $18;
hsc_P = $19;
hsc_LtBrack = $1A; { -- '['. }
hsc_RtBrack = $1B; { -- ']'. }
hsc_Enter = $1C;
hsc_Ctrl = $1D;
hsc_A = $1E;
hsc_S = $1F;
hsc_D = $20;
hsc_F = $21;
hsc_G = $22;
hsc_H = $23;
hsc_J = $24;
hsc_K = $25;
hsc_L = $26;
hsc_SemiCol = $27; { -- ';'. }
hsc_Quote = $28; { -- ''', onder het aanhalingsteken. }
hsc_Tilde = $29; { -- '`', onder de tilde (linksboven). }
hsc_LtShift = $2A;
hsc_BkSlash = $2B; { -- '\'. }
hsc_Z = $2C;
hsc_X = $2D;
hsc_C = $2E;
hsc_V = $2F;
hsc_B = $30;
hsc_N = $31;
hsc_M = $32;
hsc_Comma = $33; { -- ','. }
hsc_Period = $34; { -- '.' }
hsc_Slash = $35; { -- '/'. }
hsc_RtShift = $36;
hsc_PrtSc = $37;
hsc_Alt = $38;
hsc_Space = $39;
hsc_CapsLock = $3A;
hsc_F1 = $3B;
hsc_F2 = $3C;
hsc_F3 = $3D;
hsc_F4 = $3E;
hsc_F5 = $3F;
hsc_F6 = $40;
hsc_F7 = $41;
hsc_F8 = $42;
hsc_F9 = $43;
hsc_F10 = $44;
hsc_NumLock = $45;
hsc_ScrLock = $46;
hsc_Home = $47;
hsc_Up = $48;
hsc_PgUp = $49;
hsc_PadMinus = $4A;
hsc_Left = $4B;
hsc_Center = $4C;
hsc_Right = $4D;
hsc_Plus = $4E;
hsc_End = $4F;
hsc_Down = $50;
hsc_PgDn = $51;
hsc_Ins = $52;
hsc_Del = $53;
hsc_SysReq = $54;
hsc_F11 = $57;
hsc_F12 = $58;
{ -- Range of "hsc"-constants: }
hsc_minimum = hsc_Esc;
hsc_maximum = hsc_F12;
{ ------------------------------------------------------------------ }
IMPLEMENTATION
END (* OPkey *).
If you do not own unit TPcrt (or OPcrt), this is the "interface" of
procedure OpCrt.FastWrite(St : string; Row, Col : Word; Attr : Byte);
Write St at Row,Col in Attr (video attributes) without snow.
[Back to CRT SWAG index] [Back to Main SWAG index] [Original]