Skip to content

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

add: 修复界面显示缩放，增加MC用户登录

parent aad5883f
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 17733 additions and 8343 deletions
.gitignore
View file @ cbe6afdb
......@@ -19,3 +19,6 @@ backup/
Thumbs.db
lib/
cardimg/*.jpg
PuzzleEditor.lpi
View file @ cbe6afdb
......@@ -143,6 +143,24 @@
<ResourceBaseClass Value="Form"/>
<UnitName Value="frmAbout"/>
</Unit>
<Unit>
<Filename Value="untapi.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="untAPI"/>
</Unit>
<Unit>
<Filename Value="untconfig.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="untConfig"/>
</Unit>
<Unit>
<Filename Value="frmlogin.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="FormLogin"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="frmLogin"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
......
Test.lpr 0 → 100644
View file @ cbe6afdb
program Test;
{$mode objfpc}{$H+}
uses
heaptrc,
classes, sysutils, untapi, openssl, opensslsockets;
var
ut1, ut2: TMCUserWithToken;
u1, u2: TMCUser;
begin
ut1 := TAPI.MCLogin('rarnu', 'Rarnu1120');
if (ut1 <> nil) then begin
WriteLn(ut1.token);
ut1.Free;
end;
ut2 := TAPI.MCLogin('rarnu', '111111');
if (ut2 <> nil) then begin
WriteLn(ut2.ToString());
ut2.Free;
end;
u1 := TAPI.MCValidate(41868, 'eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6NDE4NjgsImlhdCI6MTcxNzk0NDAwNCwiZXhwIjoxNzQ5NDgwMDA0fQ.mnzCQ_Jp3UWEd85C4LiGkNoncTx3gLXoyatoYFM70MM');
if (u1 <> nil) then begin
WriteLn(u1.username);
u1.Free;
end;
u2 := TAPI.MCValidate(418681, 'eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6NDE4NjgsImlhdCI6MTcxNzk0NDAwNCwiZXhwIjoxNzQ5NDgwMDA0fQ.mnzCQ_Jp3UWEd85C4LiGkNoncTx3gLXoyatoYFM70MM');
if (u2 <> nil) then begin
WriteLn(u2.username);
u2.Free;
end;
end.
\ No newline at end of file
frmabout.lfm
View file @ cbe6afdb
This diff is collapsed.
frmabout.pas
View file @ cbe6afdb
......@@ -12,6 +12,7 @@ type
{ TFormAbout }
TFormAbout = class(TForm)
D2Resources1: TD2Resources;
Image1: TD2Image;
Label1: TD2Label;
Label2: TD2Label;
......
frmcardlist.lfm
View file @ cbe6afdb
This source diff could not be displayed because it is too large. You can view the blob instead.
frmcardlist.pas
View file @ cbe6afdb
......@@ -15,6 +15,7 @@ type
btnOK: TD2CornerButton;
btnCancel: TD2CornerButton;
btnAddCard: TD2CornerButton;
D2Resources1: TD2Resources;
Layout1: TD2Layout;
lstCards: TD2ListBox;
Root: TD2Background;
......
frmcontinouseffected.lfm
View file @ cbe6afdb
This source diff could not be displayed because it is too large. You can view the blob instead.
frmcontinouseffected.pas
View file @ cbe6afdb
......@@ -14,6 +14,7 @@ type
TFormContinousEffected = class(TForm)
CornerButton1: TD2CornerButton;
CornerButton2: TD2CornerButton;
D2Resources1: TD2Resources;
Layout1: TD2Layout;
lstCards: TD2ListBox;
Root: TD2Background;
......@@ -83,6 +84,8 @@ begin
if FCurrentCard = nil then Exit;
lstCards.Clear;
lstCards.BeginUpdate;
for i:= 0 to 4 do begin
c := FPuzzle.MCard[0, i];
if (c <> nil) then begin
......@@ -141,6 +144,8 @@ begin
end;
end;
lstCards.EndUpdate;
end;
end.
......
frmhome.lfm
View file @ cbe6afdb
This diff is collapsed.
frmhome.pas
View file @ cbe6afdb
......@@ -5,7 +5,8 @@ unit frmHome;
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, orca_scene2d, fgl, untData, untConstant, untCard, untUtils;
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, orca_scene2d, fgl, untData, untConstant, untCard, untUtils,
untAPI;
type
......@@ -151,6 +152,7 @@ type
InnerGlowEffect9: TD2InnerGlowEffect;
Label1: TD2Label;
Label10: TD2Label;
lblLoginUser: TD2Label;
Label2: TD2Label;
Label3: TD2Label;
Label4: TD2Label;
......@@ -182,6 +184,7 @@ type
Popup2: TD2Popup;
btnAbout: TD2ToolButton;
Popup3: TD2Popup;
btnUpload: TD2ToolButton;
txtFieldName: TD2Label;
Layout1: TD2Layout;
Layout10: TD2Layout;
......@@ -219,6 +222,7 @@ type
procedure btnNewClick(Sender: TObject);
procedure btnOpenClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure btnUploadClick(Sender: TObject);
procedure btnXyzElementsClick(Sender: TObject);
procedure chkCardProcChange(Sender: TObject);
procedure chkCardProcClick(Sender: TObject);
......@@ -236,6 +240,7 @@ type
procedure FormDestroy(Sender: TObject);
procedure fieldElementClick(Sender: TObject);
procedure FormShow(Sender: TObject);
private
BHand: array[0..1] of TD2CornerButton;
BDeck: array[0..1] of TD2CornerButton;
......@@ -259,6 +264,9 @@ type
FCurrentCard: TCard;
FCurrentCardList: TFPGList<TCard>;
FUserToken: String;
FUserInfo: TMCUser;
function CheckSaved(AIsNew: Boolean): Boolean;
procedure currentCardListDelete(ACardId: Int64; AIndex: Integer);
procedure NewPuzzle();
......@@ -274,6 +282,16 @@ type
procedure ReEquipTo();
// card list
procedure RefreshCardList();
// loca user
procedure LoadUser();
function userExec(ATID: TThreadID; AData: String): TMCUser;
procedure userTerm(ATID: TThreadID; AData: TMCUser);
function loginExec(ATID: TThreadID; AData: TMCSignInReq): TMCUserWithToken;
procedure loginTerm(ATID: TThreadID; AData: TMCUserWithToken);
// upload puzzle
procedure UploadPuzzle();
public
end;
......@@ -284,7 +302,8 @@ var
implementation
uses
frmSearchCard, frmCardList, frmContinousEffected, untCardJson, untListItem, frmPuzzleConfig, frmAbout, untScriptGenerator;
frmSearchCard, frmCardList, frmContinousEffected, untCardJson, untListItem, frmPuzzleConfig, frmAbout,
untScriptGenerator, frmLogin, untConfig, ISCThread;
{$R *.lfm}
......@@ -402,6 +421,9 @@ begin
cmbCardWorkAs.AddObject(TTextItemEx.Create(cmbCardWorkAs, '永续陷阱'));
cmbCardWorkAs.AddObject(TTextItemEx.Create(cmbCardWorkAs, '反击陷阱'));
// load user
LoadUser();
// create a default puzzle
NewPuzzle();
end;
......@@ -411,6 +433,9 @@ begin
if FPuzzle <> nil then begin
FPuzzle.Free;
end;
if FUserInfo <> nil then begin
FUserInfo.Free;
end;
end;
procedure TFormHome.fieldElementClick(Sender: TObject);
......@@ -511,6 +536,13 @@ begin
end;
end;
procedure TFormHome.FormShow(Sender: TObject);
begin
//
Self.Width:= Trunc(Panel2.Position.X + Panel2.Width + 32);
Self.Height:= Trunc(Panel2.Position.Y + Panel2.Height + 32);
end;
function TFormHome.CheckSaved(AIsNew: Boolean): Boolean;
var
AAct: string;
......@@ -940,6 +972,69 @@ begin
lstCardList.EndUpdate;
end;
procedure TFormHome.LoadUser();
var
AToken: String;
begin
// load user
AToken := TConfigReader.GetMCToken();
if (AToken <> '') then begin
FUserToken:= AToken;
ISCThreadExecuteGUI<String, TMCUser>(AToken, userExec, userTerm);
end;
end;
function TFormHome.userExec(ATID: TThreadID; AData: String): TMCUser;
begin
Exit(TAPI.MCValidate(AData));
end;
procedure TFormHome.userTerm(ATID: TThreadID; AData: TMCUser);
begin
if (AData <> nil) then begin
FUserInfo := AData;
if FUserInfo <> nil then begin
lblLoginUser.Text:= FUserInfo.username;
end else begin
FUserToken:= '';
end;
end;
end;
function TFormHome.loginExec(ATID: TThreadID; AData: TMCSignInReq): TMCUserWithToken;
var
acc, pwd: string;
begin
acc := AData.account;
pwd := AData.password;
AData.Free;
Exit(TAPI.MCLogin(acc, pwd));
end;
procedure TFormHome.loginTerm(ATID: TThreadID; AData: TMCUserWithToken);
begin
if (AData <> nil) then begin
FUserToken:= AData.token;
FUserInfo := TMCUser.Create;
FUserInfo.name:= AData.user.name;
FUserInfo.id:= AData.user.id;
FUserInfo.username:= AData.user.username;
FUserInfo.email:= AData.user.email;
FUserInfo.avatar:= AData.user.avatar;
lblLoginUser.Text:= FUserInfo.username;
AData.Free;
// save token
TConfigReader.SaveMCToken(FUserToken);
end else begin
FUserToken:= '';
end;
end;
procedure TFormHome.UploadPuzzle();
begin
// TODO: upload puzzle
end;
procedure TFormHome.btnNewClick(Sender: TObject);
begin
// new
......@@ -1251,7 +1346,7 @@ var
begin
SavePuzzle();
if (FFilePath <> '') then begin
// TODO export
// export
ALuaFileName := ChangeFileExt(FFilePath, '.lua');
ACode := TScriptGenerator.Generate(FPuzzle);
with TStringList.Create do begin
......@@ -1283,6 +1378,28 @@ begin
SavePuzzle();
end;
procedure TFormHome.btnUploadClick(Sender: TObject);
var
req: TMCSignInReq;
begin
if (FUserToken = '') then begin
// login
with TFormLogin.Create(Self) do begin
if ShowModal = mrOK then begin
req := TMCSignInReq.Create;
req.account:= UserAccount;
req.password:= UserPassword;
ISCThreadExecuteGUI<TMCSignInReq, TMCUserWithToken>(req, loginExec, loginTerm);
end;
Free;
end;
Exit;
end;
if (FUserToken <> '') then begin
UploadPuzzle();
end;
end;
procedure TFormHome.btnXyzElementsClick(Sender: TObject);
begin
if (FCurrentCard = nil) then Exit;
......
frmlogin.lfm 0 → 100644
View file @ cbe6afdb
object FormLogin: TFormLogin
Left = 650
Height = 182
Top = 44
Width = 500
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'MC 用户登录'
ClientHeight = 182
ClientWidth = 500
Position = poMainFormCenter
object Scene: TD2Scene
Left = 0
Height = 182
Top = 0
Width = 500
Align = alClient
DesignSnapGridShow = False
DesignSnapToGrid = False
DesignSnapToLines = True
object Root: TD2Background
Width = 500
Height = 182
Margins.Rect = '(8,8,8,8)'
Padding.Rect = '(16,16,16,16)'
HitTest = False
object Layout1: TD2Layout
Align = vaTop
Position.Point = '(8,8)'
Width = 484
Height = 50
object Label1: 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 edtAccount: TD2TextBox
Align = vaClient
Position.Point = '(136,8)'
Width = 340
Height = 34
Padding.Rect = '(8,8,8,8)'
TabOrder = 1
Font.Family = 'Microsoft Yahei'
Font.Size = 18
ReadOnly = False
OnChange = edtAccountChange
OnTyping = edtAccountChange
Password = False
end
end
object Layout2: TD2Layout
Align = vaTop
Position.Point = '(8,58)'
Width = 484
Height = 50
object Label2: 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 edtPassword: TD2TextBox
Align = vaClient
Position.Point = '(136,8)'
Width = 340
Height = 34
Padding.Rect = '(8,8,8,8)'
TabOrder = 1
Font.Family = 'Microsoft Yahei'
Font.Size = 18
ReadOnly = False
OnChange = edtAccountChange
OnTyping = edtAccountChange
Password = True
end
end
object Layout4: TD2Layout
Align = vaBottom
Position.Point = '(8,124)'
Width = 484
Height = 50
object btnOK: TD2CornerButton
Align = vaRight
Enabled = False
Position.Point = '(396,8)'
Width = 80
Height = 34
Padding.Rect = '(8,8,8,8)'
OnClick = btnOKClick
TabOrder = 0
StaysPressed = False
IsPressed = False
Font.Family = 'microsoft yahei'
Font.Size = 18
ModalResult = 1
TextAlign = d2TextAlignCenter
Text = '确定'
xRadius = 3
yRadius = 3
Sides = [d2SideTop, d2SideLeft, d2SideBottom, d2SideRight]
end
object btnCancel: TD2CornerButton
Align = vaRight
Position.Point = '(300,8)'
Width = 80
Height = 34
Padding.Rect = '(8,8,8,8)'
TabOrder = 1
StaysPressed = False
IsPressed = False
Font.Family = 'microsoft yahei'
Font.Size = 18
ModalResult = 2
TextAlign = d2TextAlignCenter
Text = '取消'
xRadius = 3
yRadius = 3
Sides = [d2SideTop, d2SideLeft, d2SideBottom, d2SideRight]
end
end
end
end
end
frmlogin.pas 0 → 100644
View file @ cbe6afdb
unit frmLogin;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, orca_scene2d;
type
{ TFormLogin }
TFormLogin = class(TForm)
btnOK: TD2CornerButton;
btnCancel: TD2CornerButton;
Label1: TD2Label;
Label2: TD2Label;
Layout1: TD2Layout;
Layout2: TD2Layout;
Layout4: TD2Layout;
Root: TD2Background;
Scene: TD2Scene;
edtAccount: TD2TextBox;
edtPassword: TD2TextBox;
procedure btnOKClick(Sender: TObject);
procedure edtAccountChange(Sender: TObject);
private
FUserAccount: string;
FUserPassword: string;
public
published
property UserAccount: string read FUserAccount write FUserAccount;
property UserPassword: string read FUserPassword write FUserPassword;
end;
var
FormLogin: TFormLogin;
implementation
{$R *.lfm}
{ TFormLogin }
procedure TFormLogin.edtAccountChange(Sender: TObject);
var
acc: string;
pwd: string;
begin
acc := edtAccount.Text;
pwd := edtPassword.Text;
btnOK.Enabled:= (acc <> '') and (pwd <> '');
end;
procedure TFormLogin.btnOKClick(Sender: TObject);
begin
FUserAccount:= edtAccount.Text;
FUserPassword:= edtPassword.Text;
end;
end.
frmpuzzleconfig.lfm
View file @ cbe6afdb
This source diff could not be displayed because it is too large. You can view the blob instead.
frmpuzzleconfig.pas
View file @ cbe6afdb
......@@ -14,6 +14,7 @@ type
TFormPuzzleConfig = class(TForm)
CornerButton1: TD2CornerButton;
CornerButton2: TD2CornerButton;
D2Resources1: TD2Resources;
Label1: TD2Label;
Label2: TD2Label;
Label3: TD2Label;
......
frmsearchcard.lfm
View file @ cbe6afdb
This source diff could not be displayed because it is too large. You can view the blob instead.
frmsearchcard.pas
View file @ cbe6afdb
......@@ -15,6 +15,7 @@ type
btnSearchCard: TD2CornerButton;
btnCancel: TD2CornerButton;
btnOK: TD2CornerButton;
D2Resources1: TD2Resources;
Label1: TD2Label;
Layout1: TD2Layout;
Layout2: TD2Layout;
......
iscbase/ISCHttp.pas
View file @ cbe6afdb
......@@ -23,7 +23,9 @@ type
TISCHttpCallback = procedure(AUrl: string; ACode: Integer; ABody: string; ACookie: specialize TFPGMap<string, string>; AError: string);
function ISCHttpGet(AUrl: string; AHeaders: specialize TFPGMap<string, string> = nil; ALookup: Boolean = False): string;
function ISCHttpDelete(AUrl: string; AHeaders: specialize TFPGMap<string, string> = nil; ALookup: Boolean = False): string;
function ISCHttpPost(AUrl: string; AParam: string; AHeaders: specialize TFPGMap<string, string> = nil; ALookup: Boolean = False): string;
function ISCHttpPut(AUrl: String; AParam: string; AHeaders: specialize TFPGMap<string, String> = nil; ALookup: Boolean = False): string;
function ISCHttpPost(AUrl: string; AParam: specialize TFPGMap<String, String>; AHeaders: specialize TFPGMap<string, string> = nil; ALookup: Boolean = False): string;
function ISCHttpRequest(AUrl: string; AMethod: THttpMethod;
......@@ -42,7 +44,7 @@ procedure ISCAllowCors(AReq: TRequest; AResp: TResponse);
implementation
uses
ISCGeneric, ISCLogger;
ISCGeneric;
procedure ISCAllowCors(AReq: TRequest; AResp: TResponse);
......@@ -139,7 +141,7 @@ begin
Result := http.Get(AUrl);
except
on E: Exception do begin
TLogger.error('HTTP', 'ISCHttpGet: ' + AUrl + ', ' + E.Message);
end;
end;
finally
......@@ -147,6 +149,34 @@ begin
end;
end;
function ISCHttpDelete(AUrl: string; AHeaders: specialize TFPGMap<string, string>; ALookup: Boolean): string;
var
http: TFPHTTPClient;
i: Integer;
begin
Result := '';
http := TFPHTTPClient.Create(nil);
try
if (AHeaders <> nil) then begin
for i:= 0 to AHeaders.Count - 1 do begin
http.AddHeader(AHeaders.Keys[i], AHeaders.Data[i]);
end;
end;
http.AllowRedirect:= True;
try
Result := http.Delete(AUrl);
except
on E: Exception do begin
end;
end;
finally
http.Free;
end;
end;
function ISCHttpPost(AUrl: string; AParam: string; AHeaders: specialize TFPGMap<string, string>; ALookup: Boolean = False): string;
var
http: TFPHTTPClient;
......@@ -169,7 +199,7 @@ begin
Result := http.Post(AUrl);
except
on E: Exception do begin
TLogger.error('HTTP', 'ISCHttpPost: ' + AUrl + ', ' + E.Message);
end;
end;
finally
......@@ -199,6 +229,38 @@ begin
Exit(ret);
end;
function ISCHttpPut(AUrl: String; AParam: string; AHeaders: specialize TFPGMap<
string, String>; ALookup: Boolean): string;
var
http: TFPHTTPClient;
i: Integer;
begin
Result := '';
http := TFPHTTPClient.Create(nil);
try
http.AddHeader('Content-Type','application/json; charset=UTF-8');
http.AddHeader('Accept', 'application/json');
if (AHeaders <> nil) then begin
for i:= 0 to AHeaders.Count - 1 do begin
http.AddHeader(AHeaders.Keys[i], AHeaders.Data[i]);
end;
end;
http.AllowRedirect:= True;
http.RequestBody := TRawByteStringStream.Create(AParam);
try
Result := http.Put(AUrl);
except
on E: Exception do begin
end;
end;
finally
http.RequestBody.Free;
http.Free;
end;
end;
function ISCHttpPost(AUrl: string; AParam: specialize TFPGMap<String, String>; AHeaders: specialize TFPGMap<string, string>; ALookup: Boolean = False): string;
var
http: TFPHTTPClient;
......@@ -218,7 +280,7 @@ begin
Result := http.FormPost(AUrl, ParamToRequestQueryString(AParam));
except
on E: Exception do begin
TLogger.error('HTTP', 'ISCHttpPost: ' + AUrl + ', ' + E.Message);
end;
end;
finally
......
untapi.pas 0 → 100644
View file @ cbe6afdb
unit untAPI;
{$mode Delphi}{$H+}
interface
uses
Classes, SysUtils, ISCJSON, ISCHttp, fgl;
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';
type
TCommonResult = class(TPersistent)
private
Fcode: Integer;
Fmessage: string;
published
property code: Integer read Fcode write Fcode;
property message: string read Fmessage write Fmessage;
end;
type
TMCUser = class(TPersistent)
private
Fid: Int64;
Fusername: String;
Fname: String;
Femail: String;
Favatar: String;
published
property id: Int64 read Fid write Fid;
property username: string read Fusername write Fusername;
property name: string read Fname write Fname;
property email: String read Femail write Femail;
property avatar: string read Favatar write Favatar;
end;
{ MCUserWithToken }
TMCUserWithToken = class(TPersistent)
private
Fuser: TMCUser;
Ftoken: String;
public
constructor Create;
destructor Destroy; override;
published
property user: TMCUser read Fuser;
property token: String read Ftoken write Ftoken;
end;
{ TMCSignInReq }
TMCSignInReq = class(TPersistent)
private
Faccount: string;
Fpassword: string;
published
property account: string read Faccount write Faccount;
property password: string read Fpassword write Fpassword;
end;
{ TEntityPuzzleAdd }
TEntityPuzzleAdd = class(TPersistent)
private
Fcontributor: string;
FcoverCard: Int64;
FluaScript: String;
Fmessage: string;
Fname: string;
Fsolution: string;
FuserId: Int64;
published
property name: string read Fname write Fname;
property userId: Int64 read FuserId write FuserId;
property contributor: string read Fcontributor write Fcontributor;
property message: string read Fmessage write Fmessage;
property solution: string read Fsolution write Fsolution;
property coverCard: Int64 read FcoverCard write FcoverCard;
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 }
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;
end;
implementation
{ MCUserWithToken }
constructor TMCUserWithToken.Create;
begin
Fuser:= TMCUser.Create;
end;
destructor TMCUserWithToken.Destroy;
begin
Fuser.Free;
inherited Destroy;
end;
class function TAPI.MCLogin(AAccount: String; APassword: String): TMCUserWithToken;
var
AUrl: String;
AHeader: TFPGMap<String, String>;
AData: TMCSignInReq;
AJson: string;
ARetJson: String;
AUser: TMCUserWithToken;
begin
AUrl := Format('%s%s', [BASE_URL, API_ACC_SIGNIN]);
AHeader := TFPGMap<String, String>.Create;
AHeader.Add('origin', 'https://accounts.moecube.com');
AHeader.Add('referer', 'https://accounts.moecube.com');
AHeader.Add('sec-fetch-dest', 'empty');
AHeader.Add('sec-fetch-mode', 'cors');
AHeader.Add('sec-fetch-site', 'same-site');
AData:= TMCSignInReq.Create;
AData.account := AAccount;
AData.password := APassword;
AJson := ISCObjectToJSONString<TMCSignInReq>(AData);
ARetJson := ISCHttpPost(AUrl, AJson, AHeader);
AData.Free;
AHeader.Free;
AUser := ISCJSONStringToObject<TMCUserWithToken>(ARetJson);
if (AUser.token <> '') then begin
Exit(AUser);
end else begin
AUser.Free;
Exit(nil);
end;;
end;
class function TAPI.MCValidate(AToken: String): TMCUser;
var
AUrl: String;
AHeader: TFPGMap<String, String>;
ARetJson: string;
AUser: TMCUser;
begin
AUrl := Format('%s%s', [BASE_URL, API_ACC_AUTHUSER]);
AHeader := TFPGMap<String, String>.Create;
AHeader.Add('Authorization', Format('Bearer %s', [AToken]));
ARetJson := ISCHttpGet(AUrl, AHeader);
AHeader.Free;
AUser := ISCJSONStringToObject<TMCUser>(ARetJson);
if (AUser.id <> 0) then begin
Exit(AUser);
end else begin
AUser.Free;
Exit(nil);
end;
end;
class function TAPI.AddPuzzle(AP: TEntityPuzzleAdd; AUserId: Int64;
AToken: String): Boolean;
var
AUrl: String;
AHeader: TFPGMap<String, String>;
AReqJson: string;
ARetJson: string;
AResult: TCommonResult;
begin
// add puzzle
AUrl := PUZZLE_URL;
AHeader := TFPGMap<String, String>.Create;
AHeader.Add('ReqSource', 'MDPro3');
AHeader.Add('userId', AUserId.ToString());
AHeader.Add('token', AToken);
AReqJson := ISCObjectToJSONString<TEntityPuzzleAdd>(AP);
ARetJson := ISCHttpPost(AUrl, AReqJson, AHeader);
AHeader.Free;
AResult := ISCJSONStringToObject<TCommonResult>(ARetJson);
Result := AResult.message = 'true';
AResult.Free;
end;
class function TAPI.UpdatePuzzle(AP: TEntityPuzzleUpdate; AuserId: Int64;
AToken: String): Boolean;
var
AUrl: String;
AHeader: TFPGMap<String, String>;
AReqJson: string;
ARetJson: string;
AResult: TCommonResult;
begin
// update puzzle
AUrl := PUZZLE_URL;
AHeader := TFPGMap<String, String>.Create;
AHeader.Add('ReqSource', 'MDPro3');
AHeader.Add('userId', AUserId.ToString());
AHeader.Add('token', AToken);
AReqJson := ISCObjectToJSONString<TEntityPuzzleAdd>(AP);
ARetJson := ISCHttpPut(AUrl, AReqJson, AHeader);
AHeader.Free;
AResult := ISCJSONStringToObject<TCommonResult>(ARetJson);
Result := AResult.message = 'true';
AResult.Free;
end;
end.
untcard.pas
View file @ cbe6afdb
......@@ -120,6 +120,7 @@ type
function GetCardByFieldRec(fr: TFieldRec): TCard;
procedure Optimize();
published
property PuzzleId: Int64 read FPuzzleId write FPuzzleId;
property P0Hand: TFPGList<TCard> read FP0Hand write FP0Hand;
property P0Deck: TFPGList<TCard> read FP0Deck write FP0Deck;
property P0ExtraDeck: TFPGList<TCard> read FP0ExtraDeck write FP0ExtraDeck;
......@@ -289,6 +290,7 @@ constructor TPuzzleField.Create;
var
i, j: Integer;
begin
FPuzzleId := 0;
FAIName:= '';
FLPOpponent:= 0;
FLPSelf:= 0;
......
untcardjson.pas
View file @ cbe6afdb
......@@ -125,6 +125,9 @@ var
str: String;
begin
json := TJSONObject.Create();
json.Int64s['puzzleId'] := APuzzle.PuzzleId;
json.Strings['aiName'] := APuzzle.AIName;
jarr := TJSONArray.Create;
......@@ -240,6 +243,9 @@ begin
j := TJSONObject(p.Parse());
puz := TPuzzleField.Create;
puz.PuzzleId:= j.Int64s['puzzleId'];
puz.AIName := j.Strings['aiName'];
for i := 0 to 4 do begin
......
untconfig.pas 0 → 100644
View file @ cbe6afdb
unit untConfig;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils;
type
{ TConfigReader }
TConfigReader = class
public
class function GetMCToken(): string;
class procedure SaveMCToken(AToken: string);
end;
implementation
{ TConfigReader }
class function TConfigReader.GetMCToken(): string;
var
ACfgPath: String;
i: Integer;
AToken: String = '';
begin
ACfgPath:= ExtractFilePath(ParamStr(0)) + DirectorySeparator + 'Data' + DirectorySeparator + 'config.conf';
with TStringList.Create do begin
LoadFromFile(ACfgPath);
// MyCardToken->
for i := 0 to Count - 1 do begin
if Strings[i].StartsWith('MyCardToken->') then begin
// read token
AToken := Strings[i].Replace('MyCardToken->', '', [rfIgnoreCase, rfReplaceAll]);
end;
end;
Free;
end;
Exit(AToken);
end;
class procedure TConfigReader.SaveMCToken(AToken: string);
var
ACfgPath: String;
AFound: Boolean = False;
i: Integer;
begin
ACfgPath:= ExtractFilePath(ParamStr(0)) + DirectorySeparator + 'Data' + DirectorySeparator + 'config.conf';
with TStringList.Create do begin
LoadFromFile(ACfgPath);
for i := 0 to Count - 1 do begin
if Strings[i].StartsWith('MyCardToken->') then begin
AFound := True;
// override token
Strings[i] := 'MyCardToken->' + AToken;
end;
end;
if (not AFound) then begin
Add('MyCardToken->' + AToken);
end;
SaveToFile(ACfgPath);
Free;
end;
end;
end.
untlistitem.pas
View file @ cbe6afdb
......@@ -207,28 +207,28 @@ begin
inherited Create(AOwner);
Parent := TD2Object(AOwner);
Width:= 350;
Height:= 354;
Width:= 190;
Height:= 190;
FImg := TD2Image.Create(Self);
FImg.Parent := Self;
FImg.Align:= vaClient;
FImg.Width:= 200;
FImg.Height:= 290;
FImg.Padding.Left:= 8;
FImg.Padding.Right:= 8;
FImg.Padding.Top:= 8;
FImg.Padding.Bottom:= 8;
FImg.Width:= 100;
FImg.Height:= 145;
FImg.Padding.Left:= 4;
FImg.Padding.Right:= 4;
FImg.Padding.Top:= 4;
FImg.Padding.Bottom:= 4;
FImg.WrapMode:= d2ImageFit;
FImg.HitTest:= False;
FLbl := TD2Label.Create(Self);
FLbl.Parent := Self;
FLbl.Align:= vaBottom;
FLbl.Height:= 48;
FLbl.Height:= 32;
FLbl.Font.Family:= 'Microsoft Yahei';
FLbl.Font.Size:= 24;
FLbl.Font.Style:= d2FontBold;
FLbl.Font.Size:= 14;
FLbl.Font.Style:= d2FontRegular;
FLbl.WordWrap:= False;
FLbl.HitTest:= False;
end;
......@@ -315,28 +315,28 @@ begin
Parent := TD2Object(AOwner);
Align:= vaTop;
Width:= 868;
Height:= 112;
Width:= 500;
Height:= 75;
FImg := TD2Image.Create(Self);
FImg.Parent := Self;
FImg.Align:= vaLeft;
FImg.Width:= 66;
FImg.Height:= 96;
FImg.Padding.Left:= 16;
FImg.Padding.Right:= 16;
FImg.Padding.Top:= 8;
FImg.Padding.Bottom:= 8;
FImg.Width:= 45;
FImg.Height:= 67;
FImg.Padding.Left:= 8;
FImg.Padding.Right:= 8;
FImg.Padding.Top:= 4;
FImg.Padding.Bottom:= 4;
FImg.WrapMode:= d2ImageFit;
FImg.HitTest:= False;
FLbl := TD2Label.Create(Self);
FLbl.Parent := Self;
FLbl.Align:= vaClient;
FLbl.Height:= 112;
FLbl.Height:= 75;
FLbl.Font.Family:= 'Microsoft Yahei';
FLbl.Font.Size:= 24;
FLbl.Font.Style:= d2FontBold;
FLbl.Font.Size:= 16;
FLbl.Font.Style:= d2FontRegular;
FLbl.WordWrap:= False;
FLbl.HitTest:= False;
FLbl.TextAlign:= d2TextAlignNear;
......@@ -348,25 +348,25 @@ begin
FbtnFace.Padding.Right:= 0;
FbtnFace.Padding.Top:= 16;
FbtnFace.Padding.Bottom:= 16;
FbtnFace.Padding.Left:=16;
FbtnFace.Height:= 80;
FbtnFace.Width:= 100;
FbtnFace.Padding.Left:= 8;
FbtnFace.Height:= 43;
FbtnFace.Width:= 70;
FbtnFace.Font.Family:= 'Microsoft Yahei';
FbtnFace.Font.Size:= 24;
FbtnFace.Font.Size:= 14;
FbtnFace.OnClick:= innerBtnFaceClick;
FBtnDel := TD2CornerButton.Create(Self);
FBtnDel.Parent := Self;
FBtnDel.Align:= vaMostRight;
FBtnDel.Padding.Right:= 16;
FBtnDel.Padding.Right:= 8;
FBtnDel.Padding.Top:= 16;
FBtnDel.Padding.Bottom:= 16;
FBtnDel.Padding.Left:= 16;
FBtnDel.Padding.Left:= 8;
FBtnDel.Text:= '删除';
FBtnDel.Height:= 80;
FBtnDel.Width:= 100;
FBtnDel.Height:= 43;
FBtnDel.Width:= 70;
FBtnDel.Font.Family:= 'Microsoft Yahei';
FBtnDel.Font.Size:= 24;
FBtnDel.Font.Size:= 14;
FBtnDel.OnClick:= innerBtnDelClick;
end;
......@@ -391,14 +391,14 @@ constructor TTextItem.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Self.Parent := TD2Object(AOwner);
Self.Height:= 56;
self.Width:= 440;
Self.Height:= 26;
self.Width:= 356;
FLbl := TD2Text.Create(Self);
FLbl.Parent := Self;
FLbl.Align:= vaClient;
FLbl.HitTest:= False;
FLbl.Font.Family:= 'Microsoft Yahei';
FLbl.Font.Size:= 24;
FLbl.Font.Size:= 16;
FLbl.Fill.Style:= d2BrushSolid;
FLbl.Fill.Color:= vcWhite;
FLbl.HorzTextAlign:= d2TextAlignCenter;
......@@ -511,28 +511,28 @@ begin
Parent := TD2Object(AOwner);
Align:= vaTop;
Width:= 440;
Height:= 112;
Width:= 356;
Height:= 75;
FImg := TD2Image.Create(Self);
FImg.Parent := Self;
FImg.Align:= vaLeft;
FImg.Width:= 66;
FImg.Height:= 96;
FImg.Padding.Left:= 16;
FImg.Padding.Right:= 16;
FImg.Padding.Top:= 8;
FImg.Padding.Bottom:= 8;
FImg.Width:= 45;
FImg.Height:= 67;
FImg.Padding.Left:= 8;
FImg.Padding.Right:= 8;
FImg.Padding.Top:= 4;
FImg.Padding.Bottom:= 4;
FImg.WrapMode:= d2ImageFit;
FImg.HitTest:= False;
FLbl := TD2Text.Create(Self);
FLbl.Parent := Self;
FLbl.Align:= vaClient;
FLbl.Height:= 112;
FLbl.Height:= 75;
FLbl.Font.Family:= 'Microsoft Yahei';
FLbl.Font.Size:= 24;
FLbl.Font.Style:= d2FontBold;
FLbl.Font.Size:= 16;
FLbl.Font.Style:= d2FontRegular;
FLbl.WordWrap:= False;
FLbl.HitTest:= False;
FLbl.HorzTextAlign:= d2TextAlignNear;
......@@ -630,28 +630,28 @@ begin
Parent := TD2Object(AOwner);
Align:= vaTop;
Width:= 868;
Height:= 112;
Width:= 584;
Height:= 75;
FImg := TD2Image.Create(Self);
FImg.Parent := Self;
FImg.Align:= vaLeft;
FImg.Width:= 66;
FImg.Height:= 96;
FImg.Padding.Left:= 16;
FImg.Padding.Right:= 16;
FImg.Padding.Top:= 8;
FImg.Padding.Bottom:= 8;
FImg.Width:= 45;
FImg.Height:= 67;
FImg.Padding.Left:= 8;
FImg.Padding.Right:= 8;
FImg.Padding.Top:= 4;
FImg.Padding.Bottom:= 4;
FImg.WrapMode:= d2ImageFit;
FImg.HitTest:= False;
FLbl := TD2Text.Create(Self);
FLbl.Parent := Self;
FLbl.Align:= vaClient;
FLbl.Height:= 112;
FLbl.Height:= 75;
FLbl.Font.Family:= 'Microsoft Yahei';
FLbl.Font.Size:= 24;
FLbl.Font.Style:= d2FontBold;
FLbl.Font.Size:= 16;
FLbl.Font.Style:= d2FontRegular;
FLbl.Fill.Style:= d2BrushSolid;
FLbl.WordWrap:= False;
FLbl.HitTest:= False;
......@@ -660,13 +660,12 @@ begin
FChk := TD2CheckBox.Create(Self);
FChk.Parent := Self;
FChk.Position.X:= 800;
FChk.Position.Y:= 30;
FChk.Position.X:= 536;
FChk.Position.Y:= 17;
FChk.Height:= 20;
FChk.Width:= 20;
FChk.Scale.X:= 2.5;
FChk.Scale.Y:= 2.5;
FChk.Scale.X:= 2;
FChk.Scale.Y:= 2;
end;
destructor TCardListItemCheck.Destroy;
......
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