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