home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_PAS / XLIB_TP5.ZIP / UNITS / X_BUTTON.PAS < prev    next >
Pascal/Delphi Source File  |  1993-11-20  |  11KB  |  377 lines
  1. Unit X_Button;
  2. (*
  3.  
  4.     Ok, here is the Unit, who can manages Mouse Buttons and so on.
  5.  
  6.     ****** XLIB - Mode X graphics library                ****************
  7.     ******                                               ****************
  8.     ****** Written By Christian Harms in TP              ****************
  9.  
  10.     Harms   : harms@minnie.informatik.uni-stuttgart.de
  11.  
  12.     comments in german and english
  13.  
  14. *)
  15.  
  16. interface
  17. uses X_Const;
  18.  
  19. const left     = 1;     (* MouseButton - Mask *)
  20.       right    = 2;
  21.       both     = left or right;
  22.  
  23.       PickUp   = $80;   (* Button Click and UnClick over the Button     *)
  24.       RunOver  = $40;   (* Pressed MouseButton can leave the Button Area*)
  25.                         (* => Activated Button  *)
  26.       Click    = $20;   (* Only Click. Good for Counters                *)
  27.  
  28.       All      = left + right + PickUp + RunOver;
  29.  
  30. type  ID_Typ   = Word;
  31.  
  32. (* Dieser Variablen kann eine eigende Procedure zugewiesen werden, die  *)
  33. (* auf einen Klick außerhalb aller Button reakiert. (z.B.:Warnton)      *)
  34. (* You can declare in this variable your own sound-procedure. And every *)
  35. (* time, if the user click not on a button, it will be started.         *)
  36. var  NotButton_Proc : procedure;
  37.      Wait           : Boolean;
  38.  
  39. (* Anfrage, ob ein Button mit der ID schon da ist.                      *)
  40. (* returns true, if exist a button with this ID.                        *)
  41. function  exist_in_ButtonList(ID:ID_Typ):Boolean;
  42.  
  43. (* Alle aktuellen Button werden aus der Liste gelöscht.                 *)
  44. (* All button will removed, but not on the screen.                      *)
  45. procedure Kill_ButtonList_All;
  46.  
  47. (* Add. ein Button in die Liste und stellt diesen dar.                  *)
  48. (* Allocate and show new Button.                                        *)
  49. function  Add_Button(ID                : ID_Typ;
  50.                      x,y               : Word;
  51.                      C1,C2,C3,high,low,        (* Box,,,Font,, - Farben *)
  52.                      Mask              : Byte; (* MouseButton - Mask    *)
  53.                      S                 : String  ) : Boolean;
  54.  
  55. (* The same like Add_Button, but a Integer is the Name .                *)
  56. function Add_ButtonInt(ID:ID_Typ;x,y:Word;C1,C2,C3,high,low,Mask:Byte;I:LongInt):Boolean;
  57.  
  58. (* s. Add_Button, alle Farben mit den Grau-Werten von x_Set_RGB_Pal.    *)
  59. (* The same, but the colors are Gray0 to Gray5 from X_Const, set by     *)
  60. (* x_set_rgb_pal from X_Pal.                                            *)
  61. function Add_Button_Gray(ID:ID_Typ;x,y:Word;Mask:Byte;S:String):Boolean;
  62. function Add_ButtonInt_Gray(ID:ID_Typ;x,y:Word;Mask:Byte;I:LongInt):Boolean;
  63.  
  64. (* Löscht Button aus Liste .                                            *)
  65. (* Remove one Button.                                                   *)
  66. function  Kill_Button(ID:ID_Typ):Boolean;
  67.  
  68. (* Schaltet Button in Hintergrund.                                      *)
  69. (* Inactivated Button, button hold in the list, can`t selected.         *)
  70. procedure Sleep_Button(ID:ID_Typ);
  71.  
  72. (* Schaltet Button wieder aktiv, nach Sleep_Button.                     *)
  73. (* Activate Button.                                                     *)
  74. procedure wake_up_Button(ID:ID_Typ);
  75.  
  76. (* Gibt ID zurück, wenn grad in dem Moment etwas aktiviert wurde,sonst 0*)
  77. (* returns ID of the activated button in this moment, other 0           *)
  78. function  Get_Pressed_Button :ID_Typ;
  79. (* Wartet solange, bis ein Button aktiviert wurde.                      *)
  80. (* Wait, until one Button is activated.                                 *)
  81. function  Wait_Pressed_Button:ID_Typ;
  82.  
  83.  
  84. implementation
  85.  
  86. uses crt,X_Main,X_Text,X_Mouse,X_Rect;
  87.  
  88. type ButtonTyp = record
  89.        ID                : ID_Typ;
  90.        x1,y1,x2,y2       : Word;
  91.        C1,C2,C3,high,low : Byte;   (* Colors: ShadowBox,Font            *)
  92.        PressMask         : Byte;   (* (left, rigth, .. or ..) +         *)
  93.                                    (* (PickUp,RunOver ...               *)
  94.        Sleep             : Boolean;
  95.        S                 : ^String;
  96.      end;
  97.  
  98.      PButtonList = ^ButtonList;
  99.  
  100.      ButtonList = record
  101.        next : PButtonList;
  102.        key  : ButtonTyp;
  103.      end;
  104.  
  105. var Root        : Pointer;
  106.  
  107. {$F+}procedure Kein_Warnton;begin;end;{$F-}
  108.  
  109. function exist_in_ButtonList(ID:ID_Typ):Boolean;
  110. var Run:PButtonList;
  111. begin;
  112.   if Root=NIL then exist_in_ButtonList:=False
  113.               else
  114.   begin;
  115.     Run:=Root;
  116.     while (Run^.key.ID<>ID)and(Run<>NIL) do Run:=Run^.next;
  117.     if Run<>NIL then Exist_in_ButtonList:=True
  118.                 else Exist_in_ButtonList:=false;
  119.   end;
  120. end;
  121.  
  122.  
  123.  
  124. procedure Add_ButtonList(B:ButtonTyp);
  125. var Run,P:PButtonList;
  126. begin;
  127.   if Root=NIL then
  128.   begin;
  129.     New(P);
  130.     Root    :=P;
  131.     P^.next :=NIL;
  132.     P^.key  :=B;
  133.   end         else
  134.   begin;
  135.     Run:=Root;
  136.     while (Run^.next<>NIL) do Run:=Run^.next;
  137.     New(P);
  138.     P^.next  :=NIL;
  139.     P^.key   :=B;
  140.     Run^.next:=P;
  141.   end;
  142. end;
  143.  
  144. function Kill_ButtonList(ID:ID_Typ):Boolean;
  145. var Run,P:PButtonList;
  146. begin;
  147.   if Root=NIL then begin;Kill_ButtonList:=False;exit;end;
  148.   Run:=Root;
  149.   if Run^.key.ID=ID then
  150.   begin;
  151.     P:=Run;
  152.     Root:=Run^.next;
  153.     FreeMEM(P^.key.S,length(P^.key.s^)+1);
  154.     Dispose(P);
  155.     Exit;
  156.   end;
  157.  
  158.   while (Run^.next<>NIL)and(Run^.next^.key.ID<>ID) do Run:=Run^.Next;
  159.   if Run^.next<>NIL then
  160.   begin;
  161.     P:=Run^.next;
  162.     Run^.next:=P^.next;
  163.     FreeMEM(P^.key.S,length(P^.key.s^)+1);
  164.     Dispose(P);
  165.     Kill_ButtonList:=True;
  166.   end
  167.                     else Kill_ButtonList:=False;
  168. end;
  169.  
  170. procedure Kill_ButtonList_All;
  171. var Run,P:PButtonList;
  172. begin;
  173.   If Root=Nil then Exit;
  174.   Run:=Root;
  175.   while (Run^.next<>NIL) do
  176.   begin;
  177.     P:=Run^.next;
  178.     Run^.next:=P^.next;
  179.     FreeMEM(P^.key.S,length(P^.key.s^)+1);
  180.     Dispose(P);
  181.   end;
  182.   FreeMEM(Run^.key.S,length(Run^.key.s^)+1);
  183.   Dispose(Run);
  184.   Root:=NIL;
  185. end;
  186.  
  187. procedure Test_List;
  188. var Run:PButtonList;
  189. begin;
  190.   if Root<>NIL then
  191.   begin;
  192.     Run:=Root;
  193.     while (Run<>NIL) do begin;WriteLn(Run^.key.ID);Run:=Run^.Next;end;
  194.   end;
  195. end;
  196.  
  197. procedure Show_Button(B:ButtonTyp;Z:Boolean);
  198. begin;
  199.   if Wait then WaitVsyncStart;
  200.   if Z then No_Button_Write(B.x1,B.y1,B.C1,B.C3,B.C2,B.High,B.low,B.S^)
  201.        else Press_Button_Write(B.x1,B.y1,B.C1,B.C3,B.C2,B.High,B.low,B.S^)
  202. end;
  203.  
  204. procedure GetButton(ID:ID_Typ;var B:ButtonTyp);
  205. var Run:PButtonList;
  206. begin;
  207.   if not exist_in_ButtonList(ID) then exit;
  208.  
  209.   Run:=Root;
  210.  
  211.   while (Run<>NIL)and(Run^.key.id<>ID) do Run:=Run^.next;
  212.  
  213.   if Run<>NIL then B:=Run^.key;
  214.  
  215. end;
  216.  
  217. procedure SetButton(ID:ID_Typ;var B:ButtonTyp);
  218. var Run:PButtonList;
  219. begin;
  220.   if not exist_in_ButtonList(ID) then exit;
  221.  
  222.   Run:=Root;
  223.  
  224.   while (Run<>NIL)and(Run^.key.id<>ID) do Run:=Run^.next;
  225.  
  226.   if Run<>NIL then Run^.key:=B;
  227.  
  228. end;
  229.  
  230. function Add_Button( ID                : ID_Typ;
  231.                      x,y               : Word;
  232.                      C1,C2,C3,high,low,        (* Box,,,Font,, - Farben *)
  233.                      Mask              : Byte; (* MouseButton - Mask    *)
  234.                      S                 : String  ) : Boolean;
  235. var B:ButtonTyp;
  236. begin;
  237.  
  238.   if exist_in_ButtonList(ID) then GetButton(ID,B);
  239.  
  240.   B.ID    := ID;
  241.   B.x1    := x;
  242.   B.y1    := y;
  243.   B.x2    := x+x_length(s)+2;
  244.   B.y2    := y+x_font_Height+1;
  245.   B.C1    := C1;
  246.   B.C2    := C2;
  247.   B.C3    := C3;
  248.   B.high  := high;
  249.   B.low   := low;
  250.   B.PressMask := Mask;
  251.   B.Sleep := False;
  252.  
  253.   if exist_in_ButtonList(ID) then
  254.   begin;
  255.     FreeMEM(B.S,length(B.S^)+1);
  256.     GetMEM(B.S,length(S)+1);
  257.     B.S^    := S;
  258.     SetButton(ID,B);
  259.   end                        else
  260.   begin;
  261.     GetMEM(B.S,length(S)+1);
  262.     B.S^    := S;
  263.     Add_ButtonList(B);
  264.   end;
  265.  
  266.   Show_Button(B,true);
  267. end;
  268.  
  269. function Add_ButtonInt(ID:ID_Typ;x,y:Word;C1,C2,C3,high,low,Mask:Byte;I:LongInt):Boolean;
  270. var S:String;
  271. begin;
  272.   Add_ButtonInt:=Add_Button(ID,x,y,C1,C2,C3,high,low,Mask,Str(i));
  273. end;
  274.  
  275. function Add_Button_Gray(ID:ID_Typ;x,y:Word;Mask:Byte;S:String):Boolean;
  276. begin;
  277.   Add_Button_Gray:=Add_Button(ID,x,y,Gray5,Gray4,Gray3,Gray0,Gray2,Mask,S);
  278. end;
  279.  
  280. function Add_ButtonInt_Gray(ID:ID_Typ;x,y:Word;Mask:Byte;I:LongInt):Boolean;
  281. var S:String;
  282. begin;{str(i,s);}Add_ButtonInt_Gray:=Add_Button_Gray(ID,x,y,Mask,Str(i));
  283. end;
  284.  
  285. function Kill_Button(ID:ID_Typ):Boolean;
  286. var Dummy:Boolean;
  287.     B    :ButtonTyp;
  288. begin;
  289.   if not exist_in_ButtonList(ID) then begin;Kill_Button:=false;exit;end;
  290.  
  291.   (* Restore BackGround *)
  292.   GetButton(ID,B);
  293.   Box(B.x1-1,B.y1-1,B.x2+1,B.y2+1,B.C2);
  294.  
  295.   Dummy:=Kill_ButtonList(ID);
  296. end;
  297.  
  298. procedure Sleep_Button(ID:ID_Typ);
  299. var B:ButtonTyp;
  300. begin;
  301.   if not exist_in_ButtonList(ID) then exit;
  302.   GetButton(ID,B);
  303.   B.Sleep:=True;
  304.   SetButton(ID,B);
  305.   if Wait then WaitVsyncStart;
  306.   No_Button_Write(B.x1,B.y1,B.C1,B.C3,B.C2,B.low,B.low,B.S^);
  307. end;
  308.  
  309. procedure wake_up_Button(ID:ID_Typ);
  310. var B:ButtonTyp;
  311. begin;
  312.   if not exist_in_ButtonList(ID) then exit;
  313.   GetButton(ID,B);
  314.   B.Sleep:=False;
  315.   SetButton(ID,B);
  316.   Show_Button(B,true);
  317. end;
  318.  
  319.  
  320. (* If 0, none MouseButton pressed or none Button clicked *)
  321. function Get_Pressed_Button:ID_Typ;
  322. var Status: Byte;
  323.     Run   : PButtonList;
  324.     Ok    : Boolean;
  325. begin;
  326.   if (ButtonStatus=0)or(Root=NIL)or(IsMouseHidden) then
  327.                                         begin;Get_Pressed_Button:=0;Exit;end;
  328.  
  329.   Status:=ButtonStatus;
  330.  
  331.   Run:=Root;
  332.   while (Run<>NIL) do
  333.   begin;
  334.     if (Run^.key.PressMask and Status)<>0 then
  335.       if not(Run^.key.Sleep) and
  336.          InBox(Run^.key.x1,Run^.key.y1,Run^.key.x2,Run^.key.y2) then
  337.       begin;
  338.         HideMouse;
  339.         Show_Button(Run^.key,false);
  340.         ShowMouse;
  341.         Ok:=False;
  342.         delay(10);
  343.         repeat
  344.           if (Run^.key.PressMask and PickUp )<>0 then Ok:=ButtonStatus=0;
  345.           if not OK then If (Run^.key.PressMask and RunOver)<>0 then
  346.              Ok:=not InBox(Run^.key.x1,Run^.key.y1,Run^.key.x2,Run^.key.y2);
  347.           if not Ok and ((Run^.key.PressMask and Click )<>0) then Ok:=True;
  348.         until Ok;
  349.         HideMouse;
  350.         Show_Button(Run^.key,true);
  351.         ShowMouse;
  352.         Get_Pressed_Button:=Run^.key.ID;
  353.         exit;
  354.       end;
  355.     Run:=Run^.next;
  356.   end;
  357.   if Status<>0 then begin;NotButton_Proc;delay(100);end;
  358.   Get_Pressed_Button:=0;
  359. end;
  360.  
  361. function Wait_Pressed_Button:ID_Typ;
  362. begin;
  363.   repeat until ButtonStatus<>0;
  364.   Wait_Pressed_Button:=Get_Pressed_Button;
  365. end;
  366.  
  367. procedure Reset_ButtonList;
  368. begin;
  369.   Root:=NIL
  370. end;
  371.  
  372. begin;
  373.   Reset_ButtonList;
  374.   NotButton_Proc:=Kein_Warnton;
  375.   Wait:=False;
  376. end.
  377.