amxmodx/editor/studio/UnitfrmMenuGenerator.pas

unit UnitfrmMenuGenerator;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  StdCtrls, ExtCtrls, Forms, TBXDkPanels, SpTBXDkPanels, JvExControls,
  JvComponent, JvPageList, TFlatRadioButtonUnit, TFlatMemoUnit,
  TFlatEditUnit, TB2Dock, TB2Toolbar, TBX, SpTBXItem, ImgList, TB2Item,
  Dialogs, TFlatComboBoxUnit, ComCtrls, ClipBrd, TFlatCheckBoxUnit;

type
  TfrmMenuGenerator = class(TForm)
    jplMain: TJvPageList;
    jspSelectType: TJvStandardPage;
    pnlSelectType: TPanel;
    lblSelectInfo: TLabel;
    optSimpleOldMenu: TSpTBXRadioButton;
    optPlayerMenu: TSpTBXRadioButton;
    optSimpleMenu: TSpTBXRadioButton;
    cmdCancel: TSpTBXButton;
    cmdNext: TSpTBXButton;
    jspOldMenuAdd1: TJvStandardPage;
    optOldPlayerMenu: TSpTBXRadioButton;
    jspNewMenuAdd: TJvStandardPage;
    ilImages: TImageList;
    pnlBack: TPanel;
    pnlMenu: TPanel;
    tbxMenuItems: TSpTBXToolbar;
    mnuAdd: TSpTBXItem;
    mnuRemove: TSpTBXItem;
    sepItems: TSpTBXSeparatorItem;
    mnuUp: TSpTBXItem;
    mnuMoveDown: TSpTBXItem;
    lstNMenuItems: TListBox;
    txtNTitle: TFlatEdit;
    lblNTitle: TLabel;
    lblMenuNItemsCaption: TLabel;
    cmdNCreate: TSpTBXButton;
    cmdBack: TSpTBXButton;
    pnlAccess: TPanel;
    lblAccess: TLabel;
    cboAccess: TFlatComboBox;
    lblState: TLabel;
    tbxColors: TSpTBXToolbar;
    mnuYellow: TSpTBXItem;
    mnuWhite: TSpTBXItem;
    mnuRed: TSpTBXItem;
    mnuGray: TSpTBXItem;
    pnlControls: TPanel;
    rtfMenu: TRichEdit;
    sepColors: TSpTBXSeparatorItem;
    mnuCopy: TSpTBXItem;
    cmdOldNext1: TSpTBXButton;
    cmdOldBack1: TSpTBXButton;
    lblHelp: TLabel;
    jspOldMenuAdd2: TJvStandardPage;
    Panel1: TPanel;
    txtKeys: TFlatEdit;
    lblKeys: TLabel;
    txtMenuName: TFlatEdit;
    lblName: TLabel;
    chkAddComment: TFlatCheckBox;
    chkRegisterMenuCommand: TFlatCheckBox;
    chkUseTime: TFlatCheckBox;
    txtTime: TFlatEdit;
    Label1: TLabel;
    cmdOldNext2: TSpTBXButton;
    cmdOldBack2: TSpTBXButton;
    procedure mnuAddClick(Sender: TObject);
    procedure mnuRemoveClick(Sender: TObject);
    procedure mnuUpClick(Sender: TObject);
    procedure mnuMoveDownClick(Sender: TObject);
    procedure cmdNCreateClick(Sender: TObject);
    procedure cmdBackClick(Sender: TObject);
    procedure cmdNextClick(Sender: TObject);
    procedure lblHelpMouseEnter(Sender: TObject);
    procedure lblHelpMouseLeave(Sender: TObject);
    procedure mnuYellowClick(Sender: TObject);
    procedure mnuWhiteClick(Sender: TObject);
    procedure mnuRedClick(Sender: TObject);
    procedure mnuGrayClick(Sender: TObject);
    procedure rtfMenuMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure rtfMenuKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cmdOldNext1Click(Sender: TObject);
    procedure mnuCopyClick(Sender: TObject);
    procedure cmdOldNext2Click(Sender: TObject);
    procedure lblHelpClick(Sender: TObject);
  private
    procedure UpdateColor;
    procedure UpdateMenu(Sender: TObject);
  end;

var
  frmMenuGenerator: TfrmMenuGenerator;

implementation

uses UnitLanguages, UnitMenuGenerators, UnitCodeUtils, UnitMainTools;

{$R *.DFM}

