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.