368 lines
10 KiB
Plaintext
368 lines
10 KiB
Plaintext
unit GUI;
|
||
|
||
|
||
interface
|
||
uses Crt, Graph, DOS;
|
||
const cc: array[0..15,0..2] of byte =
|
||
(($00,$00,$00),($00,$00,$80),($00,$80,$00),($00,$80,$80),($80,$00,$00),
|
||
($80,$00,$80),($FF,$80,$00),($C0,$C0,$C0),($80,$80,$80),($00,$00,$FF),
|
||
($00,$FF,$00),($00,$FF,$FF),($FF,$00,$00),($FF,$00,$FF),($FF,$FF,$00),
|
||
($FF,$FF,$FF));
|
||
buttondelay:integer=200;
|
||
initp_del:integer=0;
|
||
fo_del:integer=3;
|
||
gui_dis:boolean=false;
|
||
var ch,cm,cs,css: word;
|
||
mb, mx, my: integer;
|
||
oldstat: string;
|
||
om: word;
|
||
procedure InitPalette;
|
||
procedure FadeOut;
|
||
function MouseReset: boolean;
|
||
procedure ShowMouse(mode: boolean);
|
||
procedure MouseStat(var x,y,b: integer);
|
||
function MouseOver(x1,y1,x2,y2: integer): boolean;
|
||
procedure Frame(x1,y1,x2,y2: integer; b,p,s,t: shortint; bo: boolean);
|
||
procedure MakeWindow(x1,y1,x2,y2: integer; title: string);
|
||
procedure MakeButton(x1,y1,x2,y2: integer; msg: string);
|
||
procedure MakeBeveledButton(x1,y1,x2,y2: integer; msg: string);
|
||
procedure MakeRadiobutton(x,y: integer; msg: string);
|
||
procedure MakeBevRadiobutton(x,y: integer; msg: string);
|
||
procedure Alert(msg: string);
|
||
procedure StatusTime(jow: boolean);
|
||
procedure ClearStatus;
|
||
procedure Status(txt: string);
|
||
|
||
|
||
implementation
|
||
|
||
procedure InitPalette;
|
||
var i,k: byte;
|
||
begin
|
||
for i:=0 to 15 do begin
|
||
case i of
|
||
6: k := 20;
|
||
8: k := 56;
|
||
9: k := 57;
|
||
10: k := 58;
|
||
11: k := 59;
|
||
12: k := 60;
|
||
13: k := 61;
|
||
14: k := 62;
|
||
15: k := 63;
|
||
else
|
||
k := i;
|
||
end;
|
||
SetRGBPalette(k,cc[i,0] DIV 4,cc[i,1] DIV 4,cc[i,2] DIV 4);
|
||
Delay(initp_del);
|
||
end;
|
||
end;
|
||
|
||
procedure FadeOut;
|
||
const step=10;
|
||
var i,j,k: byte;
|
||
r,g,b: integer;
|
||
dead: array[0..15] of boolean;
|
||
begin
|
||
for i:=0 to 15 do dead[i]:=false;
|
||
for i:=0 to (256 DIV step) do begin
|
||
for j:=0 to 15 do begin
|
||
r := cc[j,0]-i*step; if r<0 then r:=0;
|
||
g := cc[j,1]-i*step; if g<0 then g:=0;
|
||
b := cc[j,2]-i*step; if b<0 then b:=0;
|
||
r := (r DIV 4);
|
||
g := (g DIV 4);
|
||
b := (b DIV 4);
|
||
case j of
|
||
6: k := 20;
|
||
8: k := 56;
|
||
9: k := 57;
|
||
10: k := 58;
|
||
11: k := 59;
|
||
12: k := 60;
|
||
13: k := 61;
|
||
14: k := 62;
|
||
15: k := 63;
|
||
else
|
||
k := j;
|
||
end;
|
||
if NOT dead[j] then SetRGBPalette(k,r,g,b);
|
||
if (r=0) AND (g=0) AND (b=0) then dead[j]:=true;
|
||
end;
|
||
Delay(fo_del);
|
||
end;
|
||
end;
|
||
|
||
{###########################################################################
|
||
#### Mouse procedures following ####
|
||
###########################################################################}
|
||
|
||
function MouseReset: boolean;
|
||
var regs: registers;
|
||
begin
|
||
MouseReset := false;
|
||
regs.ax := 0; regs.bx := 0;
|
||
Intr($33,regs);
|
||
if regs.ax=$FFFF then MouseReset := true;
|
||
end;
|
||
|
||
procedure ShowMouse(mode: boolean);
|
||
var regs: registers;
|
||
begin
|
||
if mode then regs.ax:=1 else regs.ax:=2;
|
||
Intr($33,regs);
|
||
end;
|
||
|
||
procedure MouseStat(var x,y,b: integer);
|
||
var regs: registers;
|
||
begin
|
||
regs.ax := 3;
|
||
Intr($33,regs);
|
||
with regs do begin
|
||
x := cx;
|
||
y := dx;
|
||
b := bx; { 1-left button; 2-right button; 4-middle button }
|
||
end;
|
||
end;
|
||
|
||
function MouseOver(x1,y1,x2,y2: integer): boolean;
|
||
begin
|
||
if (mx>=x1) AND (mx<=x2) AND (my>=y1) AND (my<=y2) then MouseOver:=true else MouseOver:=false;
|
||
end;
|
||
|
||
{###########################################################################
|
||
#### Window make procedures following ####
|
||
###########################################################################}
|
||
|
||
procedure Frame(x1,y1,x2,y2: integer; b,p,s,t: shortint; bo: boolean);
|
||
{ Parameters:
|
||
x1 y1 x2 y2 - Coordinates of Frame
|
||
b - blend color
|
||
p - pattern color
|
||
s - shadow color
|
||
t - thickness }
|
||
var slice: byte;
|
||
begin
|
||
if bo then begin
|
||
SetColor(0);
|
||
Rectangle(x1,y1,x2,y2);
|
||
slice := 1;
|
||
end else slice := 0;
|
||
SetFillStyle(SolidFill,p);
|
||
case t of
|
||
2: begin
|
||
SetColor(b);
|
||
MoveTo(x1+slice,y1+slice);
|
||
LineTo(x1+slice,y2-slice-1); LineTo(x1+slice+1,y2-slice-2); LineTo(x1+slice+1,y1+slice);
|
||
LineTo(x2-slice,y1+slice); LineTo(x2-slice-1,y1+slice+1); LineTo(x1+slice,y1+slice+1);
|
||
SetColor(s);
|
||
MoveTo(x2-slice,y2-slice);
|
||
LineTo(x2-slice,y1+slice+1); LineTo(x2-slice-1,y1+slice+2); LineTo(x2-slice-1,y2-slice);
|
||
LineTo(x1+slice,y2-slice); LineTo(x1+slice+1,y2-slice-1); LineTo(x2-slice,y2-slice-1);
|
||
Bar(x1+slice+2,y1+slice+2,x2-slice-2,y2-slice-2);
|
||
end;
|
||
1: begin
|
||
SetColor(b);
|
||
MoveTo(x2-slice,y1+slice);
|
||
LineTo(x1+slice,y1+slice); LineTo(x1+slice,y2-slice);
|
||
SetColor(s);
|
||
MoveTo(x2-slice,y1+slice+1);
|
||
LineTo(x2-slice,y2-slice); LineTo(x1+slice+1,y2-slice);
|
||
Bar(x1+slice+1,y1+slice+1,x2-slice-1,y2-slice-1);
|
||
end;
|
||
end;
|
||
SetColor(0); MoveTo(150,30);
|
||
end;
|
||
|
||
procedure MakeWindow(x1,y1,x2,y2: integer; title: string);
|
||
begin
|
||
Frame(x1,y1,x2,y2,15,7,8,2,true);
|
||
Frame(x1+3,y1+3,x2-3,y1+20,8,1,15,1,false);
|
||
SetTextJustify(CenterText,CenterText);
|
||
SetTextStyle(SmallFont,HorizDir,5);
|
||
SetViewPort(x1+4,y1+3,x2-4,y1+19,ClipOn);
|
||
SetColor(8); OutTextXY(((x2-x1-8) DIV 2)+1,7+1,title);
|
||
SetColor(15); OutTextXY(((x2-x1-8) DIV 2)-1,7-1,title);
|
||
SetColor(7); OutTextXY(((x2-x1-8) DIV 2),7,title);
|
||
SetViewPort(0,0,639,479,ClipOff);
|
||
end;
|
||
|
||
procedure MakeButton(x1,y1,x2,y2: integer; msg: string);
|
||
begin
|
||
ShowMouse(false);
|
||
SetFillStyle(SolidFill,7);
|
||
Bar(x1,y1,x2+1,y2+1);
|
||
Frame(x1,y1,x2,y2,15,7,8,1,false);
|
||
SetTextJustify(CenterText,CenterText);
|
||
SetTextStyle(SmallFont,HorizDir,5);
|
||
if (NOT gui_dis) then SetColor(0) else SetColor(8);
|
||
SetViewPort(x1+1,y1+1,x2-1,y2-1,ClipOn);
|
||
OutTextXY((x2-x1-2) DIV 2+1,(y2-y1-2) DIV 2-2,msg);
|
||
OutTextXY((x2-x1-2) DIV 2,(y2-y1-2) DIV 2-2,msg);
|
||
SetViewPort(0,0,639,479,ClipOff);
|
||
ShowMouse(true);
|
||
end;
|
||
|
||
|
||
procedure MakeBeveledButton(x1,y1,x2,y2: integer; msg: string);
|
||
begin
|
||
ShowMouse(false);
|
||
SetFillStyle(SolidFill,7);
|
||
Bar(x1,y1,x2+1,y2+1);
|
||
Frame(x1+1,y1+1,x2+1,y2+1,8,7,15,1,false);
|
||
SetTextJustify(CenterText,CenterText);
|
||
SetTextStyle(SmallFont,HorizDir,4);
|
||
if (NOT gui_dis) then SetColor(0) else SetColor(8);
|
||
SetViewPort(x1+2,y1+2,x2,y2,ClipOn);
|
||
OutTextXY((x2-x1-2) DIV 2+1,(y2-y1-2) DIV 2-1,msg);
|
||
SetViewPort(0,0,639,479,ClipOff);
|
||
ShowMouse(true);
|
||
end;
|
||
|
||
procedure MakeRadiobutton(x,y: integer; msg: string);
|
||
begin
|
||
ShowMouse(false);
|
||
MoveTo(x,y-4);
|
||
SetColor(8); LineTo(x+4,y); LineTo(x,y+4); LineTo(x-4,y);
|
||
if (NOT gui_dis) then SetColor(15); LineTo(x,y-4);
|
||
MoveTo(x,y-3);
|
||
SetColor(8); LineTo(x+3,y); LineTo(x,y+3); LineTo(x-3,y);
|
||
if (NOT gui_dis) then SetColor(15); LineTo(x,y-3);
|
||
SetTextStyle(SmallFont,HorizDir,4);
|
||
SetTextJustify(LeftText,CenterText);
|
||
if (NOT gui_dis) then SetColor(0) else SetColor(8);
|
||
OutTextXY(x+8,y-1,msg);
|
||
ShowMouse(true);
|
||
end;
|
||
|
||
procedure MakeBevRadiobutton(x,y: integer; msg: string);
|
||
begin
|
||
ShowMouse(false);
|
||
MoveTo(x,y-4);
|
||
SetColor(15); LineTo(x+4,y); LineTo(x,y+4); LineTo(x-4,y);
|
||
SetColor(8); LineTo(x,y-4);
|
||
MoveTo(x,y-3);
|
||
SetColor(15); LineTo(x+3,y); LineTo(x,y+3); LineTo(x-3,y);
|
||
SetColor(8); LineTo(x,y-3);
|
||
SetTextStyle(SmallFont,HorizDir,4);
|
||
SetTextJustify(LeftText,CenterText);
|
||
if (NOT gui_dis) then SetColor(0) else SetColor(8);
|
||
OutTextXY(x+8,y-1,msg);
|
||
ShowMouse(true);
|
||
end;
|
||
|
||
procedure Alert(msg: string);
|
||
var bg: array[150..489,200..280] of byte;
|
||
xl,xr: word;
|
||
bl,br: word;
|
||
i, j: word;
|
||
key: char;
|
||
begin
|
||
ShowMouse(false);
|
||
SetTextStyle(SmallFont,HorizDir,4);
|
||
SetTextJustify(CenterText,CenterText);
|
||
xl := Length(msg)*8 + 20;
|
||
xr := xl;
|
||
xl := 320 - xl DIV 2;
|
||
xr := 320 + xr DIV 2;
|
||
if xl<0 then xl := 0;
|
||
if xr>639 then xr := 639;
|
||
if xl>280 then xl := 280;
|
||
if xr<360 then xr := 360;
|
||
for j:=200 to 280 do begin
|
||
for i:=xl to xr do begin
|
||
bg[i,j] := GetPixel(i,j);
|
||
end;
|
||
end;
|
||
MakeWindow(xl,200,xr,280,'Alert');
|
||
if xl>260 then begin
|
||
bl := xl+10;
|
||
br := xr-10;
|
||
end else begin
|
||
bl := 300;
|
||
br := 340;
|
||
end;
|
||
MakeButton(bl,255,br,270,'OK');
|
||
SetViewPort(xl+3,225,xr-3,255,ClipOn);
|
||
OutTextXY((xr-xl-6) DIV 2,14,msg);
|
||
OutTextXY((xr-xl-6) DIV 2-1,14,msg);
|
||
SetViewPort(0,0,639,479,ClipOff);
|
||
Key := #00;
|
||
if (mb<>0) then repeat MouseStat(mx,my,mb); until (mb=0);
|
||
repeat
|
||
ShowMouse(true);
|
||
MouseStat(mx,my,mb);
|
||
if (keypressed) then Key := ReadKey;
|
||
until (MouseOver(bl,255,br,270) AND (mb<>0)) OR (key=#13) OR (key=#27);
|
||
ShowMouse(false);
|
||
MakeBeveledButton(bl,255,br,270,'OK');
|
||
repeat MouseStat(mx,my,mb); until (mb=0);
|
||
for j:=200 to 280 do begin
|
||
for i:=xl to xr do begin
|
||
PutPixel(i,j,bg[i,j]);
|
||
end;
|
||
end;
|
||
ShowMouse(true);
|
||
end;
|
||
|
||
{###########################################################################
|
||
#### Status bar procedures following ####
|
||
###########################################################################}
|
||
|
||
procedure StatusTime(jow: boolean);
|
||
var hs,ms,ot: string;
|
||
begin
|
||
GetTime(ch,cm,cs,css);
|
||
if (cm<>om) OR jow then begin
|
||
SetFillStyle(SolidFill,7);
|
||
Bar(593,469,637,477);
|
||
Str(ch:0,hs);
|
||
Str(cm:0,ms);
|
||
if (ch<10) then ot:='0' else ot:='';
|
||
ot:=ot+hs+':';
|
||
if (cm<10) then ot:=ot+'0';
|
||
ot:=ot+ms;
|
||
SetTextJustify(CenterText,CenterText);
|
||
SetTextStyle(SmallFont,HorizDir,4);
|
||
SetViewPort(592,468,638,478,ClipOn);
|
||
SetColor(8);
|
||
OutTextXY(24,4,ot);
|
||
SetColor(0);
|
||
OutTextXY(23,4,ot);
|
||
SetViewPort(0,0,639,479,ClipOff);
|
||
om := cm;
|
||
end;
|
||
end;
|
||
|
||
procedure ClearStatus;
|
||
begin
|
||
SetFillStyle(SolidFill,7);
|
||
Bar(0,467,639,479);
|
||
Frame(0,467,589,479,8,7,15,1,false);
|
||
Frame(591,467,639,479,8,7,15,1,false);
|
||
StatusTime(true);
|
||
oldstat := '';
|
||
end;
|
||
|
||
procedure Status(txt: string);
|
||
begin
|
||
if oldstat<>txt then begin
|
||
ShowMouse(false);
|
||
ClearStatus;
|
||
SetTextJustify(LeftText,CenterText);
|
||
SetTextStyle(SmallFont,HorizDir,4);
|
||
SetViewPort(1,468,638,478,ClipOn);
|
||
SetColor(0);
|
||
OutTextXY(10,4,txt);
|
||
SetViewPort(0,0,639,479,ClipOff);
|
||
oldstat := txt;
|
||
ShowMouse(true);
|
||
end;
|
||
end;
|
||
|
||
|
||
|
||
|
||
begin
|
||
WriteLn('<27> Loading Unit: GUI - Markus Birth <mbirth@webwriters.de>');
|
||
end. |