Skip to content

P
puzzle-editor
Commit 4021fc87 authored by rarnu's avatar rarnu
Browse files
Options

add: 更新图标，修复读取MDPro3安装信息的方式，增加调用MDPro3进行测试

parent cbe6afdb
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 559 additions and 314 deletions
PuzzleEditor.lpi
View file @ 4021fc87
......@@ -211,6 +211,9 @@
<Item>
<Name Value="RunError(103)"/>
</Item>
<Item>
<Name Value="ESocketError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>
PuzzleEditor.lpr
View file @ 4021fc87
......@@ -11,18 +11,16 @@ uses
{$ENDIF}
Interfaces, // this includes the LCL widgetset
SysUtils,
Forms, Dialogs, opensslsockets, untData, frmHome;
Forms, Dialogs, opensslsockets, untData, frmHome, untConfig;
{$R *.res}
var
AMDPro3Path: string;
ADataPath: string;
begin
AMDPro3Path:= ExtractFilePath(ParamStr(0)) + 'MDPro3.exe';
ADataPath:= ExtractFilePath(ParamStr(0)) + 'Data';
if (not FileExists(AMDPro3Path)) or (not DirectoryExists(ADataPath)) then begin
ShowMessage('请将残局编辑器放置到 MDPro3 的安装目录下');
AMDPro3Path:= TConfigReader.GetMDPro3InstallPath();
if (AMDPro3Path = '') or (not DirectoryExists(AMDPro3Path)) then begin
MessageDlg('提示', '没有安装 MDPro3，请先进行安装', mtError, [mbOK], 0);
Exit;
end;
......
frmhome.lfm
View file @ 4021fc87
This diff is collapsed.
frmhome.pas
View file @ 4021fc87
......@@ -5,8 +5,8 @@ unit frmHome;
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, orca_scene2d, fgl, untData, untConstant, untCard, untUtils,
untAPI;
Windows, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, orca_scene2d, fgl, untData, untConstant, untCard, untUtils,
untAPI, ShellApi;
type
......@@ -209,7 +209,7 @@ type
btnOpen: TD2ToolButton;
btnSave: TD2ToolButton;
btnConfig: TD2ToolButton;
btnExport: TD2ToolButton;
btnDebug: TD2ToolButton;
txtOwner: TD2Text;
procedure btnAboutClick(Sender: TObject);
procedure btnAddCardClick(Sender: TObject);
......@@ -218,7 +218,7 @@ type
procedure btnConfigClick(Sender: TObject);
procedure btnDelCardClick(Sender: TObject);
procedure btnEditCardListClick(Sender: TObject);
procedure btnExportClick(Sender: TObject);
procedure btnDebugClick(Sender: TObject);
procedure btnNewClick(Sender: TObject);
procedure btnOpenClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
......@@ -1031,8 +1031,39 @@ begin
end;
procedure TFormHome.UploadPuzzle();
var
APuzzleCode: string;
AP: TEntityPuzzle;
ARet: TSavePuzzleResult;
begin
// TODO: upload puzzle
// upload puzzle
if FPuzzle = nil then Exit;
if FUserInfo = nil then Exit;
if FUserInfo.id = 0 then Exit;
if FUserToken = '' then Exit;
btnUpload.Enabled:= False;
APuzzleCode:= TScriptGenerator.Generate(FPuzzle);
AP := TEntityPuzzle.Create;
AP.id:= FPuzzle.PuzzleId;
AP.name:= FPuzzle.PuzzleName;
AP.userId:= FUserInfo.id;
AP.contributor:= FUserInfo.username;
AP.message:= FPuzzle.Message;
AP.solution:= FPuzzle.Solution;
AP.coverCard:= GetFirstCardFromScriptCode(APuzzleCode);
AP.luaScript:= APuzzleCode;
ARet := TAPI.SavePuzzle(AP, FUserInfo.id, FUserToken);
if ARet <> nil then begin
FPuzzle.PuzzleId:= Aret.data;
SavePuzzle();
ARet.Free;
MessageDlg('提示', '上传残局成功', mtConfirmation, [mbOK], 0);
end else begin
MessageDlg('提示', '上传残局失败', mtError, [mbOK], 0);
end;
btnUpload.Enabled:= True;
end;
procedure TFormHome.btnNewClick(Sender: TObject);
......@@ -1046,12 +1077,14 @@ procedure TFormHome.btnConfigClick(Sender: TObject);
begin
// config
with TFormPuzzleConfig.Create(Self) do begin
PPuzzleName:= FPuzzle.PuzzleName;
PAIName:= FPuzzle.AIName;
P0LP:= FPuzzle.LPSelf;
P1LP:= FPuzzle.LPOpponent;
PMessage:= FPuzzle.Message;
PSolution:= FPuzzle.Solution;
if ShowModal = mrOK then begin
FPuzzle.PuzzleName:= PPuzzleName;
FPuzzle.AIName:= PAIName;
FPuzzle.LPSelf:= P0LP;
FPuzzle.LPOpponent:= P1LP;
......@@ -1267,8 +1300,6 @@ begin
FillCardIds(cardIds);
if ShowModal = mrOK then begin
// CardList;
ShowMessage(Format('Changed %d', [CardList.Count]));
case FFieldInfo.Owner of
foSelf:
begin
......@@ -1339,23 +1370,29 @@ begin
cardIds.Free;
end;
procedure TFormHome.btnExportClick(Sender: TObject);
procedure TFormHome.btnDebugClick(Sender: TObject);
const
DEBUG_NAME = '._debug_';
var
ADir: string;
ALuaFileName: string;
ACode: string;
AMDPro3Path: string;
begin
SavePuzzle();
if (FFilePath <> '') then begin
// export
ALuaFileName := ChangeFileExt(FFilePath, '.lua');
ACode := TScriptGenerator.Generate(FPuzzle);
with TStringList.Create do begin
Text:= ACode;
SaveToFile(ALuaFileName);
Free;
end;
ShowMessage('导出残局脚本完成!');
if (FFilePath = '') then Exit;
ADir:= TConfigReader.GetMDPro3InstallPath();
ALuaFileName:= ADir + DirectorySeparator + 'Puzzle' + DirectorySeparator + DEBUG_NAME + '.lua';
ACode:= TScriptGenerator.Generate(FPuzzle);
with TStringList.Create do begin
Text:= ACode;
SaveToFile(ALuaFileName);
Free;
end;
// debug
AMDPro3Path:= ADir + DirectorySeparator + 'MDPro3.exe';
ShellExecute(0, 'open', PChar(AMDPro3Path), PChar(Format('-s %s', [DEBUG_NAME])), PChar(ADir), SW_SHOWNORMAL);
end;
procedure TFormHome.btnOpenClick(Sender: TObject);
......
frmpuzzleconfig.lfm
View file @ 4021fc87
......@@ -26,7 +26,7 @@ object FormPuzzleConfig: TFormPuzzleConfig
HitTest = False
object Layout1: TD2Layout
Align = vaTop
Position.Point = '(8,58)'
Position.Point = '(8,108)'
Width = 584
Height = 50
object Label1: TD2Label
......@@ -62,7 +62,7 @@ object FormPuzzleConfig: TFormPuzzleConfig
end
object Layout2: TD2Layout
Align = vaTop
Position.Point = '(8,108)'
Position.Point = '(8,158)'
Width = 584
Height = 50
object Label2: TD2Label
......@@ -98,9 +98,9 @@ object FormPuzzleConfig: TFormPuzzleConfig
end
object Layout3: TD2Layout
Align = vaTop
Position.Point = '(8,158)'
Position.Point = '(8,208)'
Width = 584
Height = 300
Height = 265
object Label3: TD2Label
Align = vaTop
Position.Point = '(8,0)'
......@@ -119,7 +119,7 @@ object FormPuzzleConfig: TFormPuzzleConfig
Align = vaClient
Position.Point = '(8,50)'
Width = 568
Height = 242
Height = 207
Padding.Rect = '(8,0,8,8)'
TabOrder = 1
UseSmallScrollBars = True
......@@ -130,9 +130,9 @@ object FormPuzzleConfig: TFormPuzzleConfig
end
object Layout4: TD2Layout
Align = vaClient
Position.Point = '(8,458)'
Position.Point = '(8,473)'
Width = 584
Height = 284
Height = 269
object Label4: TD2Label
Align = vaTop
Position.Point = '(8,0)'
......@@ -151,7 +151,7 @@ object FormPuzzleConfig: TFormPuzzleConfig
Align = vaClient
Position.Point = '(8,50)'
Width = 568
Height = 226
Height = 211
Padding.Rect = '(8,0,8,8)'
TabOrder = 1
UseSmallScrollBars = True
......@@ -204,7 +204,7 @@ object FormPuzzleConfig: TFormPuzzleConfig
end
object Layout6: TD2Layout
Align = vaTop
Position.Point = '(8,8)'
Position.Point = '(8,58)'
Width = 584
Height = 50
object Label5: TD2Label
......@@ -222,6 +222,39 @@ object FormPuzzleConfig: TFormPuzzleConfig
Text = 'AI 名称'
end
object edtAIName: TD2TextBox
Align = vaClient
Position.Point = '(136,8)'
Width = 440
Height = 34
Padding.Rect = '(8,8,8,8)'
TabOrder = 1
Font.Family = 'Microsoft Yahei'
Font.Size = 18
ReadOnly = False
Password = False
Text = '我的AI'
end
end
object Layout7: TD2Layout
Align = vaTop
Position.Point = '(8,8)'
Width = 584
Height = 50
object Label6: TD2Label
Align = vaLeft
Position.Point = '(8,0)'
Width = 120
Height = 50
Padding.Rect = '(8,0,0,0)'
TabOrder = 0
Font.Family = 'Microsoft yahei'
Font.Size = 18
Font.Style = d2FontBold
TextAlign = d2TextAlignNear
VertTextAlign = d2TextAlignCenter
Text = '残局名称'
end
object edtPuzzleName: TD2TextBox
Align = vaClient
Position.Point = '(136,8)'
Width = 440
......@@ -1859,7 +1892,7 @@ object FormPuzzleConfig: TFormPuzzleConfig
000000000000F005400648656967687405000000000000008803400C50616464
696E672E52656374060928302C322C302C32290C436C69704368696C6472656E
09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F
6E74616C0E506F736974696F6E2E506F696E74060628312C383429064C6F636B
6E74616C0E506F736974696F6E2E506F696E74060628312C383629064C6F636B
6564090557696474680500000000000000EC0540064865696768740500000000
000000E404400C50616464696E672E52656374060928312C312C312C31290748
697454657374080A46696C6C2E5374796C65070F643242727573684772616469
......
frmpuzzleconfig.pas
View file @ 4021fc87
......@@ -20,6 +20,7 @@ type
Label3: TD2Label;
Label4: TD2Label;
Label5: TD2Label;
Label6: TD2Label;
Layout1: TD2Layout;
Layout2: TD2Layout;
Layout3: TD2Layout;
......@@ -28,26 +29,31 @@ type
edtSelfLP: TD2NumberBox;
edtOpponentLP: TD2NumberBox;
Layout6: TD2Layout;
Layout7: TD2Layout;
mmMessage: TD2Memo;
mmSolution: TD2Memo;
Root: TD2Background;
Scene: TD2Scene;
edtAIName: TD2TextBox;
edtPuzzleName: TD2TextBox;
private
function GetAIName: string;
function GetP0LP: Integer;
function GetP1LP: Integer;
function GetPMessage: string;
function GetPPuzzleName: string;
function GetPSolution: string;
procedure SetAIName(AValue: string);
procedure SetP0LP(AValue: Integer);
procedure SetP1LP(AValue: Integer);
procedure SetPMessage(AValue: string);
procedure SetPPuzzleName(AValue: string);
procedure SetPSolution(AValue: string);
public
published
property PPuzzleName: string read GetPPuzzleName write SetPPuzzleName;
property PAIName: string read GetAIName write SetAIName;
property P0LP: Integer read GetP0LP write SetP0LP;
property P1LP: Integer read GetP1LP write SetP1LP;
......@@ -84,6 +90,11 @@ begin
Exit(mmMessage.Lines.Text);
end;
function TFormPuzzleConfig.GetPPuzzleName: string;
begin
Exit(edtPuzzleName.Text);
end;
function TFormPuzzleConfig.GetPSolution: string;
begin
Exit(mmSolution.Lines.Text);
......@@ -109,6 +120,11 @@ begin
mmMessage.Lines.Text:= AValue;
end;
procedure TFormPuzzleConfig.SetPPuzzleName(AValue: string);
begin
edtPuzzleName.Text:= AValue;
end;
procedure TFormPuzzleConfig.SetPSolution(AValue: string);
begin
mmSolution.Lines.Text:= AValue;
......
frmsearchcard.lfm
View file @ 4021fc87
......@@ -52,7 +52,6 @@ object FormSearchCard: TFormSearchCard
Font.Size = 18
ReadOnly = False
Password = False
Text = '百夫'
end
object btnSearchCard: TD2CornerButton
Align = vaLeft
......@@ -1751,7 +1750,7 @@ object FormSearchCard: TFormSearchCard
000000000000F005400648656967687405000000000000008803400C50616464
696E672E52656374060928302C322C302C32290C436C69704368696C6472656E
09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F
6E74616C0E506F736974696F6E2E506F696E74060628312C383229064C6F636B
6E74616C0E506F736974696F6E2E506F696E74060628312C383429064C6F636B
6564090557696474680500000000000000EC0540064865696768740500000000
000000E404400C50616464696E672E52656374060928312C312C312C31290748
697454657374080A46696C6C2E5374796C65070F643242727573684772616469
......
images/menu_about.png
View replaced file @ cbe6afdb View file @ 4021fc87
images/menu_about.png

