Added AMXX-Studio to CVS
This commit is contained in:
Christian Hammacher
295
editor/studio/UnitfrmMenuGenerator.pas
Executable file
295
editor/studio/UnitfrmMenuGenerator.pas
Executable file
@ -0,0 +1,295 @@
|
||||
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
|
||||
jplMain.ActivePageIndex := 0;
|
||||
lblState.Caption := 'Menu Generator';
|
||||
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: 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];
|
||||
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 := '$players(1,8,%n. %v)' + #13 + '$next(9,9. Next)' + '$exitorback(0,0. Exit,0. Back)';
|
||||
rtfMenu.SelStart := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user