procedure TfrmMenuGenerator.mnuAddClick(Sender: TObject);
var eStr: String;
begin
  if InputQuery(lAddItemCaption, lAddItemPrompt, eStr) then begin
    if (optPlayerMenu.Checked) and (UpperCase(eStr) = 'PLAYERS') then begin
      eStr := 'PLAYERS';
      if lstNMenuItems.Items.IndexOf('PLAYERS') <> -1 then begin
        MessageBox(Handle, PChar(lPlayersAlreadyAdded), PChar(Application.Title), MB_ICONERROR);
      end;
    end;
    lstNMenuItems.ItemIndex := lstNMenuItems.Items.Add(eStr);
  end;
end;

procedure TfrmMenuGenerator.mnuRemoveClick(Sender: TObject);
begin
  if lstNMenuItems.ItemIndex <> -1 then
    lstNMenuItems.DeleteSelected;
end;

procedure TfrmMenuGenerator.mnuUpClick(Sender: TObject);
begin
  if lstNMenuItems.ItemIndex > 0 then
    lstNMenuItems.Items.Exchange(lstNMenuItems.ItemIndex, lstNMenuItems.ItemIndex -1);
end;

procedure TfrmMenuGenerator.mnuMoveDownClick(Sender: TObject);
begin
  if (lstNMenuItems.ItemIndex <> -1) and (lstNMenuItems.ItemIndex <> lstNMenuItems.Items.Count -1) then
    lstNMenuItems.Items.Exchange(lstNMenuItems.ItemIndex, lstNMenuItems.ItemIndex +1); 
end;

procedure TfrmMenuGenerator.cmdNCreateClick(Sender: TObject);
begin
  if txtNTitle.Text = '' then
    MessageBox(Handle, PChar(lEnterTitle), PChar(Application.Title), MB_ICONERROR)
  else if lstNMenuItems.Items.Count = 0 then
    MessageBox(Handle, PChar(lAddItems), PChar(Application.Title), MB_ICONERROR)
  else if self.optSimpleMenu.Checked then begin
    GenerateSimpleMenu;
    ModalResult := mrOk;
  end;
end;

procedure TfrmMenuGenerator.cmdBackClick(Sender: TObject);
begin
  if jplMain.ActivePage = jspOldMenuAdd2 then
    jplMain.ActivePage := jspOldMenuAdd1
  else begin
    jplMain.ActivePageIndex := 0;
    lblState.Caption := 'Menu Generator';
  end;
end;

procedure TfrmMenuGenerator.cmdNextClick(Sender: TObject);
begin
  // New style
  if optSimpleMenu.Checked then begin
    jplMain.ActivePageIndex := 1;
    lblState.Caption := 'Create a simple menu';
  end;
  // Old style
  if optSimpleOldMenu.Checked then begin
    jplMain.ActivePageIndex := 2;
    lblState.Caption := 'Create a simple menu';
    lblHelp.Hide;
  end;
  if optOldPlayerMenu.Checked then begin
    jplMain.ActivePageIndex := 2;
    lblState.Caption := 'Create a player menu';
    lblHelp.Show;
  end;
end;

procedure TfrmMenuGenerator.lblHelpMouseEnter(Sender: TObject);
begin
  lblHelp.Font.Color := clHotLight;
  lblHelp.Font.Style := [fsUnderline];
end;

procedure TfrmMenuGenerator.lblHelpMouseLeave(Sender: TObject);
begin
  lblHelp.Font.Color := clWindowText;
  lblHelp.Font.Style := [];
end;

procedure TfrmMenuGenerator.mnuYellowClick(Sender: TObject);
begin
  rtfMenu.SelAttributes.Color := clYellow;
  UpdateMenu(Sender);
end;

procedure TfrmMenuGenerator.mnuWhiteClick(Sender: TObject);
begin
  rtfMenu.SelAttributes.Color := clWhite;
  UpdateMenu(Sender);
end;

procedure TfrmMenuGenerator.mnuRedClick(Sender: TObject);
begin
  rtfMenu.SelAttributes.Color := clRed;
  UpdateMenu(Sender);
end;

procedure TfrmMenuGenerator.mnuGrayClick(Sender: TObject);
begin
  rtfMenu.SelAttributes.Color := clGray;
  UpdateMenu(Sender);
end;

procedure TfrmMenuGenerator.UpdateColor;
begin
  case rtfMenu.SelAttributes.Color of
    clYellow: mnuYellow.Checked := True;
    clWhite: mnuWhite.Checked := True;
    clRed: mnuRed.Checked := True;
    clGray: mnuGray.Checked := True;
  end;
end;