1.29 KB | W: | H:

images/menu_about.png

10.2 KB | W: | H:

images/menu_about.png
images/menu_about.png
images/menu_about.png
images/menu_about.png
  • 2-up
  • Swipe
  • Onion skin
images/menu_config.png
View replaced file @ cbe6afdb View file @ 4021fc87
images/menu_config.png

1.44 KB | W: | H:

images/menu_config.png

9.91 KB | W: | H:

images/menu_config.png
images/menu_config.png
images/menu_config.png
images/menu_config.png
  • 2-up
  • Swipe
  • Onion skin
images/menu_new.png
View replaced file @ cbe6afdb View file @ 4021fc87
images/menu_new.png

829 Bytes | W: | H:

images/menu_new.png

10.8 KB | W: | H:

images/menu_new.png
images/menu_new.png
images/menu_new.png
images/menu_new.png
  • 2-up
  • Swipe
  • Onion skin
images/menu_open.png
View replaced file @ cbe6afdb View file @ 4021fc87
images/menu_open.png

1.16 KB | W: | H:

images/menu_open.png

10 KB | W: | H:

images/menu_open.png
images/menu_open.png
images/menu_open.png
images/menu_open.png
  • 2-up
  • Swipe
  • Onion skin
images/menu_save.png
View replaced file @ cbe6afdb View file @ 4021fc87
images/menu_save.png

