amxmodx/editor/editor2/UnitfrmMenuMaker.pas

462 lines
13 KiB
ObjectPascal
Executable File

unit UnitfrmMenuMaker;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
StdCtrls, ExtCtrls, Forms, TFlatMemoUnit, XPStyleActnCtrls, ActnList,
ActnMan, ToolWin, ActnCtrls, ComCtrls, CorelButton, ImgList,
TFlatEditUnit, TFlatCheckBoxUnit;
type
TfrmMenuMaker = class(TForm)
pnlButtons: TPanel;
cmdCancel: TCorelButton;
ilButtons: TImageList;
amButtons: TActionManager;
acPaste: TAction;
acCopy: TAction;
acCut: TAction;
acClear: TAction;
acMenu: TAction;
acGrey: TAction;
acRed: TAction;
acWhite: TAction;
acYellow: TAction;
cmdNext: TCorelButton;
nbkPages: TNotebook;
atbButtons: TActionToolBar;
rtfEditor: TRichEdit;
pnlSettings: TPanel;
chkRegisterMenuCommand: TFlatCheckBox;
chkAddComment: TFlatCheckBox;
txtKeys: TFlatEdit;
lblKeys: TLabel;
bvlSpace: TBevel;
lblSettings: TLabel;
lblName: TLabel;
txtMenuName: TFlatEdit;
txtTime: TFlatEdit;
chkUseTime: TFlatCheckBox;
chkAppendOnlyMenuText: TFlatCheckBox;
lblNote: TLabel;
lblSettingsPlayers: TLabel;
pnlSettingsPlayers: TPanel;
lblMenu: TLabel;
txtMenu: TFlatEdit;
lblHelp: TLabel;
chkAlive: TFlatCheckBox;
bvlSpace2: TBevel;
chkRegister: TFlatCheckBox;
chkComments: TFlatCheckBox;
chkImmunity: TFlatCheckBox;
procedure acCopyExecute(Sender: TObject);
procedure acCutExecute(Sender: TObject);
procedure acPasteExecute(Sender: TObject);
procedure acClearExecute(Sender: TObject);
procedure acYellowExecute(Sender: TObject);
procedure acWhiteExecute(Sender: TObject);
procedure acRedExecute(Sender: TObject);
procedure acGreyExecute(Sender: TObject);
procedure txtKeysChange(Sender: TObject);
procedure cmdCancelClick(Sender: TObject);
procedure cmdNextClick(Sender: TObject);
procedure rtfEditorKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure rtfEditorKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure rtfEditorMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure rtfEditorMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure chkUseTimeClick(Sender: TObject);
procedure txtMenuNameKeyPress(Sender: TObject; var Key: Char);
procedure chkAppendOnlyMenuTextClick(Sender: TObject);
procedure txtTimeChange(Sender: TObject);
procedure rtfEditorChange(Sender: TObject);
procedure acMenuExecute(Sender: TObject);
procedure lblHelpMouseEnter(Sender: TObject);
procedure lblHelpMouseLeave(Sender: TObject);
procedure lblHelpClick(Sender: TObject);
private
Editing: Boolean;
FDefaultMenu: Boolean;
procedure SetDefaultMenu(const Value: Boolean);
public
property DefaultMenu: Boolean read FDefaultMenu write SetDefaultMenu;
function GetColoredMenu: String;
procedure SetButton(Action: TAction);
procedure UpdateCurColor;
procedure Reset;
end;
var
frmMenuMaker: TfrmMenuMaker;
implementation
uses UnitAddMenu, UnitfrmSelectMenu, UnitfrmMain, UnitHowToMakePlayerMenu;
{$R *.DFM}
procedure TfrmMenuMaker.acCopyExecute(Sender: TObject);
begin
rtfEditor.CopyToClipboard;
end;
procedure TfrmMenuMaker.acCutExecute(Sender: TObject);
begin
rtfEditor.CutToClipboard;
end;
procedure TfrmMenuMaker.acPasteExecute(Sender: TObject);
begin
rtfEditor.PasteFromClipboard;
end;
procedure TfrmMenuMaker.acClearExecute(Sender: TObject);
begin
rtfEditor.Clear;
rtfEditor.SelAttributes.Color := clWhite;
UpdateCurColor;
end;
procedure TfrmMenuMaker.acYellowExecute(Sender: TObject);
begin
rtfEditor.SelAttributes.Color := clYellow;
SetButton(acYellow);
end;
procedure TfrmMenuMaker.acWhiteExecute(Sender: TObject);
begin
rtfEditor.SelAttributes.Color := clWhite;
SetButton(acWhite);
end;
procedure TfrmMenuMaker.acRedExecute(Sender: TObject);
begin
rtfEditor.SelAttributes.Color := clRed;
SetButton(acRed);
end;
procedure TfrmMenuMaker.acGreyExecute(Sender: TObject);
begin
rtfEditor.SelAttributes.Color := clGray;
SetButton(acGrey);
end;
procedure TfrmMenuMaker.SetButton(Action: TAction);
begin
if Action <> acYellow then
acYellow.Checked := False;
if Action <> acWhite then
acWhite.Checked := False;
if Action <> acRed then
acRed.Checked := False;
if Action <> acGrey then
acGrey.Checked := False;
Action.Checked := True;
end;
procedure TfrmMenuMaker.txtKeysChange(Sender: TObject);
begin
try
StrToInt(Trim((Sender As TFlatEdit).Text));
except
if Sender = txtKeys then begin
(Sender As TFlatEdit).Text := '1';
SysUtils.Beep;
end
else
(Sender As TFlatEdit).Text := '';
end;
end;
procedure TfrmMenuMaker.cmdCancelClick(Sender: TObject);
begin
if nbkPages.PageIndex = 0 then
ModalResult := mrCancel
else begin
nbkPages.PageIndex := 0;
if not DefaultMenu then begin
lblNote.Visible := True;
lblHelp.Visible := True;
end;
cmdCancel.Caption := 'Cancel';
cmdNext.Caption := '&Next >';
end;
end;
procedure TfrmMenuMaker.cmdNextClick(Sender: TObject);
function IsNumeric(eChar: Char): Boolean;
begin
Result := Pos(eChar, '0123456789') <> 0;
end;
var i: integer;
eColoredMenu: String;
begin
if Editing then begin
eColoredMenu := GetColoredMenu;
frmMain.sciEditor.Lines[frmSelectMenu.eLines[frmSelectMenu.GetItemIndex]] := StringReplace(frmMain.sciEditor.Lines[frmSelectMenu.eLines[frmSelectMenu.GetItemIndex]], '"' + frmSelectMenu.eMenuStr[frmSelectMenu.GetItemIndex] + '"', '"' + eColoredMenu + '"', []);
Editing := False;
ModalResult := mrOk;
end
else if nbkPages.PageIndex = 0 then begin // Editor
if DefaultMenu then begin
txtKeys.Text := '0';
for i := 0 to rtfEditor.Lines.Count -1 do begin
if Length(rtfEditor.Lines[i]) <> 0 then begin
if IsNumeric(rtfEditor.Lines[i][1]) then
txtKeys.Text := txtKeys.Text + rtfEditor.Lines[i][1];
end;
end;
if Length(txtKeys.Text) <> 1 then
txtKeys.Text := Copy(txtKeys.Text, 2, Length(txtKeys.Text));
nbkPages.PageIndex := 1;
end
else begin
if Pos('$players', LowerCase(rtfEditor.Lines.Text)) = 0 then begin
MessageBox(Handle, 'You forgot to set the players.', 'Warning', MB_ICONWARNING);
exit;
end;
if (Pos('$next', LowerCase(rtfEditor.Lines.Text)) = 0) and (Pos('$back', LowerCase(rtfEditor.Lines.Text)) = 0) then
MessageBox(Handle, 'You should set a "Next" and a "Back" key.', 'Warning', MB_ICONWARNING)
else if Pos('$next', LowerCase(rtfEditor.Lines.Text)) = 0 then
MessageBox(Handle, 'You should set a "Next"-key.', 'Warning', MB_ICONWARNING)
else if Pos('$exitorback', LowerCase(rtfEditor.Lines.Text)) = 0 then
MessageBox(Handle, 'You should set a "Back"-key.', 'Warning', MB_ICONWARNING);
nbkPages.PageIndex := 2;
end;
cmdCancel.Caption := '< &Back';
cmdNext.Caption := 'Finish';
end
else if nbkPages.PageIndex = 1 then begin // Default finish
if (txtMenuName.Text = '') and (not chkAppendOnlyMenuText.Checked) then
MessageBox(Handle, 'Invalid menu name.', 'Warning', MB_ICONWARNING)
else begin
Screen.Cursor := crHourGlass;
if AddMenu then
ModalResult := mrOk
else
MessageBox(Handle, 'Menu already exists. Please choose another name.', 'Warning', MB_ICONWARNING);
Screen.Cursor := crDefault;
end;
end
else begin // Player finish
if (txtMenu.Text = '') then
MessageBox(Handle, 'Invalid menu name.', 'Warning', MB_ICONWARNING)
else begin
if AddPlayerMenu then
ModalResult := mrOk;
Screen.Cursor := crDefault;
end;
end;
lblNote.Visible := False;
lblHelp.Visible := False;
end;
procedure TfrmMenuMaker.UpdateCurColor;
begin
case rtfEditor.SelAttributes.Color of
clYellow: SetButton(acYellow);
clWhite: SetButton(acWhite);
clRed: SetButton(acRed);
clGray: SetButton(acGrey);
end;
atbButtons.RecreateControls;
end;
procedure TfrmMenuMaker.rtfEditorKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
UpdateCurColor;
end;
procedure TfrmMenuMaker.rtfEditorKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
UpdateCurColor;
end;
procedure TfrmMenuMaker.rtfEditorMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
UpdateCurColor;
end;
procedure TfrmMenuMaker.rtfEditorMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
UpdateCurColor;
end;
procedure TfrmMenuMaker.chkUseTimeClick(Sender: TObject);
begin
txtTime.Enabled := chkUseTime.Checked;
if not chkUseTime.Checked then
txtTime.Text := '-1';
end;
procedure TfrmMenuMaker.txtMenuNameKeyPress(Sender: TObject;
var Key: Char);
begin
if Key = #32 then
Key := #0;
end;
procedure TfrmMenuMaker.chkAppendOnlyMenuTextClick(Sender: TObject);
begin
lblKeys.Enabled := not chkAppendOnlyMenuText.Checked;
txtKeys.Enabled := not chkAppendOnlyMenuText.Checked;
chkAddComment.Enabled := not chkAppendOnlyMenuText.Checked;
chkRegisterMenuCommand.Enabled := not chkAppendOnlyMenuText.Checked;
chkUseTime.Enabled := not chkAppendOnlyMenuText.Checked;
txtTime.Enabled := not chkAppendOnlyMenuText.Checked;
lblName.Enabled := not chkAppendOnlyMenuText.Checked;
txtMenuName.Enabled := not chkAppendOnlyMenuText.Checked;
end;
procedure TfrmMenuMaker.txtTimeChange(Sender: TObject);
begin
try
if StrToInt(txtTime.Text) < -1 then begin
txtTime.Text := '-1';
SysUtils.Beep;
end;
except
txtTime.Text := '1000';
SysUtils.Beep;
end;
end;
procedure TfrmMenuMaker.rtfEditorChange(Sender: TObject);
begin
cmdNext.Enabled := rtfEditor.Text <> '';
end;
procedure TfrmMenuMaker.SetDefaultMenu(const Value: Boolean);
begin
FDefaultMenu := Value;
lblNote.Visible := not Value;
lblHelp.Visible := not Value;
acMenu.Enabled := Value;
Editing := False;
if Value then
Caption := 'Menu Maker'
else
Caption := 'Player Menu Maker';
end;
procedure TfrmMenuMaker.acMenuExecute(Sender: TObject);
var eTemp: String;
begin
if frmSelectMenu.ShowModal = mrOk then begin
atbButtons.RecreateControls;
if frmSelectMenu.GetItemIndex = -1 then
frmSelectMenu.lstMenu.Selected[0] := True;
DefaultMenu := True;
Editing := True;
rtfEditor.Clear;
rtfEditor.SelAttributes.Color := clWhite;
eTemp := frmSelectMenu.eMenuStr[frmSelectMenu.GetItemIndex];
if eTemp <> '' then begin
while Length(eTemp) <> 0 do begin
if eTemp[1] = '\' then begin
if Length(eTemp) <> 1 then begin
case LowerCase(eTemp[2])[1] of
'w': rtfEditor.SelAttributes.Color := clWhite;
'r': rtfEditor.SelAttributes.Color := clRed;
'd': rtfEditor.SelAttributes.Color := clGray;
'y': rtfEditor.SelAttributes.Color := clYellow;
end;
end;
Delete(eTemp, 1, 2);
end
else if Copy(eTemp, 1, 2) = '^n' then begin
rtfEditor.SelText := #13#10;
Delete(eTemp, 1, 2);
end
else begin
rtfEditor.SelText := eTemp[1];
Delete(eTemp, 1, 1);
end;
end;
end;
cmdNext.Caption := 'Finish edit';
end
else
atbButtons.RecreateControls;
end;
function TfrmMenuMaker.GetColoredMenu: String;
var i: integer;
eCurColor: TColor;
begin
eCurColor := clWhite;
Result := '';
for i := 0 to Length(rtfEditor.Lines.Text) -1 do begin
rtfEditor.SelStart := i;
if rtfEditor.SelAttributes.Color <> eCurColor then begin
eCurColor := rtfEditor.SelAttributes.Color;
case eCurColor of
clWhite : Result := Result + '\w';
clYellow: Result := Result + '\y';
clRed : Result := Result + '\r';
clGray : Result := Result + '\d';
end;
end;
Result := Result + rtfEditor.Lines.Text[i+1];
end;
rtfEditor.SelStart := 0;
Result := StringReplace(Result, #13, '^n', [rfReplaceAll]);
Result := StringReplace(Result, #10, '', [rfReplaceAll]);
end;
procedure TfrmMenuMaker.Reset;
begin
rtfEditor.Clear;
rtfEditor.SelAttributes.Color := clWhite;
txtKeys.Text := '1';
txtMenu.Clear;
txtMenuName.Clear;
UpdateCurColor;
end;
procedure TfrmMenuMaker.lblHelpMouseEnter(Sender: TObject);
begin
lblHelp.Font.Color := clBlue;
lblHelp.Font.Style := [fsUnderline];
end;
procedure TfrmMenuMaker.lblHelpMouseLeave(Sender: TObject);
begin
lblHelp.Font.Color := clWindowText;
lblHelp.Font.Style := [];
end;
procedure TfrmMenuMaker.lblHelpClick(Sender: TObject);
procedure Append(eText: String);
begin
rtfEditor.SelText := eText + #13#10;
rtfEditor.SelStart := Length(rtfEditor.Lines.Text);
end;
begin
if frmHowToMakePlayerMenu.ShowModal = mrYes then begin
rtfEditor.Clear;
rtfEditor.SelAttributes.Color := clYellow;
Append('Kick player');
Append('');
rtfEditor.SelAttributes.Color := clWhite;
Append('$players(1,8,%n. %v)');
Append('$next(9,9. Next)');
Append('');
Append('$exitorback(0,0. Exit,0. Back)');
end;
end;
end.