amxmodx/editor/studio/UnitfrmMenuGenerator.pas
Christian Hammacher 78b35d80ee Fixed some bugs in the menu generator
Fixed bug in the AutoUpdate function
2005-11-06 14:52:50 +00:00

329 lines
10 KiB
ObjectPascal
Executable File

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.