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, SpTBXControls; 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.