Program pro hru LODĚ. Program by měl umožnit hru dvou protihráčů nebo i hru proti počítači.

{ TMENU01.PAS                              Copyright (c) Ales Kucik }
{ TEXTOVE MENU ver.01                                               }
{ Jednotka pro vytvoreni a obsluhu jednoducheho menu.               }
{                                                                   }
{ Datum:09.04.2002                             http://www.trsek.com }
 
unit tmenu01;
interface
uses crt,mcrt01,mouse01;
 
const
 
  {hodnoty klaves vracene funkci GetKey (unit mcrt01)}
  up   = 328;
  down = 336;
  enter= 13;
 
  max_item=25;                   {maximum polozek menu}
 
  {prednastaveni barvicek}
  normal_item = lightgray;       {text normalni polozky svetle sedy}
  active_item = yellow;          {text vybrane polozky zluty}
  normal_bgr  = black;           {normalni pozadi cerne}
  active_bgr  = red;             {pozadi vybrane polozky cervene}
 
 
 
 
 
type
  pstring=^string;
 
  tmenu=object
 
   private
 
    item:array [1..max_item] of pstring;  {pole ukazatelu na polozky}
    long:byte;               {delka nejdelsi polozky}
    x,y:byte;                {umisteni menu na obrazovce}
    active:byte;             {cislo prave vybrane polozky}
    nr_items:byte;           {pocet polozek menu}
 
   public
 
    constructor Init(xx,yy:byte);           {inicializace menu}
    procedure NewItem(s:string);          {prida novou polozku na konec}
    procedure NewItemN(s:string; n:byte); {prida novou polozku na n-te misto}
    procedure EraseItem;                  {smaze se posledni polozka}
    procedure EraseItemN(n:byte);         {smaze se n-ta polozka}
    procedure ShowMenu;                   {zobrazi menu na obrazovku}
    procedure SetMenuPosition(xx,yy:byte);  {nastavi pozici menu}
    procedure GetMenuPosition(var xx,yy:byte);{vrati pozici menu}
    function  Choice:byte;                 {vraci cislo zvolene polozky}
    destructor Done;                      {ukonceni menu}
 
  end;
implementation
 
constructor tmenu.Init;
begin
  long:=0;              {nastaveni delky nejdelsi polozky na 0}
  self.x:=xx;            {nastaveni x-ove souradnice menu (sloupec)}
  self.y:=yy;            {nastaveni y-ove souradnice menu (radek)}
  active:=1;            {nastaveni aktivni polozky na prvni}
  nr_items:=0;          {pocet polozek je 0}
end;
 
procedure tmenu.NewItem;
var
  temp:byte;            {delka nove polozky}
 
begin
  if nr_items < max_item then      {pokud menu neni plne pridej novou polozku}
    begin
      temp:=length(s);             {delka nove polozky}
      if temp>long then long:=temp;{pokud je nejdelsi nastav ji jako nejdelsi}
      inc(nr_items);               {zvetsi pocet polozek menu}
      new(item[nr_items]);         {alokuj pamet pro novou polozku}
      item[nr_items]^:=s;
    end;
end;
 
procedure tmenu.NewItemN;
var
  i,
  temp:byte;  {delka nove polozky}
 
begin
 
  {pokud menu neni plne a nova polozka je na miste nejake jiz existujici}
  if (nr_items<max_item) and (n>0) and (n<=nr_items) then
    begin
      temp:=length(s);             {delka nove polozky}
      if temp>long then long:=temp;{pokud je nejdelsi nastav ji jako nejdelsi}
      inc(nr_items);               {zvetsi pocet polozek menu}
 
      {presun polozek k mistu vlozeni nove polozky}
      for i:=nr_items downto nr_items-n+1 do item[i]:=item[i-1];
      new(item[n]);     {alokuj nove misto pro novou polozku}
      item[n]^:=s;
    end;
end;
 
procedure tmenu.EraseItem;
begin
  dispose(item[nr_items]);   {uvolni pamet}
  dec(nr_items);             {sniz pocet polozek o jednu}
end;
 
procedure tmenu.EraseItemN;
var
  i:byte;
 
begin
  if (n>0) and (n<=nr_items) then
    begin
      dispose(item[n]);         {uvolni pamet n-te polozky}
      dec(nr_items);            {sniz pocet polozek o jednu}
      for i:=n to nr_items do   {presun polozek s vyssim cislem o jednu niz}
        item[i]:=item[i+1];
    end;
end;
 
procedure tmenu.ShowMenu;
var
  i,j,
  attr:byte;          {uchova puvodni atribut}
  temp:string;
 
begin
  attr:=TextAttr;            {ulozeni puvodniho atributu}
  for i:=1 to nr_items do  {ber postupne vsechny polozky menu}
    begin
      gotoxy(x,y+i-1);       {pozice polozky na obrazovce}
      if i=active then     {je polozka aktivni ??}
        begin                {polozka je aktivni}
          textbackground(active_bgr);
          textcolor(active_item);
          write(item[i]^);
 
          {doplneni polozky mezerami na velikost nejdelsi}
          for j:=1 to long-length(item[i]^) do write(' ');
        end
      else
        begin                {polozka neni aktivni}
          textbackground(normal_bgr);
          textcolor(normal_item);
          write(item[i]^);
 
          {doplneni polozky mezerami na velikost nejdelsi polozky}
          for j:=1 to long-length(item[i]^) do write(' ');
        end;
    end;
  TextAttr:=attr;            {vraceni puvodniho atributu}
end;
 
procedure tmenu.SetMenuPosition;
begin
  x:=xx;
  y:=yy;
end;
 
procedure tmenu.GetMenuPosition;
begin
  x:=xx;
  y:=yy;
end;
 
function tmenu.Choice;
  procedure SuccItem;
  begin
    if active<nr_items then inc(active)
    else active:=1;
  end;
 
  procedure PredItem;
  begin
    if active>1 then dec(active)
    else active:=nr_items;
  end;
 
var
  back:boolean;         {indikator navratu}
  state,                {stav mysi, nenulova hodnota = stisknute tlacitko}
  number,               {pocet, stisknuti}
  h,                    {horizontalni pozice mysi}
  v:word;               {vertikalni pozice mysi}
 
begin
  back:=false;
  if exmouse then CursorEnable;  {pokud je pritomna mys zobraz jeji kurzor}
  if nr_items>0 then             {kontrola jestli menu obsahuje polozky}
    repeat
      ShowMenu;                  {zobrazeni menu}
      repeat                     {ceka se az je neco stisknuto}
        if exmouse then GetPress(0,state,number,h,v);
      until keypressed or (exmouse and (state>0));
 
      if keypressed then         {pokud byla stisknita klavesa, zjisti ktera}
        case getkey of
          up   : PredItem;       {sipka nahoru > posun v nabidce nahoru}
          down : SuccItem;       {sipka dolu > posun v nabidce dolu}
          enter: begin           {vraceni zvolene polozky}
                   Choice:=active;
                   back:=true;   {ukonceni vyberu polozky}
                 end;
        end;
 
      {pokud existuje mys a bylo stisknuto tlacitko}
      if exmouse and (state<>0) then
        begin
          h:=(h+8) div 8;      {prepocet pozice kurzoru mysi}
          v:=(v+8) div 8;      {prepocet pozice kurzoru mysi}
 
          {naleza se kurzor mysi na nabidce menu??}
          if (h>=x) and (h<x+long) then
            if (v>=y) and (v<y+nr_items) then
              begin
                Choice:=v-y+1;  {vypocet vybrane polozky menu}
                back:=true;     {ukonceni vyberu polozky}
              end;
        end;
    until back;
  if exmouse then CursorDisable;
end;
 
destructor tmenu.Done;
var i:byte;
begin
  for i:=1 to nr_items do dispose(item[i]);  {uvolneni pameti}
end;
 
end.