1.18 KB | W: | H:

images/menu_save.png

9.83 KB | W: | H:

images/menu_save.png
images/menu_save.png
images/menu_save.png
images/menu_save.png
  • 2-up
  • Swipe
  • Onion skin
images/menu_upload.png
View replaced file @ cbe6afdb View file @ 4021fc87
images/menu_upload.png

449 Bytes | W: | H:

images/menu_upload.png

9.94 KB | W: | H:

images/menu_upload.png
images/menu_upload.png
images/menu_upload.png
images/menu_upload.png
  • 2-up
  • Swipe
  • Onion skin
untapi.pas
View file @ 4021fc87
......@@ -11,7 +11,7 @@ const
BASE_URL = 'https://sapi.moecube.com:444';
API_ACC_SIGNIN = '/accounts/signin';
API_ACC_AUTHUSER = '/accounts/authUser';
PUZZLE_URL = 'http://rarnu.xyz:38383/api/mdpro3/puzzle';
PUZZLE_URL = 'http://rarnu.xyz:38383/api/mdpro3/puzzle/save';
type
TCommonResult = class(TPersistent)
......@@ -66,8 +66,9 @@ type
{ TEntityPuzzleAdd }
TEntityPuzzleAdd = class(TPersistent)
TEntityPuzzle = class(TPersistent)
private
Fid: Int64;
Fcontributor: string;
FcoverCard: Int64;
FluaScript: String;
......@@ -76,6 +77,7 @@ type
Fsolution: string;
FuserId: Int64;
published
property id: Int64 read Fid write Fid;
property name: string read Fname write Fname;
property userId: Int64 read FuserId write FuserId;
property contributor: string read Fcontributor write Fcontributor;
......@@ -85,25 +87,25 @@ type
property luaScript: String read FluaScript write FluaScript;
end;
{ TEntityPuzzleUpdate }
TEntityPuzzleUpdate = class(TEntityPuzzleAdd)
private
Fid: Int64;
published
property id: Int64 read Fid write Fid;
end;
type
{ TAPI }
TSavePuzzleResult = class(TCommonResult)
private
Fdata: Int64;
published
property data: Int64 read Fdata write Fdata;
end;
TAPI = class
public
class function MCLogin(AAccount: String; APassword: String): TMCUserWithToken;
class function MCValidate(AToken: String): TMCUser;
class function AddPuzzle(AP: TEntityPuzzleAdd; AUserId: Int64; AToken: String): Boolean;
class function UpdatePuzzle(AP: TEntityPuzzleUpdate; AuserId: Int64; AToken: String): Boolean;
// class function AddPuzzle(AP: TEntityPuzzle; AUserId: Int64; AToken: String): Boolean;
// class function UpdatePuzzle(AP: TEntityPuzzle; AuserId: Int64; AToken: String): Boolean;
class function SavePuzzle(AP: TEntityPuzzle; AUserId: Int64; AToken: String): TSavePuzzleResult;
end;
implementation
......@@ -175,7 +177,9 @@ begin
end;
end;
class function TAPI.AddPuzzle(AP: TEntityPuzzleAdd; AUserId: Int64;
(*
class function TAPI.AddPuzzle(AP: TEntityPuzzle; AUserId: Int64;
AToken: String): Boolean;
var
AUrl: String;
......@@ -190,7 +194,7 @@ begin
AHeader.Add('ReqSource', 'MDPro3');
AHeader.Add('userId', AUserId.ToString());
AHeader.Add('token', AToken);
AReqJson := ISCObjectToJSONString<TEntityPuzzleAdd>(AP);
AReqJson := ISCObjectToJSONString<TEntityPuzzle>(AP);
ARetJson := ISCHttpPost(AUrl, AReqJson, AHeader);
AHeader.Free;
AResult := ISCJSONStringToObject<TCommonResult>(ARetJson);
......@@ -198,7 +202,12 @@ begin
AResult.Free;
end;
class function TAPI.UpdatePuzzle(AP: TEntityPuzzleUpdate; AuserId: Int64;
*)
(*
class function TAPI.UpdatePuzzle(AP: TEntityPuzzle; AuserId: Int64;
AToken: String): Boolean;
var
AUrl: String;
......@@ -213,7 +222,7 @@ begin
AHeader.Add('ReqSource', 'MDPro3');
AHeader.Add('userId', AUserId.ToString());
AHeader.Add('token', AToken);
AReqJson := ISCObjectToJSONString<TEntityPuzzleAdd>(AP);
AReqJson := ISCObjectToJSONString<TEntityPuzzle>(AP);
ARetJson := ISCHttpPut(AUrl, AReqJson, AHeader);
AHeader.Free;
AResult := ISCJSONStringToObject<TCommonResult>(ARetJson);
......@@ -221,5 +230,32 @@ begin
AResult.Free;
end;
*)
class function TAPI.SavePuzzle(AP: TEntityPuzzle; AUserId: Int64; AToken: String): TSavePuzzleResult;
var
AUrl: String;
AHeader: TFPGMap<String, String>;
AReqJson: string;
ARetJson: string;
AResult: TSavePuzzleResult;
begin
AUrl := PUZZLE_URL;
AHeader := TFPGMap<String, String>.Create;
AHeader.Add('ReqSource', 'MDPro3');
AHeader.Add('userId', AUserId.ToString());
AHeader.Add('token', AToken);
AReqJson := ISCObjectToJSONString<TEntityPuzzle>(AP);
ARetJson := ISCHttpPost(AUrl, AReqJson, AHeader);
AHeader.Free;
AResult := ISCJSONStringToObject<TSavePuzzleResult>(ARetJson);
if (AResult.message = 'true') then begin
Exit(AResult);
end else begin
AResult.Free;
Exit(Nil);
end;;
end;
end.
untcard.pas
View file @ 4021fc87
......@@ -101,6 +101,8 @@ type
FP1Grave: TFPGList<TCard>;
FP1Hand: TFPGList<TCard>;
FP1Removed: TFPGList<TCard>;
FPuzzleId: Int64;
FPuzzleName: string;
FSCards: array [0..1, 0..5] of TCard;
FExtraMonsterCards: array [5..6] of TCard;
FLPOpponent: Integer;
......@@ -121,6 +123,7 @@ type
procedure Optimize();
published
property PuzzleId: Int64 read FPuzzleId write FPuzzleId;
property PuzzleName: string read FPuzzleName write FPuzzleName;
property P0Hand: TFPGList<TCard> read FP0Hand write FP0Hand;
property P0Deck: TFPGList<TCard> read FP0Deck write FP0Deck;
property P0ExtraDeck: TFPGList<TCard> read FP0ExtraDeck write FP0ExtraDeck;
......@@ -291,6 +294,7 @@ var
i, j: Integer;
begin
FPuzzleId := 0;
FPuzzleName:= '';
FAIName:= '';
FLPOpponent:= 0;
FLPSelf:= 0;
......
untcardjson.pas
View file @ 4021fc87
......@@ -127,6 +127,7 @@ begin
json := TJSONObject.Create();
json.Int64s['puzzleId'] := APuzzle.PuzzleId;
json.Strings['puzzleName'] := APuzzle.PuzzleName;
json.Strings['aiName'] := APuzzle.AIName;
......@@ -245,6 +246,7 @@ begin
puz := TPuzzleField.Create;
puz.PuzzleId:= j.Int64s['puzzleId'];
puz.PuzzleName:= j.Strings['puzzleName'];
puz.AIName := j.Strings['aiName'];
......
untconfig.pas
View file @ 4021fc87
......@@ -5,7 +5,7 @@ unit untConfig;
interface
uses
Classes, SysUtils;
Classes, SysUtils, Registry;
type
......@@ -15,6 +15,7 @@ type
public
class function GetMCToken(): string;
class procedure SaveMCToken(AToken: string);
class function GetMDPro3InstallPath(): string;
end;
implementation
......@@ -27,7 +28,7 @@ var
i: Integer;
AToken: String = '';
begin
ACfgPath:= ExtractFilePath(ParamStr(0)) + DirectorySeparator + 'Data' + DirectorySeparator + 'config.conf';
ACfgPath:= GetMDPro3InstallPath() + DirectorySeparator + 'Data' + DirectorySeparator + 'config.conf';
with TStringList.Create do begin
LoadFromFile(ACfgPath);
// MyCardToken->
......@@ -48,7 +49,7 @@ var
AFound: Boolean = False;
i: Integer;
begin
ACfgPath:= ExtractFilePath(ParamStr(0)) + DirectorySeparator + 'Data' + DirectorySeparator + 'config.conf';
ACfgPath:= GetMDPro3InstallPath() + DirectorySeparator + 'Data' + DirectorySeparator + 'config.conf';
with TStringList.Create do begin
LoadFromFile(ACfgPath);
for i := 0 to Count - 1 do begin
......@@ -67,5 +68,23 @@ begin
end;
class function TConfigReader.GetMDPro3InstallPath(): string;
var
AOpened: Boolean;
APath: string = '';
begin
// GetMDPro3InstallPath
with TRegistry.Create do begin
RootKey:= HKEY_CURRENT_USER;
AOpened := OpenKey('Software\MDPro3\MDPro3Install', False);
if AOpened then begin
APath := ReadString('InstallPath');
CloseKey;
end;
Free;
end;
Exit(APath);
end;
end.
untdata.pas
View file @ 4021fc87
......@@ -41,13 +41,16 @@ var
implementation
uses
untConfig;
{ TCardDatabase }
constructor TCardDatabase.Create;
var
APath: string;
begin
APath:= ExtractFilePath(ParamStr(0)) + DirectorySeparator + 'Data' + DirectorySeparator + 'locales' + DirectorySeparator + 'zh-CN' + DirectorySeparator + 'cards.cdb';
APath:= TConfigReader.GetMDPro3InstallPath() + DirectorySeparator + 'Data' + DirectorySeparator + 'locales' + DirectorySeparator + 'zh-CN' + DirectorySeparator + 'cards.cdb';
if (not FileExists(APath)) then raise EFileNotFoundException.CreateFmt('数据库 [%s] 不存在，请重新安装 MDPro3', [APath]);
FTrans := TSQLTransaction.Create(nil);
FDatabase := TSQLite3Connection.Create(nil);
......
untutils.pas
View file @ 4021fc87
......@@ -15,6 +15,8 @@ function CardTypeToReadable(ct: TCardType): string;
function PickOneCardFromList(list: TFPGList<TCard>; ACardId: Int64; AOwner: TCardOwner; APlayer: TCardPlayer; ALocation: TCardLocation; ASeq: Integer): TCard;
function WorkAsToCodeName(cwa: TCardWorkAs): String;
function GetFirstCardFromScriptCode(ACode: string): Int64;
implementation
function ElementNameToFieldRec(AName: string): TFieldRec;
......@@ -164,5 +166,26 @@ begin
Exit('');
end;
function GetFirstCardFromScriptCode(ACode: string): Int64;
var
i: Integer;
tmp: string;
begin
// GetFirstCardFromScriptCode
with TStringList.Create do begin
Text:= ACode;
for i := 0 to Count - 1 do begin
if (Strings[i].Contains('Debug.AddCard(')) then begin
tmp := Strings[i];
tmp := tmp.Substring(tmp.IndexOf('(') + 1);
tmp := tmp.Substring(0, tmp.IndexOf(','));
Break;
end;
end;
Free;
end;
Exit(StrToInt64(tmp));
end;
end.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment