462 lines
13 KiB
ObjectPascal
462 lines
13 KiB
ObjectPascal
|
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.
|