Subject:           Re: Mouse in Pascal
      Date:           Thu, 2 Jul 1998 12:09:51 +0200
      From:           "Mardirossian" <antranik.kirkor@wanadoo.fr>
 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