home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / mouse / mouse0 / mouseed.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-30  |  6.3 KB  |  216 lines
  1. {$N-}
  2. Program Maus_zeiger_editor;
  3. {$DEFINE resident}
  4. {$IFDEF resident}
  5. { unit drivers und fonts wurden nach Turbo Pascal Manual
  6.   aus allen Treibern und Fonts erzeugt }
  7. uses dos,crt,graph,mousunit,drivers,fonts;
  8. {$ELSE}
  9. uses dos,crt,graph,mousunit;
  10. {$ENDIF}
  11. var
  12.   Gd,Gm,GrSave : integer;
  13.   i,updateflag : byte;
  14.   x,y,Count : word;
  15.   Flag : MouseMenuFlags;
  16.   NewCursor : MaskRecord;
  17.   s:string[8];
  18.   Menu1: string;
  19.   f:text;
  20.  
  21. {$F+}
  22. Procedure MouseInt(Mask,Button,X,Y:Word);
  23. { Diese Prozedur wird vom Maustreiber indirekt über die
  24.   Maus-Unit aufgerufen, wenn einer der Knöpfe betätigt wird}
  25. Begin
  26.   case Button of
  27.     1:  Sound(440);        { Linker Knopf  }
  28.     2:  Sound(880);        { Rechter Knopf }
  29.     3:  Sound(1000);       { Beide Knöpfe  }
  30.   end;
  31.   delay(20);
  32.   Nosound;
  33. End;
  34. {$F-}
  35.  
  36. Procedure Abort(msg:string);
  37. begin
  38.   writeln (msg, ': Treiber nicht gefunden!');
  39.   halt(1);
  40. end;
  41.  
  42. Procedure RegisterAll;
  43. begin
  44.   if RegisterBGIdriver(@CGADriverProc) < 0 then     Abort('CGA');
  45.   if RegisterBGIdriver(@EGAVGADriverProc) < 0 then  Abort('EGA/VGA');
  46.   if RegisterBGIdriver(@HercDriverProc) < 0 then    Abort('Herc');
  47.   if RegisterBGIdriver(@ATTDriverProc) < 0 then     Abort('AT&T');
  48.   if RegisterBGIdriver(@PC3270DriverProc) < 0 then  Abort('PC 3270');
  49. end;
  50.  
  51. Procedure BitInvert(var mask:word;nr:byte);
  52. { Invertiert Bit nr in word mask }
  53. begin
  54.   mask:= mask xor ($8000 shr nr);
  55. end;
  56.  
  57. Function BitTest(mask:word;nr:byte):boolean;
  58. { Testet Bit nr in word mask }
  59. begin
  60.   BitTest:=(mask and ($8000 shr nr)) > 0;
  61. end;
  62.  
  63. Function Hexval(value:word):string;
  64. { Verwandelt word value in Hexstring }
  65. Var
  66.   hext : string;
  67.   i,r : byte;
  68. const
  69.   hexst = '0123456789ABCDEF';
  70. Begin
  71.   hext:='';
  72.   for i:=1 to 4 do begin
  73.     r:=1+value-(value shr 4) shl 4;
  74.     value:=value shr 4;
  75.     hext:=copy(hexst,r,1)+hext;
  76.   end;
  77.   hexval:=hext;
  78. end;
  79.  
  80. Procedure InitScreen;
  81. { Initialisiert Variable und Bildschirm }
  82. Begin
  83.   HideMouse;
  84.   NewCursor.x:=0;
  85.   NewCursor.y:=0;
  86.   for x:=1 to 17 do begin
  87.     if x<17 then begin
  88.       NewCursor.mask[0,x-1]:=0;
  89.       NewCursor.mask[1,x-1]:=0;
  90.     end;
  91.     for y:=1 to 17 do begin
  92.       if y < 17 then line(x*15,y*15,x*15,(y+1)*15);
  93.       if x < 17 then line(x*15,y*15,(x+1)*15,y*15);
  94.     end;
  95.   end;
  96.   setgraphicscursor(StandardCursor);
  97.   Updateflag:=MouseMenu(menu1,3,flag);
  98.   ShowMouse;
  99. end;
  100.  
  101. begin
  102. { Grafik-Initialisierung }
  103.   Gd := Detect;
  104.   {$IFDEF resident}
  105.     RegisterAll;
  106.     InitGraph(Gd, Gm, '');
  107.   {$ELSE}
  108.     InitGraph(Gd, Gm, '\turbo\driver');
  109.   {$ENDIF}
  110.     GrSave:=GraphResult;
  111.   if GrSave <> grOk then begin
  112.     writeln('Grafik Initialisierungs Fehler Nr.: ',GrSave);
  113.     Halt(1);
  114.   end;
  115.   { Menü Texte Zuweisen }
  116.   Menu1:='10Reset: ;02Neuer Cursor:02Standard Cursor;04Exit: ';
  117.   resetmouse;              { Maus initialisieren }
  118.   for i:=1 to 20 do flag[i]:=false;
  119.   { Setzt MouseInt als Interrupt-Prozedur, die vom Maustreiber
  120.     gerufen wird, wenn einer der Knöpfe betätigt wird = $0A }
  121.   SetMouseProcedure($0A,@MouseInt);
  122.   InitScreen;               { Initialisierung Variablen + Screen }
  123.   ShowMouse;                { Mauszeiger einschalten }
  124.   repeat
  125.     if flag[2] then setgraphicscursor(NewCursor)
  126.                else setgraphicscursor(StandardCursor);
  127.     if Updateflag > 0 then Updateflag:=MouseMenu(menu1,3,flag)
  128.                       else Updateflag:=MouseMenu('',3,flag);
  129.     Flag[20]:=buttonpressinfo(LeftB,Count,x,y);
  130.     ShowMouse;
  131.     if Count > 0 then begin
  132.       for x:=1 to 16 do begin
  133.         for y:=1 to 16 do begin
  134.           if MouseInBox(x*15,y*15,(x+1)*15,(y+1)*15) then begin
  135.             { Modifiziere Bildschirmmaske }
  136.             setgraphicscursor(StandardCursor);
  137.             if leftbutton and rightbutton then begin
  138.               { Setze heißen Fleck }
  139.               NewCursor.x:=x-1;
  140.               NewCursor.y:=y-1;
  141.             end;
  142.             BitInvert(NewCursor.mask[0,y-1],x-1);
  143.             i:=0;
  144.             if BitTest(NewCursor.mask[0,y-1],x-1) then i:=i+1;
  145.             if BitTest(NewCursor.mask[1,y-1],x-1) then i:=i+2;
  146.             Case i of
  147.               0: SetFillStyle(EmptyFill,GetMaxColor);
  148.               1: SetFillStyle(CloseDotFill,GetMaxColor);
  149.               2: SetFillStyle(SolidFill,GetMaxColor);
  150.               3: SetFillStyle(XHatchFill,GetMaxColor);
  151.             end;
  152.             HideMouse;
  153.             bar(x*15+1,y*15+1,(x+1)*15-1,(y+1)*15-1);
  154.             ShowMouse;
  155.           end;
  156.         end;
  157.       end;
  158.     end;
  159.     Flag[20]:=buttonpressinfo(RightB,Count,x,y);
  160.     ShowMouse;
  161.     if Count > 0 then begin
  162.       for x:=1 to 16 do begin
  163.         for y:=1 to 16 do begin
  164.           if MouseInBox(x*15,y*15,(x+1)*15,(y+1)*15) then begin
  165.             { Modifiziere Zeigermaske }
  166.             setgraphicscursor(StandardCursor);
  167.             if leftbutton and rightbutton then begin
  168.               { Setze heißen Fleck }
  169.               NewCursor.x:=x-1;
  170.               NewCursor.y:=y-1;
  171.             end;
  172.             BitInvert(NewCursor.mask[1,y-1],x-1);
  173.             i:=0;
  174.             if BitTest(NewCursor.mask[0,y-1],x-1) then i:=i+1;
  175.             if BitTest(NewCursor.mask[1,y-1],x-1) then i:=i+2;
  176.             Case i of
  177.               0: SetFillStyle(EmptyFill,GetMaxColor);
  178.               1: SetFillStyle(CloseDotFill,GetMaxColor);
  179.               2: SetFillStyle(SolidFill,GetMaxColor);
  180.               3: SetFillStyle(XHatchFill,GetMaxColor);
  181.             end;
  182.             HideMouse;
  183.             bar(x*15+1,y*15+1,(x+1)*15-1,(y+1)*15-1);
  184.             ShowMouse;
  185.           end;
  186.         end;
  187.       end;
  188.     end;
  189.     if flag[1] then begin
  190.       flag[1]:=false;
  191.       cleardevice;
  192.       InitScreen;
  193.     end;
  194.   until flag[3];                     { Exit:Exit }
  195.  
  196.   CloseGraph;
  197.   { Neue Mauszeiger-Definition in Datei schreiben }
  198.   write('Eingabe Cursorname : ');
  199.   readln(s);
  200.   assign(f,s+'.inc');
  201.   rewrite(f);
  202.   write(f,s,'Cursor : Maskrecord = (mask:((');
  203.   for x:=0 to 14 do begin
  204.     if (x and 7) = 0 then writeln(f);
  205.     write(f,'$',hexval(NewCursor.mask[0,x]),',');
  206.   end;
  207.   write(f,'$',hexval(NewCursor.mask[0,15]),'),(');
  208.   for x:=0 to 14 do begin
  209.     if (x and 7) = 0 then writeln(f);
  210.     write(f,'$',hexval(NewCursor.mask[1,x]),',');
  211.   end;
  212.   writeln(f,'$',hexval(NewCursor.mask[1,15]),'));x:',
  213.   NewCursor.x:2,';y:',NewCursor.y:2,');');
  214.   close(f);
  215. end.
  216.