Subject: Re: Mouse in Pascal
Date: Thu, 2 Jul 1998 12:09:51 +0200
From: "Mardirossian"
Organization: particulier
Newsgroups: borland.public.turbopascal
(* version limit.*)
{$DEFINE DEBUG}
{$IFDEF DEBUG}
{$I-,D+,L+,Y+,A+,X+,R+,G-}
{$ELSE}
{$I-,D-,L-,Y-,A+,X+,R-,G-}
{$ENDIF}
Uses
graph,dos,crt;
Const
cham :
Array[0..31] Of Word = (
$83FF, $13FF, $03FF, $E333, $F201, $F200, $F000, $F800,
$FC00, $FE70, $FEF9, $FEFD, $FEFD, $FEFD, $FEFD, $FDF9,
$7C00, $EC00, $FC00, $1CCC, $0DFE, $0DFF, $0FFF, $07FF,
$03FF, $018F, $0106, $0102, $0102, $0102, $0102, $0206);
Type
ButtonType = (Up, Dn);
RadioType = (Sel, NotSel);
OutputType = (c, Pascal, Fortran, Basic);
TColor = (Black, White, Transp, Invert);
WBit = 0..15;
type mouse = object
r : registers;
iposx, iposy : integer;
isttb : integer;
present : boolean;
iaspect : integer;
procedure pb;
procedure mouse;
procedure aspect;
procedure aspect2;
function ispresent : boolean;
function posx : integer;
function posy : integer;
function sttb : integer;
procedure show(status : boolean);
procedure defwin(minc, minl, maxc, maxl : integer);
procedure boutons(interu : integer;
var nb_bout, pos_x, pos_y : integer);
end;
Const
Output : OutputType = Pascal;
Color : TColor = Black;
Const
OutputName : String = 'CURSOR';
xmaxvideo:integer=0;
ymaxvideo:integer=0;
Var
fF : FILE;
Mot_Passe : STRING;
NPg,N : WORD;
Taille_Fichier,
Taille_EXE : LONGINT;
F : Text;
FullCursor : Array[0..15,0..15] Of TColor;
Cursor : Array[0..31] Of Word;
fset : fillsettingstype;
m : mouse;
nomfich:string;
fill : integer;
colrec : word;
x,y:integer;
attr:word;
procedure makerectr(x, y, longe, haut, coulav, motif, coulremp :
integer);
var c : integer;
begin
c := getcolor;
getfillsettings(fset);
setfillstyle(motif, coulremp);
setcolor(coulav);
bar(x, y, x + longe, y + haut);
rectangle(x, y, x + longe, y + haut);
setfillstyle(fset.pattern, fset.color);
setcolor(c);
end;
Procedure Button(State : ButtonType; PosX, PosY, Width : Integer;
Text : String);
Var
Len : Integer;
Begin
Len := Length(Text);
Case State Of
Up : Begin
randomize;
(* makerectr(posx+2,posy+2,48+len*8,22,7,solidfill,random(254)+1);
9*)
makerectr(posx+2,posy+2,48+len*8,22,7,solidfill,9); (*9*)
setcolor(0);
line(PosX+2, PosY+22,PosX+48+Len*8, PosY+22);
line(PosX+2, PosY+2,PosX+2, PosY+22);
setcolor(15);
line(PosX+2, PosY+2,PosX+48+Len*8, PosY+2);
line(PosX+48+len*8, PosY+2,PosX+48+len*8, PosY+22);
setcolor(3);
moveto(PosX + 8, PosY + 4);(*10*)
outtext(Text);
End;
Dn : Begin
makerectr(posx+2,posy+2,48+len*8,22,7,solidfill,9);
setcolor(15);
line(PosX+2, PosY+22,PosX+48+Len*8, PosY+22);
line(PosX+2, PosY+2,PosX+2, PosY+22);
setcolor(0);
line(PosX+2, PosY+2,PosX+48+Len*8, PosY+2);
line(PosX+48+len*8, PosY+2,PosX+48+len*8, PosY+22);
(* setcolor(8);*)
moveto(PosX + 9, PosY + 4);(*11*)
setcolor(3);
outtext(Text);
End;
End;
End;
Procedure RadioButton(State : RadioType; PosX, PosY : Integer;
Text : String);
Var
Len : Integer;
Begin
Len := Length(Text);
Case State Of
Sel : Begin
setcolor(3);
moveto(PosX+5,PosY+5);
circle(posx+5,posy+8,8);
setcolor(15);
colrec:=15;
fill := SOLIDFILL;
setfillstyle(fill, colrec);
circle(posx+5,posy+8,4);
floodfill(posx+5, posy+8, 15);
moveto(PosX + 17, PosY + 2);
setcolor(2);
outtext(Text);
End;
NotSel : Begin
setcolor(3);
moveto(PosX+5,PosY+5);
circle(posx+5,posy+8,8);
setcolor(7);colrec:=7;
fill := SOLIDFILL;
setfillstyle(fill, colrec);
circle(posx+5,posy+8,4);
floodfill(posx+4, posy+7, 7);
moveto(PosX + 17, PosY +2);
setcolor(14);
outtext(Text);
End;
End;
End;
Procedure GroupBox(X,Y,textWidth,textHeight : Integer; Text : String);
Var
Len : Integer;
Begin
Len := Length(Text);
moveto(X,Y);
setcolor(8);
setcolor(4);
rectangle(X+3,Y-4,X+6+Len*8,Y+4);
setcolor(9);
moveto(X+6,Y+3);
outtext(Text);
End;
Procedure DrawGrid;
Begin
setcolor(8);
makerectr(160,80,210,196,7,solidfill,7);
setcolor(8);
line(352,80,352,272);
line(340,80,340,272);
line(328,80,328,272);
line(316,80,316,272);
line(304,80,304,272);
line(292,80,292,272);
line(280,80,280,272);
line(268,80,268,272);
line(256,80,256,272);
line(244,80,244,272);
line(232,80,232,272);
line(220,80,220,272);
line(208,80,208,272);
line(196,80,196,272);
line(184,80,184,272);
line(172,80,172,272);
line(160,80,160,272);
line(160,272,352,272);
line(160,260,352,260);
line(160,248,352,248);
line(160,236,352,236);
line(160,224,352,224);
line(160,212,352,212);
line(160,200,352,200);
line(160,188,352,188);
line(160,176,352,176);
line(160,164,352,164);
line(160,152,352,152);
line(160,140,352,140);
line(160,128,352,128);
line(160,116,352,116);
line(160,104,352,104);
line(160,92,352,92);
line(160,80,352,80);
End;
Procedure BuildUI;
Begin
makerectr(0,13,getmaxx,getmaxy-13,7,solidfill,7);
setcolor(1);
makerectr(0,0,getmaxx,25,1,solidfill,1);
setcolor(7);
makerectr(0,getmaxy-25,getmaxx,getmaxy,1,solidfill,1);
setcolor(11);
moveto(6,8);
outtext('Cursor Editor 1.00');
moveto(6,462);
outtext('Source code : ');
moveto(220,460);
outtext('CURSOR.CUR');
setcolor(14);
moveto(4,6);(*10*)
outtext('Cursor Editor 1.00');
moveto(5,460);
outtext('Source code : ');
Button(Up,5,60,56,'Save ');
Button(Up,5,90,56,'Clear');
Button(Up,5,120,56,'Load ');
Button(Up,5,150,56,'Exit ');
RadioButton(Sel,7,330,'Pascal');
RadioButton(NotSel,7,354,'c');
RadioButton(NotSel,7,378,'Fortran');
RadioButton(NotSel,7,402,'Basic');
RadioButton(Sel,536,330,'Black');
RadioButton(NotSel,536,354,'White');
RadioButton(NotSel,536,378,'Transp');
RadioButton(NotSel,536,402,'Invert');
DrawGrid;
m.show(true);
End;
Function HexWord(W : Word) : String;
Const
Digits : Array[0..$F] Of Char = '0123456789ABCDEF';
Begin
HexWord[0] := #4;
HexWord[1] := Digits[Hi(W) Shr 4];
HexWord[2] := Digits[Hi(W) And $F];
HexWord[3] := Digits[Lo(W) Shr 4];
HexWord[4] := Digits[Lo(W) And $F];
End;
Procedure SavePas(s : string);
Var
I, J, K : Integer;
Begin
Assign(F, s);
Rewrite(F);
For I := 0 To 3 Do
begin
For J := 0 To 7 Do
begin
K := (I * 8) + J;
Write(F,'$',HexWord(Cursor[K]),' ');
end;
WriteLn(F);
end;
Close(F);
End;
Procedure load_cursor(s : string);
Var
M : word;
I, J, K, L, num_ligne, tilex, tiley : Integer;
Begin
Assign(F, s);
Reset(F);
For I := 0 To 3 Do
begin
For J := 0 To 7 Do
begin
K := (I * 8) + J;
read(F, Cursor[K]);
if ( i < 2 ) then
begin
num_ligne := k;
for l := 0 to 15 do
begin
m := cursor[k] shr l;
if ( (m mod 2) = 0 ) then
fullcursor[15 - l, num_ligne] := black;
end;
end
else if ( i >= 2 ) then
begin
num_ligne := ((I - 2) * 8) + J;
for l := 0 to 15 do
begin
m := cursor[k] shr l;
if ( (m mod 2) = 1 ) then
begin
if ( fullcursor[15 - l, num_ligne] = black) then
fullcursor[15 - l, num_ligne] := white
else
fullcursor[15 - l, num_ligne] := invert;
end;
end;
end;
end;
readln(F);
end;
Close(F);
for i := 0 to 15 do
for j := 0 to 15 do
begin
Color := fullcursor[i, j];
Case Color Of
Black : setcolor(0);
White : setcolor(15);
Transp : setcolor(7);
Invert : setcolor(3);
End;
TileX := i;
TileY := j;
rectangle(111+TileX*6,31+TileY*6,115+TileX*6,35+TileY*6);
putpixel(569+TileX,36+TileY,4);
end;
End;
Procedure SaveC;
Var
I : Integer;
Begin
Assign(F,OutputName + '.C');
Rewrite(F);
WriteLn(F);
Write(F,'short mycursor[] = {');
For I := 0 To 7 Do
Write(F,'0x',HexWord(Cursor[I]),',');
WriteLn(F);
Write(F,' ');
For I := 8 To 15 Do
Write(F,'0x',HexWord(Cursor[I]),',');
WriteLn(F);
Write(F,' ');
For I := 16 To 23 Do
Write(F,'0x',HexWord(Cursor[I]),',');
WriteLn(F);
Write(F,' ');
For I := 24 To 30 Do
Write(F,'0x',HexWord(Cursor[I]),',');
WriteLn(F,'0x',HexWord(Cursor[31]),'};');
WriteLn(F);
Close(F);
End;
Procedure SaveFor;
Var
I : Integer;
Begin
Assign(F,OutputName + '.FOR');
Rewrite(F);
WriteLn(F);
WriteLn(F,' INTEGER*2 MYCURSOR(32)');
WriteLn(F);
WriteLn(F,' DATA MYCURSOR /');
Write(F,' + ');
For I := 0 To 7 Do
Write(F,'#',HexWord(Cursor[I]),',');
WriteLn(F);
Write(F,' + ');
For I := 8 To 15 Do
Write(F,'#',HexWord(Cursor[I]),',');
WriteLn(F);
Write(F,' + ');
For I := 16 To 23 Do
Write(F,'#',HexWord(Cursor[I]),',');
WriteLn(F);
Write(F,' + ');
For I := 24 To 30 Do
Write(F,'#',HexWord(Cursor[I]),',');
WriteLn(F,'#',HexWord(Cursor[31]),'/');
WriteLn(F);
Close(F);
End;
Procedure load_cursor2(s : string);
Var
W : word;
I, J, K, L, num_ligne, tilex, tiley : Integer;
Begin
m.show(false);
Assign(F, s);
Reset(F);
For I := 0 To 3 Do
begin
For J := 0 To 7 Do
begin
K := (I * 8) + J;
read(F, Cursor[K]);
if ( i < 2 ) then
begin
num_ligne := k;
for l := 0 to 15 do
begin
w := cursor[k] shr l;
if ( (w mod 2) = 0 ) then
fullcursor[15 - l, num_ligne] := black;
end;
end
else if ( i >= 2 ) then
begin
num_ligne := ((I - 2) * 8) + J;
for l := 0 to 15 do
begin
w := cursor[k] shr l;
if ( (w mod 2) = 1 ) then
begin
if ( fullcursor[15 - l, num_ligne] = black) then
fullcursor[15 - l, num_ligne] := white
else
fullcursor[15 - l, num_ligne] := invert;
end;
end;
end;
end;
readln(F);
end;
Close(F);
for i := 0 to 15 do
for j := 0 to 15 do
begin
Color := fullcursor[i, j];
Case Color Of
Black : begin
setcolor(0);
colrec := 0;
end;
White : begin
setcolor(15);
colrec := 15;
end;
Transp : begin
setcolor(7);
colrec := 7;
end;
Invert : begin
setcolor(3);
colrec := 3;
end;
End;
TileX := i;
TileY := j;
fill := SOLIDFILL;
setfillstyle(fill, colrec);
rectangle(161+TileX*12,81+TileY*12,171+TileX*12,91+TileY*12);
floodfill(162+TileX*12,82+TileY*12, colrec);
rectangle(569+tilex,36+tiley,569+tilex,36+tiley);
end;
m.aspect;
m.show(true);
End;
Procedure load_cursor22;
Var
W : word;
I, J, K, L, num_ligne, tilex, tiley : Integer;
Begin
m.show(false);
For I := 0 To 3 Do
begin
For J := 0 To 7 Do
begin
K := (I * 8) + J;
if ( i < 2 ) then
begin
num_ligne := k;
for l := 0 to 15 do
begin
w := cham[k] shr l;
if ( (w mod 2) = 0 ) then
fullcursor[15 - l, num_ligne] := black;
end;
end
else if ( i >= 2 ) then
begin
num_ligne := ((I - 2) * 8) + J;
for l := 0 to 15 do
begin
w := cham[k] shr l;
if ( (w mod 2) = 1 ) then
begin
if ( fullcursor[15 - l, num_ligne] = black) then
fullcursor[15 - l, num_ligne] := white
else
fullcursor[15 - l, num_ligne] := invert;
end;
end;
end;
end;
end;
for i := 0 to 15 do
for j := 0 to 15 do
begin
Color := fullcursor[i, j];
Case Color Of
Black : begin
setcolor(0);
colrec := 0;
end;
White : begin
setcolor(15);
colrec := 15;
end;
Transp : begin
setcolor(7);
colrec := 7;
end;
Invert : begin
setcolor(3);
colrec := 3;
end;
End;
TileX := i;
TileY := j;
fill := SOLIDFILL;
setfillstyle(fill, colrec);
rectangle(161+TileX*12,81+TileY*12,171+TileX*12,91+TileY*12);
floodfill(162+TileX*12,82+TileY*12, colrec);
rectangle(569+tilex,36+tiley,569+tilex,36+tiley);
end;
m.aspect2;
m.show(true);
End;
Procedure SaveBas;
Var
I : Integer;
Begin
Assign(F,OutputName + '.BAS');
Rewrite(F);
WriteLn(F);
WriteLn(F,'DIM MyCursor(32)');
WriteLn(F);
WriteLn(F,'Rem MyCursor values');
Write(F,'DATA ');
For I := 0 To 7 Do
Write(F,'&',HexWord(Cursor[I]),',');
WriteLn(F);
Write(F,'DATA ');
For I := 8 To 15 Do
Write(F,'&',HexWord(Cursor[I]),',');
WriteLn(F);
Write(F,'DATA ');
For I := 16 To 23 Do
Write(F,'&',HexWord(Cursor[I]),',');
WriteLn(F);
Write(F,'DATA ');
For I := 24 To 30 Do
Write(F,'&',HexWord(Cursor[I]),',');
WriteLn(F,'&',HexWord(Cursor[31]));
WriteLn(F);
Close(F);
End;
Procedure CalcCursor;
Procedure SetBitW(Var W : Word; Bit : WBit);Assembler;
Asm
Mov Cl, Bit
Mov BX, 1
SHL BX, CL
LES DI, W
OR ES:[DI], BX
End;
Var
I, J : Integer;
Begin
FillChar(Cursor,SizeOf(Cursor),0);
For I := 0 To 15 Do
For J := 0 To 15 Do
Case FullCursor[I,J] Of
White : SetBitW(Cursor[J+16],15-I);
Transp : SetBitW(Cursor[J],15-I);
Invert : Begin
SetBitW(Cursor[J+16],15-I);
SetBitW(Cursor[J],15-I);
End;
End;
End;
procedure Mouse.pb;
begin
r.ax := 3;
intr($33, r);
iposx := r.cx;
iposy := r.dx;
isttb := r.bx;
end;
function Mouse.ispresent : boolean;
begin
ispresent := present;
end;
procedure Mouse.Mouse;
begin
r.ax := 0;
intr($33, r);
if ( r.ax = 0 ) then
present := false
else
present := true;
end;
procedure Mouse.Aspect;
var I, J, K : integer;
File_cursor : text;
Cursor : Array[0..31] Of Word;
begin
Assign(File_cursor, nomfich);
Reset(File_cursor);
For I := 0 To 3 Do
begin
For J := 0 To 7 Do
begin
K := (I * 8) + J;
read(File_cursor, Cursor[K]);
end;
readln(File_cursor);
end;
Close(File_cursor);
r.ax := 9;
r.bx := 0;
r.cx := 0;
r.es := seg(cursor);
r.dx := ofs(cursor);
intr($33, r);
end;
procedure Mouse.Aspect2;
var I, J, K : integer;
File_cursor : text;
Cursor : Array[0..31] Of Word;
begin
For I := 0 To 3 Do
begin
For J := 0 To 7 Do
begin
K := (I * 8) + J;
end;
end;
r.ax := 9;
r.bx := 0;
r.cx := 0;
r.es := seg(cham);
r.dx := ofs(cham);
intr($33, r);
end;
function Mouse.posx : integer;
begin
pb;
posx := iposx;
end;
function Mouse.posy : integer;
begin
pb;
posy := iposy;
end;
function Mouse.sttb : integer;
begin
pb;
sttb := isttb;
end;
procedure Mouse.show(status : boolean);
begin
if ( status ) then
begin
r.ax := 1;
intr($33, r);
end
else
begin
r.ax := 2;
intr($33, r);
end;
end;
procedure Mouse.defwin(minc, minl, maxc, maxl : integer);
begin
r.ax := 7;
r.cx := minc;
r.dx := maxc;
intr($33, r);
r.ax := 8;
r.cx := minl;
r.dx := maxl;
intr($33, r);
end;
procedure Mouse.Boutons(interu : integer;
var nb_bout, pos_x, pos_y : integer);
begin
r.bx := 0;
(* repeat *)
r.ax := 5;
if ( interu = -1 ) then
r.ax := 6;
intr($33, r);
(* until ( r.ax = 1);*)
nb_bout := r.bx;
pos_x := r.cx;
pos_y := r.dx;
end;
function existfile(nomf:string):boolean;
var attrb:word;
fich:file;
begin
assign(fich,nomf);
getfattr(fich,attrb);
if(doserror<>ioresult)
then existfile:=false
else
if((attrb=volumeid) or (attrb=directory))
then existfile:=false
end;
function litnomfich : string;
var c : char;
nomfich, save : string[30];
j, xx, yy, fin, back, ok, eee : integer;
begin
j := 1;
xx:=220;
yy:=460;
fin := 0;
back := 0;
ok := 0;
eee := 0;
nomfich := '';
repeat
c := readkey;
c := upcase(c);
case ( c ) of
#8 : if ( j > 1 ) then
begin
j := j - 1;
save := '';
save := copy(nomfich,1,j-1);
nomfich := '';
nomfich := copy(save,1,j-1);
back := 1;
ok := 0;
end;
#13 : begin
fin := 1;
end;
#42 : begin
end;
#63 : begin
end;
#27 : begin
fin := 1;
eee := 1;
end
else
if ( j < 25 ) then
begin
nomfich := concat(nomfich,c);
ok := 1;
end;
end;
if ( ok = 1) then
begin
setcolor(11);
outtextxy(xx, yy, c);
xx := xx + textwidth('w');
j := j + 1;
ok := 0;
end;
if ( back = 1) then
begin
c := nomfich[j];
xx := xx - textwidth(c);
setcolor(1);
outtextxy(xx, yy, c);
back := 0;
end;
until (fin = 1) ;
if ( eee = 1) then
begin
litnomfich := '';
end
else
litnomfich := nomfich;
end;
(* procedure egavgadriverproc;external;
{$L EGAVGA.OBJ}
procedure sansseriffontproc;external;
{$L SANS.OBJ}*)
Var
OldMode : Byte;
Count, mX, mY : Integer;
Bt, posx, posy : Integer;
TileX, TileY : Integer;
key, aux : Byte;
Ch : Char;
S : String;
I : Integer;
graphdriver,graphmode:integer;
Begin
graphdriver:=vga;
graphmode:=vgahi;
initgraph(graphdriver,graphmode,'');
SetTextStyle(0, HorizDir, 2);
;
FillChar(FullCursor,SizeOf(FullCursor),Transp);
BuildUI;
m.mouse;
m.defwin(0, 0, 635, 470);
m.show(true);
load_cursor22;
Color := Black;
repeat
m.boutons(-1,Count,posX,posY);
m.boutons(1,Count,mX,mY);
If (mX = 0) And (mY = 0) Then Continue;
(*
---------------
Traitement SAVE
---------------
*)
If (mX >= 6) And (mX <= 80) And (mY >= 61) and (my <= 91) Then
Begin
m.show(false);
Button(Dn,5,60,56,'Save ');
m.show(true);
Repeat
m.boutons(-1,Count,mX,mY);
Until Count > 0;
If (mX >= 6) And (mX <= 80) And (mY >= 61) and (my <= 91) Then
Begin
CalcCursor;
setcolor(15);
makerectr(218,460,220,20,1,solidfill,1);
setcolor(11);
moveto(220,460);
S := '';
S := litnomfich;
If ( S = '' ) Then
S := OutputName;
Case Output Of
Pascal : begin
S := concat(s, '.CUR');
SavePas(s);
end;
c : begin
S := concat(s, '.C');
SaveC;
end;
Fortran : begin
S := concat(s, '.FOR');
SaveFor;
end;
Basic : begin
S := concat(s, '.BAS');
SaveBas;
end;
End;
setcolor(15);
makerectr(218,460,220,20,1,solidfill,1);
setcolor(11);
moveto(220,460);
outtext(S);
m.show(false);
Button(Up,5,60,56,'Save ');
m.show(true);
repeat
mx := m.posx;
my := m.posy;
until ( m.sttb = 1 );
End;
Continue;
End;
(*
----------------
Traitement CLEAR
----------------
*)
If (mX >= 6) And (mX <= 80) And (mY >= 76) and (my <= 106) Then
Begin
m.show(false);
Button(Dn,5,90,56,'Clear');
m.show(true);
Repeat
m.boutons(-1,Count,mX,mY);
Until Count > 0;
If (mX >= 6) And (mX <= 80) And (mY >= 76) and (my <= 106) Then
Begin
FillChar(FullCursor,SizeOf(FullCursor),transp);
m.show(false);
DrawGrid;
setcolor(9);
makerectr(567,36,33,15,7,solidfill,7);
m.show(true);
m.show(false);
Button(Up,5,90,56,'Clear');
m.show(true);
repeat
mx := m.posx;
my := m.posy;
until ( m.sttb = 1 );
End;
Continue;
End;
(*
---------------
Traitement LOAD
---------------
*)
If (mX >= 6) And (mX <= 80) And (mY >= 106) and (my <= 136) Then
Begin
m.show(false);
Button(Dn,5,120,56,'Load ');
m.show(true);
If (mX >= 6) And (mX <= 80) And (mY >= 106) and (my <= 136) Then
Begin
setcolor(7);
outtextxy(20,30,'file not found');
setcolor(15);
makerectr(218,460,220,20,1,solidfill,1);
setcolor(11);
moveto(220,460);
S := '';
S := litnomfich;
If ( S = '' ) Then
S := OutputName;
Case Output Of
Pascal : S := concat(s, '.CUR');
c : S := concat(s, '.C');
Fortran : S := concat(s, '.FOR');
Basic : S := concat(s, '.BAS');
End;
setcolor(15);
makerectr(218,460,220,20,1,solidfill,1);
setcolor(11);
moveto(220,460);
outtext(S);
m.show(true);
FillChar(FullCursor,SizeOf(FullCursor),Transp);
m.show(false);
DrawGrid;
setcolor(7);
rectangle(568,35,585,52);
m.show(true);
nomfich := s;
if existfile(s) then
load_cursor2(s)
else begin setcolor(red);
outtextxy(20,30,'file not found');
load_cursor22;end;
m.show(false);
RadioButton(Sel,536,330,'Black');
RadioButton(NotSel,536,354,'White');
RadioButton(NotSel,536,378,'Transp');
RadioButton(NotSel,536,402,'Invert');
m.show(true);
Color := Black;
colrec:=0;
CalcCursor;
m.show(false);
Button(Up,5,120,56,'Load ');
m.show(true);
repeat
mx := m.posx;
my := m.posy;
until ( m.sttb = 1 );
End;
Continue;
End;
(*
---------------
Traitement EXIT
---------------
*)
If (mX >= 6) And (mX <= 80) And (mY >= 140) and (my <= 170) Then
begin
Break;
m.show(false);
Button(Up,5,150,56,'Exit ');
m.show(true);
Continue;
exit;closegraph;
End;
(*
----------------------------------
Traitement Choix du langage PASCAL
----------------------------------
*)
If (mX >= 5) And (mX <= 115) And (mY >= 330) and (my <= 340) Then
Begin
If Output <> Pascal Then
Begin
m.show(false);
RadioButton(Sel,7,330,'Pascal');
RadioButton(NotSel,7,354,'c');
RadioButton(NotSel,7,378,'Fortran');
RadioButton(NotSel,7,402,'Basic');
Output := Pascal;
setcolor(15);
makerectr(218,460,220,20,1,solidfill,1);
setcolor(11);
moveto(220,460);
outtext(OutputName + '.CUR');
m.show(true);
Continue;
End;
End;
(*
-----------------------------
Traitement Choix du langage C
-----------------------------
*)
If (mX >= 5) And (mX <= 115) And (mY >= 354) and (my <= 364) Then
Begin
If Output <> c Then
Begin
m.show(false);
RadioButton(NotSel,7,330,'Pascal');
RadioButton(Sel,7,354,'c');
RadioButton(NotSel,7,378,'Fortran');
RadioButton(NotSel,7,402,'Basic');
Output := c;
setcolor(15);
makerectr(218,460,220,20,1,solidfill,1);
setcolor(11);
moveto(220,460);
outtext(OutputName + '.C');
m.show(true);
Continue;
End;
End;
(*
-----------------------------------
Traitement Choix du langage FORTRAN
-----------------------------------
*)
If (mX >= 5) And (mX <= 115) And (mY >= 378) and (my <= 388) Then
Begin
If Output <> Fortran Then
Begin
m.show(false);
RadioButton(NotSel,7,330,'Pascal');
RadioButton(NotSel,7,354,'c');
RadioButton(Sel,7,378,'Fortran');
RadioButton(NotSel,7,402,'Basic');
Output := Fortran;
setcolor(15);
makerectr(218,460,220,20,1,solidfill,1);
setcolor(11);
moveto(220,460);
outtext(OutputName + '.FOR');
m.show(true);
Continue;
End;
End;
(*
---------------------------------
Traitement Choix du langage BASIC
---------------------------------
*)
If (mX >= 5) And (mX <= 115) And (mY >= 402) and (my <= 412) Then
Begin
If Output <> Basic Then
Begin
m.show(false);
RadioButton(NotSel,7,330,'Pascal');
RadioButton(NotSel,7,354,'c');
RadioButton(NotSel,7,378,'Fortran');
RadioButton(Sel,7,402,'Basic');
Output := Basic;
setcolor(15);
makerectr(218,460,220,20,1,solidfill,1);
setcolor(11);
moveto(220,460);
outtext(OutputName + '.BAS');
m.show(true);
Continue;
End;
End;
(*
------------------------------------
Traitement Choix de la couleur BLACK
------------------------------------
*)
If (mX >= 536) And (mX <= 628) And (mY >= 330) and (my <= 340) Then
Begin
If Color <> Black Then
Begin
m.show(false);
RadioButton(Sel,536,330,'Black');
RadioButton(NotSel,536,354,'White');
RadioButton(NotSel,536,378,'Transp');
RadioButton(NotSel,536,402,'Invert');
m.show(true);
Color := Black;
colrec:=0;
Continue;
End;
End;
(*
------------------------------------
Traitement Choix de la couleur WHITE
------------------------------------
*)
If (mX >= 538) And (mX <= 628) And (mY >= 354) and (my <= 364) Then
Begin
If Color <> White Then
Begin
m.show(false);
RadioButton(NotSel,536,330,'Black');
RadioButton(Sel,536,354,'White');
RadioButton(NotSel,536,378,'Transp');
RadioButton(NotSel,536,402,'Invert');
m.show(true);
Color := White;
colrec:=15;
Continue;
End;
End;
(*
-------------------------------------
Traitement Choix de la couleur TRANSP
-------------------------------------
*)
If (mX >= 538) And (mX <= 628) And (mY >= 378) and (my <= 388) Then
Begin
If Color <> Transp Then
Begin
m.show(false);
RadioButton(NotSel,536,330,'Black');
RadioButton(NotSel,536,354,'White');
RadioButton(Sel,536,378,'Transp');
RadioButton(NotSel,536,402,'Invert');
m.show(true);
Color := Transp;
colrec:=7;
Continue;
End;
End;
(*
-------------------------------------
Traitement Choix de la couleur INVERT
-------------------------------------
*)
If (mX >= 538) And (mX <= 628) And (mY >= 402) and (my <= 412) Then
Begin
If Color <> Invert Then
Begin
m.show(false);
RadioButton(NotSel,536,330,'Black');
RadioButton(NotSel,536,354,'White');
RadioButton(NotSel,536,378,'Transp');
RadioButton(Sel,536,402,'Invert');
m.show(true);
Color := Invert;
colrec:=3;
Continue;
End;
End;
(*
-------------------------------
Traitement de DESSIN du curseur
-------------------------------
*)
If ( (mX >= 160) And (mX <= 356) And
(mY >= 80) and (my <= 276) ) then
Begin
Case Color Of
Black : begin
setcolor(0);
colrec := 0;
end;
White : begin
setcolor(15);
colrec := 15;
end;
Transp : begin
setcolor(7);
colrec := 7;
end;
Invert : begin
setcolor(3);
colrec := 3;
end;
End;
posX := 100;
repeat
repeat
mx := m.posx;
my := m.posy;
until ( m.sttb = 1 );
TileX := (mX - 160) Div 12;
TileY := (mY - 80) Div 12;
If (TileX >= 0) And (TileX <= 15) And (TileY >= 0) And
(TileY <= 15) And ((TileX <> posX) Or (TileY <> posY)) then
Begin
m.show(false);
fill := SOLIDFILL;
setfillstyle(fill, colrec);
rectangle(161+TileX*12,81+TileY*12,171+TileX*12,91+TileY*12);
floodfill(162+TileX*12,82+TileY*12, colrec);
rectangle(569+tilex,36+tiley,569+tilex,36+tiley);
m.show(true);
FullCursor[TileX,TileY] := Color;
posX := TileX;
posY := TileY;
End;
m.boutons(-1,Count,X,Y);
Until Count > 0;
Continue;
End;
until true = false;closegraph;
End.
This prog. is coming from SWAG, I added my own procedures for the mouse,
and the 2 load procedures, one load is for constant, the other for a file.
Notice that some procedure are never called !!!!!!!!
If there is error (?),let me know !!!
cut here and save as cham.cur
-----------------------------------------------------------------------------------
$83FF $13FF $03FF $E333 $F201 $F200 $F000 $F800
$FC00 $FE70 $FEF9 $FEFD $FEFD $FEFD $FEFD $FDF9
$7C00 $EC00 $FC00 $1CCC $0DFE $0DFF $0FFF $07FF
$03FF $018F $0106 $0102 $0102 $0102 $0102 $0206
-----------------------------------------------------------------------------------
bye
patrick
marseille
(
geocities.com/~franzglaser)