qmenu.pas

delphi编的不错的贪吃蛇

  if (menu^.nitems < MAXMENUITEMS) then
  begin
    menu^.items[menu^.nitems] := item;
    menucommon_p(menu^.items[menu.nitems]).parent := menu;
    Inc(menu.nitems);
  end;

  menu^.nslots := Menu_TallySlots(menu);
end;

{*
** Menu_AdjustCursor
**
** This function takes the given menu, the direction, and attempts
** to adjust the menu's cursor so that it's at the next available
** slot.
*}

procedure Menu_AdjustCursor(menu: menuframework_p; dir: integer);
var
  citem: menucommon_p;
begin
  {*
  ** see if it's in a valid spot
  *}
  if (menu^.cursor >= 0) and (menu^.cursor < menu^.nitems) then
  begin
    citem := Menu_ItemAtCursor(menu);
    if citem <> nil then
      if (citem^.type_ <> MTYPE_SEPARATOR) then
        Exit;
  end;

  {*
  ** it's not in a valid spot, so crawl in the direction indicated until we
  ** find a valid spot
  *}
  if (dir = 1) then
    while True do
    begin
      citem := Menu_ItemAtCursor(menu);
      if citem <> nil then
        if (citem^.type_ <> MTYPE_SEPARATOR) then
          Break;
      menu^.cursor := menu^.cursor + dir;
      if (menu^.cursor >= menu^.nitems) then
        menu^.cursor := 0;
    end
  else
    while True do
    begin
      citem := Menu_ItemAtCursor(menu);
      if citem <> nil then
        if (citem^.type_ <> MTYPE_SEPARATOR) then
          Break;
      menu^.cursor := menu^.cursor + dir;
      if (menu^.cursor < 0) then
        menu^.cursor := menu^.nitems - 1;
    end;
end;

procedure Menu_Center(menu: menuframework_p);
var
  height: integer;
begin
  height := menucommon_p(menu.items[menu.nitems - 1]).y;
  Inc(height, 10);

  menu.y := (VID_HEIGHT - height) div 2;
end;

procedure Menu_Draw(menu: menuframework_p);
var
  i: integer;
  item: menucommon_p;
begin
  {*
  ** draw contents
  *}
  for i := 0 to menu^.nitems - 1 do
  begin
    case menucommon_p(menu^.items[i])^.type_ of
      MTYPE_FIELD: Field_Draw(menufield_p(menu.items[i]));
      MTYPE_SLIDER: Slider_Draw(menuslider_p(menu.items[i]));
      MTYPE_LIST: MenuList_Draw(menulist_p(menu.items[i]));
      MTYPE_SPINCONTROL: SpinControl_Draw(menulist_p(menu.items[i]));
      MTYPE_ACTION: Action_Draw(menuaction_p(menu.items[i]));
      MTYPE_SEPARATOR: Separator_Draw(menuseparator_p(menu.items[i]));
    end;                                //case
  end;

  item := Menu_ItemAtCursor(menu);

  if (item <> nil) and Assigned(item^.cursordraw) then
    item^.cursordraw(item)
  else if (@menu^.cursordraw <> nil) then
    menu.cursordraw(menu)
  else if (item <> nil) and (item^.type_ <> MTYPE_FIELD) then
    if (item.flags and QMF_LEFT_JUSTIFY) <> 0 then
      re.DrawChar(menu.x + item.x - 24 + item.cursor_offset, menu.y + item.y, 12 + (Round(Sys_Milliseconds() / 250) and 1))
    else
      re.DrawChar(menu.x + item.cursor_offset, menu.y + item.y, 12 + (Round(Sys_Milliseconds() / 250) and 1));

  if (item <> nil) then
    if (@item^.statusbarfunc <> nil) then
      item^.statusbarfunc(item)
    else if (item^.statusbar <> nil) then
      Menu_DrawStatusBar(item^.statusbar)
    else
      Menu_DrawStatusBar(menu^.statusbar)
  else
    Menu_DrawStatusBar(menu.statusbar);
end;

//procedure Menu_DrawStatusBar ( const char *string );

procedure Menu_DrawStatusBar(string_: PChar);
var
  l,
    //  maxrow,
  maxcol,
    col: integer;