procedure TfrmMenuGenerator.UpdateMenu(Sender: TObject);
begin
  mnuYellow.Checked := Sender = mnuYellow;
  mnuWhite.Checked := Sender = mnuWhite;
  mnuRed.Checked := Sender = mnuRed;
  mnuGray.Checked := Sender = mnuGray;
end;

procedure TfrmMenuGenerator.rtfMenuMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  UpdateColor;
end;

procedure TfrmMenuGenerator.rtfMenuKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  UpdateColor;
end;

procedure TfrmMenuGenerator.cmdOldNext1Click(Sender: TObject);
var i, k: integer;
    a, b: integer;
begin
  if Trim(rtfMenu.Text) = '' then begin
    MessageBox(Handle, 'The menu is empty!', PChar(Application.Title), MB_ICONERROR);
    exit;
  end;

  txtKeys.Clear;
  for i := 0 to rtfMenu.Lines.Count -1 do begin
    if IsNumeric(Copy(rtfMenu.Lines[i], 1, 1)) then
      txtKeys.Text := txtKeys.Text + rtfMenu.Lines[i][1];
    if lblHelp.Visible then begin
      try
        if Pos('$players(', LowerCase(rtfMenu.Lines[i])) = 1 then begin
          a := StrToInt(Trim(Between(rtfMenu.Lines[i], '$players(', ',')));
          b := StrToInt(Trim(Between(rtfMenu.Lines[i], '$players(' + IntToStr(a) + ',', ',')));
          for k := a to b do
            txtKeys.Text := txtKeys.Text + IntToStr(k);
        end;
        
        if Pos('$next(', LowerCase(rtfMenu.Lines[i])) = 1 then begin
          a := StrToInt(Trim(Between(rtfMenu.Lines[i], '$next(', ',')));
          txtKeys.Text := txtKeys.Text + IntToStr(a);
        end;

        if Pos('$exitorback(', LowerCase(rtfMenu.Lines[i])) = 1 then begin
          a := StrToInt(Trim(Between(rtfMenu.Lines[i], '$exitorback(', ',')));
          txtKeys.Text := txtKeys.Text + IntToStr(a);
        end;
      except
        MessageBox(Handle, PChar('Invalid menu.'), PChar(Application.Title), MB_ICONERROR);
      end;
    end;
  end;
  jplMain.ActivePageIndex := 3;
end;

procedure TfrmMenuGenerator.mnuCopyClick(Sender: TObject);
begin
  Clipboard.SetTextBuf(PChar(GetColoredMenu));
  MessageBox(Handle, 'Okay, menu copied to clipboard.', PChar(Application.Title), MB_ICONINFORMATION);
end;

procedure TfrmMenuGenerator.cmdOldNext2Click(Sender: TObject);
begin
  if optSimpleOldMenu.Checked then
    AddOldMenu
  else
    AddOldPlayerMenu;
  ModalResult := mrOk;
end;

procedure TfrmMenuGenerator.lblHelpClick(Sender: TObject);
var eMsg: String;
begin
  eMsg :=        '1. Choose a menu title (e.g. Kick player)' + #13;
  eMsg := eMsg + '2. Set dynamic players with $players in this format:' + #13;
  eMsg := eMsg + '   $players(StartKey, StopKey, Caption)' + #13;
  eMsg := eMsg + '   Variables in caption are: %n (Key) and %v(Player)' + #13;
  eMsg := eMsg + '3. Set Next and Back keys using $next(Key, Caption)' + #13;
  eMsg := eMsg + '   and $exitorback(Key, ExitCaption, BackCaption)' + #13;
  eMsg := eMsg + #13;
  eMsg := eMsg + 'Show example?';

  if MessageBox(Handle, PChar(eMsg), PChar(Application.Title), MB_ICONQUESTION + MB_YESNO) = mrYes then begin
    rtfMenu.Clear;
    rtfMenu.SelAttributes.Color := clYellow;
    rtfMenu.SelText := 'Kick player' + #13 + #13;
    rtfMenu.SelStart := Length(rtfMenu.Lines.Text);
    rtfMenu.SelAttributes.Color := clWhite;
    rtfMenu.SelText := #13 + '$players(1,8,%n. %v)';
    rtfMenu.SelStart := Length(rtfMenu.Lines.Text);
    rtfMenu.SelAttributes.Color := clWhite;
    rtfMenu.SelText := #13 + #13 + '$next(9,9. Next)';
    rtfMenu.SelStart := Length(rtfMenu.Lines.Text);
    rtfMenu.SelAttributes.Color := clWhite;
    rtfMenu.SelText := #13 + '$exitorback(0,0. Exit,0. Back)';
    rtfMenu.SelStart := 0;
  end;
end;

end.