begin
  if (string_ <> nil) then
  begin
    l := strlen(string_);
    //    maxrow := VID_HEIGHT div 8;
    maxcol := VID_WIDTH div 8;
    col := maxcol div 2 - l div 2;

    re.DrawFill(0, VID_HEIGHT - 8, VID_WIDTH, 8, 4);
    Menu_DrawString(col * 8, VID_HEIGHT - 8, string_);
  end
  else
    re.DrawFill(0, VID_HEIGHT - 8, VID_WIDTH, 8, 0);
end;

//procedure Menu_DrawString ( int x, int y, const char *string )

procedure Menu_DrawString(x, y: integer; string_: PChar);
var
  i: Integer;
begin
  for i := 0 to strlen(string_) - 1 do
    re.DrawChar(x + i * 8, y, Byte(string_[i]));
end;

procedure Menu_DrawStringDark(x, y: integer; string_: PChar);
var
  i: integer;
begin
  for i := 0 to strlen(string_) - 1 do
    re.DrawChar(x + i * 8, y, Byte(string_[i]) + 128);
end;

procedure Menu_DrawStringR2L(x, y: integer; string_: PChar);
var
  i: integer;
begin
  for i := 0 to strlen(string_) do
    re.DrawChar(x - i * 8, y, byte(string_[strlen(string_) - i - 1]));
end;

procedure Menu_DrawStringR2LDark(x, y: integer; string_: PChar);
var
  i: integer;
begin
  for i := 0 to strlen(string_) - 1 do
    re.DrawChar(x - i * 8, y, byte(string_[strlen(string_) - i - 1]) + 128);
end;

function Menu_ItemAtCursor(m: menuframework_p): pointer;
begin
  if (m.cursor < 0) or (m.cursor >= m.nitems) then
  begin
    Result := nil;
    Exit;
  end;

  Result := m.items[m.cursor];
end;

function Menu_SelectItem(s: menuframework_p): qboolean;
var
  item: menucommon_p;
begin
  item := menucommon_p(Menu_ItemAtCursor(s));

  if item <> nil then
    case item.type_ of
      MTYPE_FIELD:
        begin
          Result := Field_DoEnter(menufield_p(item));
          Exit;
        end;
      MTYPE_ACTION:
        begin
          Action_DoEnter(menuaction_p(item));
          Result := true;
          Exit;
        end;
      MTYPE_LIST:
        //idsoft    Menulist_DoEnter( ( menulist_s * ) item );
        begin
          Result := false;
          exit;
        end;
      MTYPE_SPINCONTROL:
        //idsoft    SpinControl_DoEnter( ( menulist_s * ) item );
        begin
          Result := false;
          exit;
        end;
    end;                                //case

  Result := false;
end;

procedure Menu_SetStatusBar(m: menuframework_p; string_: pchar);
begin
  m.statusbar := string_;
end;

procedure Menu_SlideItem(s: menuframework_p; dir: integer);
var
  item: menucommon_p;
begin
  item := menucommon_p(Menu_ItemAtCursor(s));
  if (item <> nil) then
    case item.type_ of
      MTYPE_SLIDER: Slider_DoSlide(menuslider_p(item), dir);
      MTYPE_SPINCONTROL: SpinControl_DoSlide(menulist_p(item), dir);
    end;                                //case
end;

function Menu_TallySlots(menu: menuframework_p): integer;
var
  i, total, nitems: integer;
  n: PPChar;
begin
  total := 0;
  for i := 0 to menu.nitems - 1 do
    if (menucommon_p(menu.items[i]).type_ = MTYPE_LIST) then
    begin
      nitems := 0;
      n := PPChar(@menulist_p(menu.items[i]).itemnames^[0]);

      while (n <> nil) do
      begin
        Inc(nitems);
        Inc(n);
      end;

      Inc(total, nitems);
    end
    else
      Inc(total);

  Result := total;
end;

procedure Menulist_DoEnter(l: menulist_p);
var
  start: integer;
begin
  start := l^.generic.y div 10 + 1;

  l^.curvalue := l^.generic.parent.cursor - start;

  if (@l.generic.callback <> nil) then
    l^.generic.callback(l);
end;

procedure MenuList_Draw(l: menulist_p);
var
  y: integer;
  n: PPChar;
begin
  y := 0;
  Menu_DrawStringR2LDark(l.generic.x + l.generic.parent.x + LCOLUMN_OFFSET, l.generic.y + l.generic.parent.y, l.generic.name);

  n := PPChar(l.itemnames);

  re.DrawFill(l.generic.x - 112 + l.generic.parent.x, l.generic.parent.y + l.generic.y + l.curvalue * 10 + 10, 128, 10, 16);
  while (n^ <> nil) do
  begin
    Menu_DrawStringR2LDark(l.generic.x + l.generic.parent.x + LCOLUMN_OFFSET, l.generic.y + l.generic.parent.y + y + 10, n^);

    Inc(n);
    Inc(y, 10);
  end;
end;

procedure Separator_Draw(s: menuseparator_p);
begin
  if (s.generic.name <> nil) then
    Menu_DrawStringR2LDark(s.generic.x + s.generic.parent.x, s.generic.y + s.generic.parent.y, s.generic.name);
end;

procedure Slider_DoSlide(s: menuslider_p; dir: integer);
begin
  s^.curvalue := s^.curvalue + dir;

  if (s^.curvalue > s^.maxvalue) then
    s^.curvalue := s^.maxvalue
  else if (s^.curvalue < s^.minvalue) then
    s^.curvalue := s^.minvalue;

  if (@s^.generic.callback <> nil) then
    s^.generic.callback(s);
end;

const
  SLIDER_RANGE = 10;

procedure Slider_Draw(s: menuslider_p);
var
  i: integer;
begin
  Menu_DrawStringR2LDark(s.generic.x + s.generic.parent.x + LCOLUMN_OFFSET,
    s.generic.y + s.generic.parent.y,
    s.generic.name);

  s.range := (s.curvalue - s.minvalue) / (s.maxvalue - s.minvalue);

  if (s.range < 0) then
    s.range := 0;
  if (s.range > 1) then
    s.range := 1;
  re.DrawChar(s.generic.x + s.generic.parent.x + RCOLUMN_OFFSET, s.generic.y + s.generic.parent.y, 128);
  for i := 0 to SLIDER_RANGE do
    re.DrawChar(RCOLUMN_OFFSET + s.generic.x + i * 8 + s.generic.parent.x + 8, s.generic.y + s.generic.parent.y, 129);
  i := SLIDER_RANGE;
  re.DrawChar(RCOLUMN_OFFSET + s.generic.x + i * 8 + s.generic.parent.x + 8, s.generic.y + s.generic.parent.y, 130);
  re.DrawChar(Round(8 + RCOLUMN_OFFSET + s.generic.parent.x + s.generic.x + (SLIDER_RANGE - 1) * 8 * s.range), s.generic.y + s.generic.parent.y, 131);
end;

procedure SpinControl_DoEnter(s: menulist_p);
begin
  Inc(s^.curvalue);
  if (s^.itemnames^[s^.curvalue] = nil) then
    s^.curvalue := 0;

  if (@s^.generic.callback <> nil) then
    s^.generic.callback(s);
end;

procedure SpinControl_DoSlide(s: menulist_p; dir: integer);
begin
  s^.curvalue := s^.curvalue + dir;

  if (s^.curvalue < 0) then
    s^.curvalue := 0
  else if (s^.itemnames^[s^.curvalue] = nil) then
    dec(s^.curvalue);

  if (@s^.generic.callback <> nil) then
    s^.generic.callback(s);
end;

procedure SpinControl_Draw(s: menulist_p);
var
  buffer: array[0..100 - 1] of char;
begin
  if (s^.generic.name <> nil) then
    Menu_DrawStringR2LDark(s^.generic.x + s^.generic.parent.x + LCOLUMN_OFFSET,
      s^.generic.y + s^.generic.parent.y,
      s^.generic.name);

  if (strstr(s^.itemnames^[s^.curvalue], #10) = nil) then
    Menu_DrawString(RCOLUMN_OFFSET + s^.generic.x + s^.generic.parent.x, s^.generic.y + s^.generic.parent.y, s^.itemnames^[s^.curvalue])
  else
  begin
    strcpy(buffer, s^.itemnames^[s^.curvalue]);
    strchr(buffer, Byte(#10))^ := #0;
    Menu_DrawString(RCOLUMN_OFFSET + s^.generic.x + s^.generic.parent.x, s^.generic.y + s^.generic.parent.y, buffer);
    strcpy(buffer, strchr(s^.itemnames^[s^.curvalue], Byte(#10)) + 1);
    Menu_DrawString(RCOLUMN_OFFSET + s^.generic.x + s^.generic.parent.x, s^.generic.y + s^.generic.parent.y + 10, buffer);
  end;
end;

// End of file
end.