Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
P
puzzle-editor
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Packages
Packages
List
Container Registry
Analytics
Analytics
CI / CD
Code Review
Insights
Issues
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
rarnu
puzzle-editor
Commits
2341542c
Commit
2341542c
authored
Oct 20, 2024
by
rarnu
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
add: 增加搜索历史,增加一些提升用户体验的操作
parent
4021fc87
Changes
20
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
20 changed files
with
3857 additions
and
3269 deletions
+3857
-3269
PuzzleEditor.lpi
PuzzleEditor.lpi
+6
-0
PuzzleEditor.lpr
PuzzleEditor.lpr
+22
-1
frmabout.lfm
frmabout.lfm
+2888
-2885
frmabout.pas
frmabout.pas
+18
-3
frmcardlist.lfm
frmcardlist.lfm
+4
-1
frmcardlist.pas
frmcardlist.pas
+59
-15
frmcontinouseffected.lfm
frmcontinouseffected.lfm
+3
-1
frmcontinouseffected.pas
frmcontinouseffected.pas
+8
-1
frmhome.lfm
frmhome.lfm
+316
-314
frmhome.pas
frmhome.pas
+75
-15
frmlogin.lfm
frmlogin.lfm
+11
-7
frmlogin.pas
frmlogin.pas
+15
-0
frmpuzzleconfig.lfm
frmpuzzleconfig.lfm
+4
-1
frmpuzzleconfig.pas
frmpuzzleconfig.pas
+15
-0
frmsearchcard.lfm
frmsearchcard.lfm
+192
-3
frmsearchcard.pas
frmsearchcard.pas
+126
-6
untcard.pas
untcard.pas
+4
-4
untconfig.pas
untconfig.pas
+46
-1
untlistitem.pas
untlistitem.pas
+35
-10
untscriptgenerator.pas
untscriptgenerator.pas
+10
-1
No files found.
PuzzleEditor.lpi
View file @
2341542c
...
@@ -214,6 +214,12 @@
...
@@ -214,6 +214,12 @@
<Item>
<Item>
<Name
Value=
"ESocketError"
/>
<Name
Value=
"ESocketError"
/>
</Item>
</Item>
<Item>
<Name
Value=
"EHTTPClient"
/>
</Item>
<Item>
<Name
Value=
"EAccessViolation"
/>
</Item>
</Exceptions>
</Exceptions>
</Debugging>
</Debugging>
</CONFIG>
</CONFIG>
PuzzleEditor.lpr
View file @
2341542c
...
@@ -15,19 +15,40 @@ uses
...
@@ -15,19 +15,40 @@ uses
{$R *.res}
{$R *.res}
type
{ TExceptionHandler }
TExceptionHandler = class
public
Procedure OnError(Sender : TObject; E : Exception);
end;
var
var
AMDPro3Path: string;
AMDPro3Path: string;
{ TExceptionHandler }
procedure TExceptionHandler.OnError(Sender: TObject; E: Exception);
begin
// do nothing
end;
var
EH: TExceptionHandler;
begin
begin
AMDPro3Path:= TConfigReader.GetMDPro3InstallPath();
AMDPro3Path:= TConfigReader.GetMDPro3InstallPath();
if (AMDPro3Path = '') or (not DirectoryExists(AMDPro3Path)) then begin
if (AMDPro3Path = '') or (not DirectoryExists(AMDPro3Path)) then begin
MessageDlg('提示', '没有安装 MDPro3,请先进行安装', mtError, [mbOK], 0);
MessageDlg('提示', '没有安装 MDPro3,请先进行安装', mtError, [mbOK], 0);
Exit;
Exit;
end;
end;
EH:= TExceptionHandler.Create;
RequireDerivedFormResource:=True;
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.Scaled:=True;
Application.Initialize;
Application.Initialize;
Application.OnException:= @EH.OnError;
Application.CreateForm(TFormHome, FormHome);
Application.CreateForm(TFormHome, FormHome);
Application.Run;
Application.Run;
EH.Free;
end.
end.
frmabout.lfm
View file @
2341542c
This diff is collapsed.
Click to expand it.
frmabout.pas
View file @
2341542c
...
@@ -20,13 +20,14 @@ type
...
@@ -20,13 +20,14 @@ type
lblGitlab
:
TD2Label
;
lblGitlab
:
TD2Label
;
Label5
:
TD2Label
;
Label5
:
TD2Label
;
Line1
:
TD2Line
;
Line1
:
TD2Line
;
Root
1
:
TD2Background
;
Root
:
TD2Background
;
Scene
:
TD2Scene
;
Scene
:
TD2Scene
;
procedure
FormCreate
(
Sender
:
TObject
);
procedure
FormKeyPress
(
Sender
:
TObject
;
var
Key
:
char
);
procedure
FormKeyPress
(
Sender
:
TObject
;
var
Key
:
char
);
procedure
lblGitlabClick
(
Sender
:
TObject
);
procedure
lblGitlabClick
(
Sender
:
TObject
);
procedure
lblGitlabMouseEnter
(
Sender
:
TObject
);
procedure
lblGitlabMouseEnter
(
Sender
:
TObject
);
procedure
lblGitlabMouseLeave
(
Sender
:
TObject
);
procedure
lblGitlabMouseLeave
(
Sender
:
TObject
);
procedure
Root
1
Click
(
Sender
:
TObject
);
procedure
RootClick
(
Sender
:
TObject
);
private
private
public
public
...
@@ -38,6 +39,9 @@ var
...
@@ -38,6 +39,9 @@ var
implementation
implementation
uses
untConfig
;
{$R *.lfm}
{$R *.lfm}
{ TFormAbout }
{ TFormAbout }
...
@@ -52,6 +56,17 @@ begin
...
@@ -52,6 +56,17 @@ begin
if
(
Key
=
#
27
)
then
Close
;
if
(
Key
=
#
27
)
then
Close
;
end
;
end
;
procedure
TFormAbout
.
FormCreate
(
Sender
:
TObject
);
var
AScale
:
Double
;
begin
AScale
:=
TConfigReader
.
GetScale
();
self
.
Width
:=
Trunc
(
520
*
AScale
);
self
.
Height
:=
Trunc
(
270
*
AScale
);
Root
.
Scale
.
X
:=
AScale
;
Root
.
Scale
.
Y
:=
AScale
;
end
;
procedure
TFormAbout
.
lblGitlabClick
(
Sender
:
TObject
);
procedure
TFormAbout
.
lblGitlabClick
(
Sender
:
TObject
);
begin
begin
LCLIntf
.
OpenURL
(
'https://code.moenext.com/rarnu/puzzle-editor'
);
LCLIntf
.
OpenURL
(
'https://code.moenext.com/rarnu/puzzle-editor'
);
...
@@ -62,7 +77,7 @@ begin
...
@@ -62,7 +77,7 @@ begin
lblGitlab
.
Font
.
Style
:=
d2FontRegular
;
lblGitlab
.
Font
.
Style
:=
d2FontRegular
;
end
;
end
;
procedure
TFormAbout
.
Root
1
Click
(
Sender
:
TObject
);
procedure
TFormAbout
.
RootClick
(
Sender
:
TObject
);
begin
begin
Close
;
Close
;
end
;
end
;
...
...
frmcardlist.lfm
View file @
2341542c
...
@@ -8,9 +8,12 @@ object FormCardList: TFormCardList
...
@@ -8,9 +8,12 @@ object FormCardList: TFormCardList
Caption = '卡片列表'
Caption = '卡片列表'
ClientHeight = 800
ClientHeight = 800
ClientWidth = 600
ClientWidth = 600
Constraints.MinHeight = 800
Constraints.MinWidth = 600
OnCreate = FormCreate
OnCreate = FormCreate
OnDestroy = FormDestroy
OnDestroy = FormDestroy
Position = poMainFormCenter
Position = poMainFormCenter
LCLVersion = '3.6.0.0'
object Scene: TD2Scene
object Scene: TD2Scene
Left = 0
Left = 0
Height = 800
Height = 800
...
@@ -1718,7 +1721,7 @@ object FormCardList: TFormCardList
...
@@ -1718,7 +1721,7 @@ object FormCardList: TFormCardList
000000000000F005400648656967687405000000000000008803400C50616464
000000000000F005400648656967687405000000000000008803400C50616464
696E672E52656374060928302C322C302C32290C436C69704368696C6472656E
696E672E52656374060928302C322C302C32290C436C69704368696C6472656E
09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F
09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F
6E74616C0E506F736974696F6E2E506F696E74060628312C383
2
29064C6F636B
6E74616C0E506F736974696F6E2E506F696E74060628312C383
6
29064C6F636B
6564090557696474680500000000000000EC0540064865696768740500000000
6564090557696474680500000000000000EC0540064865696768740500000000
000000E404400C50616464696E672E52656374060928312C312C312C31290748
000000E404400C50616464696E672E52656374060928312C312C312C31290748
697454657374080A46696C6C2E5374796C65070F643242727573684772616469
697454657374080A46696C6C2E5374796C65070F643242727573684772616469
...
...
frmcardlist.pas
View file @
2341542c
...
@@ -25,6 +25,7 @@ type
...
@@ -25,6 +25,7 @@ type
procedure
FormDestroy
(
Sender
:
TObject
);
procedure
FormDestroy
(
Sender
:
TObject
);
private
private
FCardList
:
TFPGList
<
Int64
>;
FCardList
:
TFPGList
<
Int64
>;
procedure
addOneCardItem
(
ACard
:
TCard
);
procedure
deleteCardItem
(
ACardId
:
Int64
;
AIndex
:
Integer
);
procedure
deleteCardItem
(
ACardId
:
Int64
;
AIndex
:
Integer
);
public
public
procedure
FillCardIds
(
list
:
TFPGList
<
Int64
>);
procedure
FillCardIds
(
list
:
TFPGList
<
Int64
>);
...
@@ -37,7 +38,7 @@ var
...
@@ -37,7 +38,7 @@ var
implementation
implementation
uses
untListItem
,
frmSearchCard
;
uses
untListItem
,
frmSearchCard
,
untConfig
;
{$R *.lfm}
{$R *.lfm}
...
@@ -46,6 +47,7 @@ uses untListItem, frmSearchCard;
...
@@ -46,6 +47,7 @@ uses untListItem, frmSearchCard;
procedure
TFormCardList
.
btnAddCardClick
(
Sender
:
TObject
);
procedure
TFormCardList
.
btnAddCardClick
(
Sender
:
TObject
);
var
var
cid
:
Int64
=
0
;
cid
:
Int64
=
0
;
c
:
TCard
;
item
:
TCardListItemOp
;
item
:
TCardListItemOp
;
begin
begin
with
TFormSearchCard
.
Create
(
Self
)
do
begin
with
TFormSearchCard
.
Create
(
Self
)
do
begin
...
@@ -56,19 +58,30 @@ begin
...
@@ -56,19 +58,30 @@ begin
end
;
end
;
if
cid
>
0
then
begin
if
cid
>
0
then
begin
FCardList
.
Add
(
cid
);
FCardList
.
Add
(
cid
);
c
:=
Cards
.
GetCardInfo
(
cid
);
lstCards
.
BeginUpdate
;
lstCards
.
BeginUpdate
;
item
:=
TCardListItemOp
.
Create
(
lstCards
);
item
:=
TCardListItemOp
.
Create
(
lstCards
);
item
.
CardName
:=
Cards
.
GetCardName
(
cid
)
;
item
.
CardName
:=
c
.
CardName
;
item
.
Id
:=
cid
;
item
.
Id
:=
cid
;
item
.
Card
:=
c
;
item
.
ShowFace
:=
False
;
item
.
ShowFace
:=
False
;
item
.
Index
:=
lstCards
.
Count
-
1
;
item
.
OnDelete
:=
deleteCardItem
;
item
.
OnDelete
:=
deleteCardItem
;
item
.
OnCardAddOneClicked
:=
addOneCardItem
;
lstCards
.
EndUpdate
;
lstCards
.
EndUpdate
;
end
;
end
;
end
;
end
;
procedure
TFormCardList
.
FormCreate
(
Sender
:
TObject
);
procedure
TFormCardList
.
FormCreate
(
Sender
:
TObject
);
var
AScale
:
Double
;
begin
begin
FCardList
:=
TFPGList
<
Int64
>.
Create
;
FCardList
:=
TFPGList
<
Int64
>.
Create
;
AScale
:=
TConfigReader
.
GetScale
();
self
.
Width
:=
Trunc
(
600
*
AScale
);
self
.
Height
:=
Trunc
(
800
*
AScale
);
Root
.
Scale
.
X
:=
AScale
;
Root
.
Scale
.
Y
:=
AScale
;
end
;
end
;
procedure
TFormCardList
.
FormDestroy
(
Sender
:
TObject
);
procedure
TFormCardList
.
FormDestroy
(
Sender
:
TObject
);
...
@@ -78,22 +91,49 @@ end;
...
@@ -78,22 +91,49 @@ end;
procedure
TFormCardList
.
deleteCardItem
(
ACardId
:
Int64
;
AIndex
:
Integer
);
procedure
TFormCardList
.
deleteCardItem
(
ACardId
:
Int64
;
AIndex
:
Integer
);
var
var
i
:
Integer
;
cid
:
Int64
;
i
,
j
:
Integer
;
item
:
TCardListItemOp
;
begin
begin
// index matches
// index matches
if
(
FCardList
[
AIndex
]
=
ACardId
)
then
begin
for
i
:=
0
to
FCardList
.
Count
-
1
do
begin
FCardList
.
Delete
(
AIndex
);
cid
:=
FCardList
[
i
];
lstCards
.
Items
[
AIndex
].
Free
;
if
cid
=
ACardId
then
begin
Exit
;
for
j
:=
0
to
lstCards
.
Count
-
1
do
begin
end
;
item
:=
TCardListItemOp
(
lstCards
.
Items
[
j
]);
// index not match
if
(
item
.
Id
=
ACardId
)
and
(
item
.
Index
=
AIndex
)
then
begin
FCardList
.
Remove
(
ACardId
);
FCardList
.
Delete
(
i
);
for
i
:=
0
to
lstCards
.
Count
-
1
do
begin
item
.
Free
;
if
TCardListItemOp
(
lstCards
.
Items
[
i
]).
Id
=
ACardId
then
begin
Break
;
lstCards
.
Items
[
i
].
Free
;
end
;
end
;
Break
;
Break
;
end
;
end
;
end
;
end
;
for
i
:=
0
to
lstCards
.
Count
-
1
do
begin
item
:=
TCardListItemOp
(
lstCards
.
Items
[
i
]);
item
.
Index
:=
i
;
end
;
end
;
procedure
TFormCardList
.
addOneCardItem
(
ACard
:
TCard
);
var
item
:
TCardListItemOp
;
c
:
TCard
;
begin
c
:=
Cards
.
GetCardInfo
(
ACard
.
CardId
);
FCardList
.
Add
(
ACard
.
CardId
);
lstCards
.
BeginUpdate
;
item
:=
TCardListItemOp
.
Create
(
lstCards
);
item
.
CardName
:=
c
.
CardName
;
item
.
Id
:=
c
.
CardId
;
item
.
Card
:=
c
;
item
.
ShowFace
:=
False
;
item
.
Index
:=
lstCards
.
Count
-
1
;
item
.
OnDelete
:=
deleteCardItem
;
item
.
OnCardAddOneClicked
:=
addOneCardItem
;
lstCards
.
EndUpdate
;
end
;
end
;
procedure
TFormCardList
.
FillCardIds
(
list
:
TFPGList
<
Int64
>);
procedure
TFormCardList
.
FillCardIds
(
list
:
TFPGList
<
Int64
>);
...
@@ -101,6 +141,7 @@ var
...
@@ -101,6 +141,7 @@ var
i
:
Integer
;
i
:
Integer
;
item
:
TCardListItemOp
;
item
:
TCardListItemOp
;
cn
:
string
;
cn
:
string
;
c
:
TCard
;
begin
begin
FCardList
.
Clear
;
FCardList
.
Clear
;
FCardList
.
AddList
(
list
);
FCardList
.
AddList
(
list
);
...
@@ -108,12 +149,15 @@ begin
...
@@ -108,12 +149,15 @@ begin
if
(
list
.
Count
>
0
)
then
begin
if
(
list
.
Count
>
0
)
then
begin
lstCards
.
BeginUpdate
;
lstCards
.
BeginUpdate
;
for
i
:=
0
to
FCardList
.
Count
-
1
do
begin
for
i
:=
0
to
FCardList
.
Count
-
1
do
begin
c
n
:=
Cards
.
GetCardName
(
FCardList
[
i
]);
c
:=
Cards
.
GetCardInfo
(
FCardList
[
i
]);
item
:=
TCardListItemOp
.
Create
(
lstCards
);
item
:=
TCardListItemOp
.
Create
(
lstCards
);
item
.
CardName
:=
c
n
;
item
.
CardName
:=
c
.
CardName
;
item
.
Id
:=
FCardList
[
i
];
item
.
Id
:=
FCardList
[
i
];
item
.
ShowFace
:=
False
;
item
.
ShowFace
:=
False
;
item
.
Card
:=
c
;
item
.
Index
:=
i
;
item
.
OnDelete
:=
deleteCardItem
;
item
.
OnDelete
:=
deleteCardItem
;
item
.
OnCardAddOneClicked
:=
addOneCardItem
;
end
;
end
;
lstCards
.
EndUpdate
;
lstCards
.
EndUpdate
;
end
;
end
;
...
...
frmcontinouseffected.lfm
View file @
2341542c
...
@@ -8,6 +8,8 @@ object FormContinousEffected: TFormContinousEffected
...
@@ -8,6 +8,8 @@ object FormContinousEffected: TFormContinousEffected
Caption = '永续受影响的卡片'
Caption = '永续受影响的卡片'
ClientHeight = 800
ClientHeight = 800
ClientWidth = 600
ClientWidth = 600
Constraints.MinHeight = 800
Constraints.MinWidth = 600
OnCreate = FormCreate
OnCreate = FormCreate
OnDestroy = FormDestroy
OnDestroy = FormDestroy
Position = poMainFormCenter
Position = poMainFormCenter
...
@@ -1701,7 +1703,7 @@ object FormContinousEffected: TFormContinousEffected
...
@@ -1701,7 +1703,7 @@ object FormContinousEffected: TFormContinousEffected
000000000000F005400648656967687405000000000000008803400C50616464
000000000000F005400648656967687405000000000000008803400C50616464
696E672E52656374060928302C322C302C32290C436C69704368696C6472656E
696E672E52656374060928302C322C302C32290C436C69704368696C6472656E
09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F
09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F
6E74616C0E506F736974696F6E2E506F696E74060628312C383
4
29064C6F636B
6E74616C0E506F736974696F6E2E506F696E74060628312C383
6
29064C6F636B
6564090557696474680500000000000000EC0540064865696768740500000000
6564090557696474680500000000000000EC0540064865696768740500000000
000000E404400C50616464696E672E52656374060928312C312C312C31290748
000000E404400C50616464696E672E52656374060928312C312C312C31290748
697454657374080A46696C6C2E5374796C65070F643242727573684772616469
697454657374080A46696C6C2E5374796C65070F643242727573684772616469
...
...
frmcontinouseffected.pas
View file @
2341542c
...
@@ -43,15 +43,22 @@ var
...
@@ -43,15 +43,22 @@ var
implementation
implementation
uses
uses
untUtils
;
untUtils
,
untConfig
;
{$R *.lfm}
{$R *.lfm}
{ TFormContinousEffected }
{ TFormContinousEffected }
procedure
TFormContinousEffected
.
FormCreate
(
Sender
:
TObject
);
procedure
TFormContinousEffected
.
FormCreate
(
Sender
:
TObject
);
var
AScale
:
Double
;
begin
begin
FCESelectedCards
:=
TFPGList
<
TCard
>.
Create
;
FCESelectedCards
:=
TFPGList
<
TCard
>.
Create
;
AScale
:=
TConfigReader
.
GetScale
();
self
.
Width
:=
Trunc
(
600
*
AScale
);
self
.
Height
:=
Trunc
(
800
*
AScale
);
Root
.
Scale
.
X
:=
AScale
;
Root
.
Scale
.
Y
:=
AScale
;
end
;
end
;
procedure
TFormContinousEffected
.
CornerButton1Click
(
Sender
:
TObject
);
procedure
TFormContinousEffected
.
CornerButton1Click
(
Sender
:
TObject
);
...
...
frmhome.lfm
View file @
2341542c
This diff is collapsed.
Click to expand it.
frmhome.pas
View file @
2341542c
...
@@ -240,6 +240,7 @@ type
...
@@ -240,6 +240,7 @@ type
procedure
FormDestroy
(
Sender
:
TObject
);
procedure
FormDestroy
(
Sender
:
TObject
);
procedure
fieldElementClick
(
Sender
:
TObject
);
procedure
fieldElementClick
(
Sender
:
TObject
);
procedure
FormResize
(
Sender
:
TObject
);
procedure
FormShow
(
Sender
:
TObject
);
procedure
FormShow
(
Sender
:
TObject
);
private
private
BHand
:
array
[
0..1
]
of
TD2CornerButton
;
BHand
:
array
[
0..1
]
of
TD2CornerButton
;
...
@@ -268,6 +269,7 @@ type
...
@@ -268,6 +269,7 @@ type
FUserInfo
:
TMCUser
;
FUserInfo
:
TMCUser
;
function
CheckSaved
(
AIsNew
:
Boolean
):
Boolean
;
function
CheckSaved
(
AIsNew
:
Boolean
):
Boolean
;
procedure
currentCardListAddOne
(
ACard
:
TCard
);
procedure
currentCardListDelete
(
ACardId
:
Int64
;
AIndex
:
Integer
);
procedure
currentCardListDelete
(
ACardId
:
Int64
;
AIndex
:
Integer
);
procedure
NewPuzzle
();
procedure
NewPuzzle
();
procedure
OpenPuzzle
(
AFilePath
:
string
);
procedure
OpenPuzzle
(
AFilePath
:
string
);
...
@@ -313,6 +315,7 @@ procedure TFormHome.FormCreate(Sender: TObject);
...
@@ -313,6 +315,7 @@ procedure TFormHome.FormCreate(Sender: TObject);
var
var
i
,
j
:
Integer
;
i
,
j
:
Integer
;
begin
begin
TConfigReader
.
SetScale
(
1.0
);
FPuzzle
:=
nil
;
FPuzzle
:=
nil
;
FSaved
:=
True
;
FSaved
:=
True
;
FFilePath
:=
''
;
FFilePath
:=
''
;
...
@@ -536,11 +539,34 @@ begin
...
@@ -536,11 +539,34 @@ begin
end
;
end
;
end
;
end
;
procedure
TFormHome
.
FormResize
(
Sender
:
TObject
);
var
minH
,
minW
:
Integer
;
ARate
:
Double
;
AScale
:
Double
;
begin
// resize
minH
:=
self
.
Constraints
.
MinHeight
;
minW
:=
Self
.
Constraints
.
MinWidth
;
ARate
:=
(
minW
*
1.0
)
/
(
minH
*
1.0
);
// w/h
if
(
Self
.
Width
/
self
.
Height
>
ARate
)
then
begin
Self
.
Height
:=
Trunc
(
Self
.
Width
/
ARate
);
// self.Width:= Trunc(self.Height * ARate);
end
else
if
(
self
.
Width
/
self
.
Height
<
ARate
)
then
begin
Self
.
Height
:=
Trunc
(
Self
.
Width
/
ARate
);
// self.Width:= Trunc(self.Height * ARate);
end
;
AScale
:=
(
Self
.
Width
*
1.0
)
/
(
self
.
Constraints
.
MinWidth
*
1.0
);
TConfigReader
.
SetScale
(
AScale
);
Root
.
Scale
.
X
:=
AScale
;
Root
.
Scale
.
Y
:=
AScale
;
end
;
procedure
TFormHome
.
FormShow
(
Sender
:
TObject
);
procedure
TFormHome
.
FormShow
(
Sender
:
TObject
);
begin
begin
//
self
.
Constraints
.
MinHeight
:=
Trunc
(
Panel2
.
Position
.
Y
+
Panel2
.
Height
+
32
);
Self
.
Width
:=
Trunc
(
Panel2
.
Position
.
X
+
Panel2
.
Width
+
32
);
self
.
Constraints
.
MinWidth
:=
Trunc
(
Panel2
.
Position
.
X
+
Panel2
.
Width
+
32
);;
Self
.
Height
:=
Trunc
(
Panel2
.
Position
.
Y
+
Panel2
.
Height
+
32
);
end
;
end
;
function
TFormHome
.
CheckSaved
(
AIsNew
:
Boolean
):
Boolean
;
function
TFormHome
.
CheckSaved
(
AIsNew
:
Boolean
):
Boolean
;
...
@@ -561,27 +587,59 @@ begin
...
@@ -561,27 +587,59 @@ begin
end
;
end
;
end
;
end
;
procedure
TFormHome
.
currentCardList
Delete
(
ACardId
:
Int64
;
AIndex
:
Integer
);
procedure
TFormHome
.
currentCardList
AddOne
(
ACard
:
TCard
);
var
var
i
:
Integer
;
i
:
Integer
;
item
:
TCardListItemOp
;
item
:
TCardListItemOp
;
c
:
TCard
;
begin
begin
if
(
FCurrentCardList
=
nil
)
then
Exit
;
if
(
FCurrentCardList
=
nil
)
then
Exit
;
c
:=
Cards
.
GetCardInfo
(
ACard
.
CardId
);
FCurrentCardList
.
Add
(
c
);
item
:=
TCardListItemOp
.
Create
(
lstCardList
);
item
.
CardName
:=
c
.
CardName
;
item
.
Id
:=
c
.
CardId
;
item
.
Card
:=
c
;
item
.
Index
:=
lstCardList
.
Count
-
1
;
item
.
OnDelete
:=
currentCardListDelete
;
item
.
OnCardAddOneClicked
:=
currentCardListAddOne
;
if
(
FFieldInfo
.
Location
=
clGrave
)
then
begin
item
.
ShowFace
:=
False
;
item
.
Face
:=
0
;
// up
end
else
begin
item
.
ShowFace
:=
True
;
case
FFieldInfo
.
Location
of
clHand
,
clDeck
,
clExtra
:
item
.
Face
:=
1
;
// down
clRemoved
:
item
.
Face
:=
0
;
// up
end
;
end
;
// index matches
// rebuild index
if
(
FCurrentCardList
[
AIndex
].
CardId
=
ACardId
)
then
begin
for
i
:=
0
to
lstCardList
.
Count
-
1
do
begin
FCurrentCardList
.
Items
[
AIndex
].
Free
;
item
:=
TCardListItemOp
(
lstCardList
.
Items
[
i
]);
FCurrentCardList
.
Delete
(
AIndex
);
item
.
Index
:=
i
;
lstCardList
.
Items
[
AIndex
].
Free
;
Exit
;
end
;
end
;
end
;
procedure
TFormHome
.
currentCardListDelete
(
ACardId
:
Int64
;
AIndex
:
Integer
);
var
i
,
j
:
Integer
;
c
:
TCard
;
item
:
TCardListItemOp
;
begin
if
(
FCurrentCardList
=
nil
)
then
Exit
;
// index not matches
for
i
:=
0
to
FCurrentCardList
.
Count
-
1
do
begin
for
i
:=
0
to
FCurrentCardList
.
Count
-
1
do
begin
if
(
FCurrentCardList
[
i
].
CardId
=
ACardId
)
then
begin
c
:=
FCurrentCardList
[
i
];
FCurrentCardList
[
i
].
Free
;
if
c
.
CardId
=
ACardId
then
begin
FCurrentCardList
.
Delete
(
i
);
for
j
:=
0
to
lstCardList
.
Count
-
1
do
begin
lstCardList
.
Items
[
i
].
Free
;
item
:=
TCardListItemOp
(
lstCardList
.
Items
[
j
]);
if
(
item
.
Id
=
ACardId
)
and
(
item
.
Index
=
AIndex
)
then
begin
FCurrentCardList
.
Delete
(
i
);
item
.
Free
;
Break
;
end
;
end
;
Break
;
Break
;
end
;
end
;
end
;
end
;
...
@@ -968,6 +1026,7 @@ begin
...
@@ -968,6 +1026,7 @@ begin
end
;
end
;
end
;;
end
;;
item
.
OnDelete
:=
currentCardListDelete
;
item
.
OnDelete
:=
currentCardListDelete
;
item
.
OnCardAddOneClicked
:=
currentCardListAddOne
;
end
;
end
;
lstCardList
.
EndUpdate
;
lstCardList
.
EndUpdate
;
end
;
end
;
...
@@ -1236,6 +1295,7 @@ begin
...
@@ -1236,6 +1295,7 @@ begin
item
.
Card
:=
c
;
item
.
Card
:=
c
;
item
.
Index
:=
lstCardList
.
Count
-
1
;
item
.
Index
:=
lstCardList
.
Count
-
1
;
item
.
OnDelete
:=
currentCardListDelete
;
item
.
OnDelete
:=
currentCardListDelete
;
item
.
OnCardAddOneClicked
:=
currentCardListAddOne
;
if
(
FFieldInfo
.
Location
=
clGrave
)
then
begin
if
(
FFieldInfo
.
Location
=
clGrave
)
then
begin
item
.
ShowFace
:=
False
;
item
.
ShowFace
:=
False
;
item
.
Face
:=
0
;
// up
item
.
Face
:=
0
;
// up
...
...
frmlogin.lfm
View file @
2341542c
object FormLogin: TFormLogin
object FormLogin: TFormLogin
Left = 650
Left = 650
Height =
182
Height =
200
Top = 44
Top = 44
Width = 500
Width = 500
BorderIcons = [biSystemMenu]
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
BorderStyle = bsDialog
Caption = 'MC 用户登录'
Caption = 'MC 用户登录'
ClientHeight =
182
ClientHeight =
200
ClientWidth = 500
ClientWidth = 500
Constraints.MinHeight = 200
Constraints.MinWidth = 500
OnCreate = FormCreate
Position = poMainFormCenter
Position = poMainFormCenter
object Scene: TD2Scene
object Scene: TD2Scene
Left = 0
Left = 0
Height =
182
Height =
200
Top = 0
Top = 0
Width = 500
Width = 500
Align = alClient
Align = alClient
...
@@ -20,15 +23,16 @@ object FormLogin: TFormLogin
...
@@ -20,15 +23,16 @@ object FormLogin: TFormLogin
DesignSnapToLines = True
DesignSnapToLines = True
object Root: TD2Background
object Root: TD2Background
Width = 500
Width = 500
Height =
182
Height =
200
Margins.Rect = '(8,8,8,8)'
Margins.Rect = '(8,8,8,8)'
Padding.Rect = '(16,16,16,16)'
Padding.Rect = '(16,16,16,16)'
HitTest = False
HitTest = False
object Layout1: TD2Layout
object Layout1: TD2Layout
Align = vaTop
Align = vaTop
Position.Point = '(8,
8
)'
Position.Point = '(8,
16
)'
Width = 484
Width = 484
Height = 50
Height = 50
Padding.Rect = '(0,8,0,0)'
object Label1: TD2Label
object Label1: TD2Label
Align = vaLeft
Align = vaLeft
Position.Point = '(8,0)'
Position.Point = '(8,0)'
...
@@ -60,7 +64,7 @@ object FormLogin: TFormLogin
...
@@ -60,7 +64,7 @@ object FormLogin: TFormLogin
end
end
object Layout2: TD2Layout
object Layout2: TD2Layout
Align = vaTop
Align = vaTop
Position.Point = '(8,
58
)'
Position.Point = '(8,
66
)'
Width = 484
Width = 484
Height = 50
Height = 50
object Label2: TD2Label
object Label2: TD2Label
...
@@ -94,7 +98,7 @@ object FormLogin: TFormLogin
...
@@ -94,7 +98,7 @@ object FormLogin: TFormLogin
end
end
object Layout4: TD2Layout
object Layout4: TD2Layout
Align = vaBottom
Align = vaBottom
Position.Point = '(8,1
24
)'
Position.Point = '(8,1
42
)'
Width = 484
Width = 484
Height = 50
Height = 50
object btnOK: TD2CornerButton
object btnOK: TD2CornerButton
...
...
frmlogin.pas
View file @
2341542c
...
@@ -25,6 +25,7 @@ type
...
@@ -25,6 +25,7 @@ type
edtPassword
:
TD2TextBox
;
edtPassword
:
TD2TextBox
;
procedure
btnOKClick
(
Sender
:
TObject
);
procedure
btnOKClick
(
Sender
:
TObject
);
procedure
edtAccountChange
(
Sender
:
TObject
);
procedure
edtAccountChange
(
Sender
:
TObject
);
procedure
FormCreate
(
Sender
:
TObject
);
private
private
FUserAccount
:
string
;
FUserAccount
:
string
;
FUserPassword
:
string
;
FUserPassword
:
string
;
...
@@ -40,6 +41,9 @@ var
...
@@ -40,6 +41,9 @@ var
implementation
implementation
uses
untConfig
;
{$R *.lfm}
{$R *.lfm}
{ TFormLogin }
{ TFormLogin }
...
@@ -54,6 +58,17 @@ begin
...
@@ -54,6 +58,17 @@ begin
btnOK
.
Enabled
:=
(
acc
<>
''
)
and
(
pwd
<>
''
);
btnOK
.
Enabled
:=
(
acc
<>
''
)
and
(
pwd
<>
''
);
end
;
end
;
procedure
TFormLogin
.
FormCreate
(
Sender
:
TObject
);
var
AScale
:
Double
;
begin
AScale
:=
TConfigReader
.
GetScale
();
self
.
Width
:=
Trunc
(
500
*
AScale
);
self
.
Height
:=
Trunc
(
200
*
AScale
);
Root
.
Scale
.
X
:=
AScale
;
Root
.
Scale
.
Y
:=
AScale
;
end
;
procedure
TFormLogin
.
btnOKClick
(
Sender
:
TObject
);
procedure
TFormLogin
.
btnOKClick
(
Sender
:
TObject
);
begin
begin
FUserAccount
:=
edtAccount
.
Text
;
FUserAccount
:=
edtAccount
.
Text
;
...
...
frmpuzzleconfig.lfm
View file @
2341542c
...
@@ -8,6 +8,9 @@ object FormPuzzleConfig: TFormPuzzleConfig
...
@@ -8,6 +8,9 @@ object FormPuzzleConfig: TFormPuzzleConfig
Caption = '残局设置'
Caption = '残局设置'
ClientHeight = 800
ClientHeight = 800
ClientWidth = 600
ClientWidth = 600
Constraints.MinHeight = 800
Constraints.MinWidth = 600
OnCreate = FormCreate
Position = poMainFormCenter
Position = poMainFormCenter
object Scene: TD2Scene
object Scene: TD2Scene
Left = 0
Left = 0
...
@@ -1892,7 +1895,7 @@ object FormPuzzleConfig: TFormPuzzleConfig
...
@@ -1892,7 +1895,7 @@ object FormPuzzleConfig: TFormPuzzleConfig
000000000000F005400648656967687405000000000000008803400C50616464
000000000000F005400648656967687405000000000000008803400C50616464
696E672E52656374060928302C322C302C32290C436C69704368696C6472656E
696E672E52656374060928302C322C302C32290C436C69704368696C6472656E
09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F
09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F
6E74616C0E506F736974696F6E2E506F696E74060628312C383
6
29064C6F636B
6E74616C0E506F736974696F6E2E506F696E74060628312C383
8
29064C6F636B
6564090557696474680500000000000000EC0540064865696768740500000000
6564090557696474680500000000000000EC0540064865696768740500000000
000000E404400C50616464696E672E52656374060928312C312C312C31290748
000000E404400C50616464696E672E52656374060928312C312C312C31290748
697454657374080A46696C6C2E5374796C65070F643242727573684772616469
697454657374080A46696C6C2E5374796C65070F643242727573684772616469
...
...
frmpuzzleconfig.pas
View file @
2341542c
...
@@ -36,6 +36,7 @@ type
...
@@ -36,6 +36,7 @@ type
Scene
:
TD2Scene
;
Scene
:
TD2Scene
;
edtAIName
:
TD2TextBox
;
edtAIName
:
TD2TextBox
;
edtPuzzleName
:
TD2TextBox
;
edtPuzzleName
:
TD2TextBox
;
procedure
FormCreate
(
Sender
:
TObject
);
private
private
function
GetAIName
:
string
;
function
GetAIName
:
string
;
function
GetP0LP
:
Integer
;
function
GetP0LP
:
Integer
;
...
@@ -66,10 +67,24 @@ var
...
@@ -66,10 +67,24 @@ var
implementation
implementation
uses
untConfig
;
{$R *.lfm}
{$R *.lfm}
{ TFormPuzzleConfig }
{ TFormPuzzleConfig }
procedure
TFormPuzzleConfig
.
FormCreate
(
Sender
:
TObject
);
var
AScale
:
Double
;
begin
AScale
:=
TConfigReader
.
GetScale
();
self
.
Width
:=
Trunc
(
600
*
AScale
);
self
.
Height
:=
Trunc
(
800
*
AScale
);
Root
.
Scale
.
X
:=
AScale
;
Root
.
Scale
.
Y
:=
AScale
;
end
;
function
TFormPuzzleConfig
.
GetAIName
:
string
;
function
TFormPuzzleConfig
.
GetAIName
:
string
;
begin
begin
Exit
(
edtAIName
.
Text
);
Exit
(
edtAIName
.
Text
);
...
...
frmsearchcard.lfm
View file @
2341542c
...
@@ -8,6 +8,9 @@ object FormSearchCard: TFormSearchCard
...
@@ -8,6 +8,9 @@ object FormSearchCard: TFormSearchCard
Caption = '卡片查询'
Caption = '卡片查询'
ClientHeight = 800
ClientHeight = 800
ClientWidth = 600
ClientWidth = 600
Constraints.MinHeight = 800
Constraints.MinWidth = 600
OnCreate = FormCreate
Position = poMainFormCenter
Position = poMainFormCenter
object Scene: TD2Scene
object Scene: TD2Scene
Left = 0
Left = 0
...
@@ -47,6 +50,7 @@ object FormSearchCard: TFormSearchCard
...
@@ -47,6 +50,7 @@ object FormSearchCard: TFormSearchCard
Width = 300
Width = 300
Height = 34
Height = 34
Padding.Rect = '(8,8,8,8)'
Padding.Rect = '(8,8,8,8)'
OnKeyUp = edtCardNameKeyUp
TabOrder = 1
TabOrder = 1
Font.Family = 'microsoft yahei'
Font.Family = 'microsoft yahei'
Font.Size = 18
Font.Size = 18
...
@@ -74,10 +78,11 @@ object FormSearchCard: TFormSearchCard
...
@@ -74,10 +78,11 @@ object FormSearchCard: TFormSearchCard
end
end
object lstCards: TD2ListBox
object lstCards: TD2ListBox
Align = vaClient
Align = vaClient
Position.Point = '(8,
5
8)'
Position.Point = '(8,
11
8)'
Width = 584
Width = 584
Height = 6
7
6
Height = 6
1
6
OnClick = lstCardsClick
OnClick = lstCardsClick
OnDblClick = lstCardsDblClick
TabOrder = 2
TabOrder = 2
UseSmallScrollBars = True
UseSmallScrollBars = True
Columns = 3
Columns = 3
...
@@ -126,6 +131,190 @@ object FormSearchCard: TFormSearchCard
...
@@ -126,6 +131,190 @@ object FormSearchCard: TFormSearchCard
Sides = [d2SideTop, d2SideLeft, d2SideBottom, d2SideRight]
Sides = [d2SideTop, d2SideLeft, d2SideBottom, d2SideRight]
end
end
end
end
object layHistory: TD2Layout
Align = vaTop
Position.Point = '(8,58)'
Width = 584
Height = 60
object CircleButton1: TD2CircleButton
Align = vaMostRight
Position.Point = '(548,16)'
Width = 28
Height = 28
Padding.Rect = '(0,16,8,16)'
OnClick = CircleButton1Click
TabOrder = 0
StaysPressed = False
IsPressed = False
Font.Family = 'Microsoft Yahei'
Font.Size = 12
Font.Style = d2FontBold
TextAlign = d2TextAlignCenter
Text = 'X'
end
object Layout3: TD2Layout
Align = vaClient
Width = 548
Height = 60
object Layout4: TD2Layout
Align = vaTop
Width = 548
Height = 30
object txtHistory0: TD2Text
Align = vaLeft
Width = 100
Height = 30
OnClick = txtHistory0Click
Fill.Color = '#FFFF0033'
Font.Family = 'Microsoft Yahei'
Font.Size = 12
Font.Style = d2FontBold
HorzTextAlign = d2TextAlignNear
Text = '混沌虚数No.1000 梦幻虚光神 原数天灵·原数天地'
WordWrap = False
end
object txtHistory1: TD2Text
Align = vaLeft
Position.Point = '(108,0)'
Width = 100
Height = 30
Padding.Rect = '(8,0,0,0)'
OnClick = txtHistory0Click
Fill.Color = '#FFFF7700'
Font.Family = 'Microsoft Yahei'
Font.Size = 12
Font.Style = d2FontBold
HorzTextAlign = d2TextAlignNear
Text = 'æ··æ²èæ°No.1000 梦幻èå ç¥ åæ°å¤©çµÂ·åæ°å¤©å°'
WordWrap = False
end
object txtHistory4: TD2Text
Align = vaLeft
Position.Point = '(432,0)'
Width = 100
Height = 30
Padding.Rect = '(8,0,0,0)'
OnClick = txtHistory0Click
Fill.Color = '#FF00FF77'
Font.Family = 'Microsoft Yahei'
Font.Size = 12
Font.Style = d2FontBold
HorzTextAlign = d2TextAlignNear
Text = 'æ··æ²ÂèÂÂæ°No.1000 梦幻èÂÂå Â祠åÂÂæ°天çµ÷åÂÂæ°天å°'
WordWrap = False
end
object txtHistory3: TD2Text
Align = vaLeft
Position.Point = '(324,0)'
Width = 100
Height = 30
Padding.Rect = '(8,0,0,0)'
OnClick = txtHistory0Click
Fill.Color = '#FF77FF00'
Font.Family = 'Microsoft Yahei'
Font.Size = 12
Font.Style = d2FontBold
HorzTextAlign = d2TextAlignNear
Text = 'æ··æ²ÂèÂÂæ°No.1000 梦幻èÂÂå Â祠åÂÂæ°天çµ÷åÂÂæ°天å°'
WordWrap = False
end
object txtHistory2: TD2Text
Align = vaLeft
Position.Point = '(216,0)'
Width = 100
Height = 30
Padding.Rect = '(8,0,0,0)'
OnClick = txtHistory0Click
Fill.Color = '#FFFFFF00'
Font.Family = 'Microsoft Yahei'
Font.Size = 12
Font.Style = d2FontBold
HorzTextAlign = d2TextAlignNear
Text = 'æ··æ²ÂèÂÂæ°No.1000 梦幻èÂÂå Â祠åÂÂæ°天çµ÷åÂÂæ°天å°'
WordWrap = False
end
end
object Layout5: TD2Layout
Align = vaClient
Position.Point = '(0,30)'
Width = 548
Height = 30
object txtHistory5: TD2Text
Align = vaLeft
Width = 100
Height = 30
OnClick = txtHistory0Click
Fill.Color = '#FF00FFFF'
Font.Family = 'Microsoft Yahei'
Font.Size = 12
Font.Style = d2FontBold
HorzTextAlign = d2TextAlignNear
Text = 'æ··æ²ÂèÂÂæ°No.1000 梦幻èÂÂå Â祠åÂÂæ°天çµ÷åÂÂæ°天å°'
WordWrap = False
end
object txtHistory9: TD2Text
Align = vaLeft
Position.Point = '(432,0)'
Width = 100
Height = 30
Padding.Rect = '(8,0,0,0)'
OnClick = txtHistory0Click
Fill.Color = '#FF9966FF'
Font.Family = 'Microsoft Yahei'
Font.Size = 12
Font.Style = d2FontBold
HorzTextAlign = d2TextAlignNear
Text = 'æ··æ²ÂèÂÂæ°No.1000 梦幻èÂÂå Â祠åÂÂæ°天çµ÷åÂÂæ°天å°'
WordWrap = False
end
object txtHistory8: TD2Text
Align = vaLeft
Position.Point = '(324,0)'
Width = 100
Height = 30
Padding.Rect = '(8,0,0,0)'
OnClick = txtHistory0Click
Fill.Color = '#FFCC99FF'
Font.Family = 'Microsoft Yahei'
Font.Size = 12
Font.Style = d2FontBold
HorzTextAlign = d2TextAlignNear
Text = 'æ··æ²ÂèÂÂæ°No.1000 梦幻èÂÂå Â祠åÂÂæ°天çµ÷åÂÂæ°天å°'
WordWrap = False
end
object txtHistory7: TD2Text
Align = vaLeft
Position.Point = '(216,0)'
Width = 100
Height = 30
Padding.Rect = '(8,0,0,0)'
OnClick = txtHistory0Click
Fill.Color = '#FF7777FF'
Font.Family = 'Microsoft Yahei'
Font.Size = 12
Font.Style = d2FontBold
HorzTextAlign = d2TextAlignNear
Text = 'æ··æ²ÂèÂÂæ°No.1000 梦幻èÂÂå Â祠åÂÂæ°天çµ÷åÂÂæ°天å°'
WordWrap = False
end
object txtHistory6: TD2Text
Align = vaLeft
Position.Point = '(108,0)'
Width = 100
Height = 30
Padding.Rect = '(8,0,0,0)'
OnClick = txtHistory0Click
Fill.Color = '#FF0077FF'
Font.Family = 'Microsoft Yahei'
Font.Size = 12
Font.Style = d2FontBold
HorzTextAlign = d2TextAlignNear
Text = 'æ··æ²ÂèÂÂæ°No.1000 梦幻èÂÂå Â祠åÂÂæ°天çµ÷åÂÂæ°天å°'
WordWrap = False
end
end
end
end
end
end
end
end
object D2Resources1: TD2Resources
object D2Resources1: TD2Resources
...
@@ -1750,7 +1939,7 @@ object FormSearchCard: TFormSearchCard
...
@@ -1750,7 +1939,7 @@ object FormSearchCard: TFormSearchCard
000000000000F005400648656967687405000000000000008803400C50616464
000000000000F005400648656967687405000000000000008803400C50616464
696E672E52656374060928302C322C302C32290C436C69704368696C6472656E
696E672E52656374060928302C322C302C32290C436C69704368696C6472656E
09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F
09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F
6E74616C0E506F736974696F6E2E506F696E74060628312C3
834
29064C6F636B
6E74616C0E506F736974696F6E2E506F696E74060628312C3
930
29064C6F636B
6564090557696474680500000000000000EC0540064865696768740500000000
6564090557696474680500000000000000EC0540064865696768740500000000
000000E404400C50616464696E672E52656374060928312C312C312C31290748
000000E404400C50616464696E672E52656374060928312C312C312C31290748
697454657374080A46696C6C2E5374796C65070F643242727573684772616469
697454657374080A46696C6C2E5374796C65070F643242727573684772616469
...
...
frmsearchcard.pas
View file @
2341542c
...
@@ -5,7 +5,7 @@ unit frmSearchCard;
...
@@ -5,7 +5,7 @@ unit frmSearchCard;
interface
interface
uses
uses
Classes
,
SysUtils
,
Forms
,
Controls
,
Graphics
,
Dialogs
,
orca_scene2d
,
untData
,
untCard
,
fgl
;
Windows
,
Classes
,
SysUtils
,
Forms
,
Controls
,
Graphics
,
Dialogs
,
orca_scene2d
,
untData
,
untCard
,
fgl
;
type
type
...
@@ -15,20 +15,43 @@ type
...
@@ -15,20 +15,43 @@ type
btnSearchCard
:
TD2CornerButton
;
btnSearchCard
:
TD2CornerButton
;
btnCancel
:
TD2CornerButton
;
btnCancel
:
TD2CornerButton
;
btnOK
:
TD2CornerButton
;
btnOK
:
TD2CornerButton
;
CircleButton1
:
TD2CircleButton
;
D2Resources1
:
TD2Resources
;
D2Resources1
:
TD2Resources
;
Label1
:
TD2Label
;
Label1
:
TD2Label
;
Layout1
:
TD2Layout
;
Layout1
:
TD2Layout
;
Layout2
:
TD2Layout
;
Layout2
:
TD2Layout
;
layHistory
:
TD2Layout
;
Layout3
:
TD2Layout
;
Layout4
:
TD2Layout
;
Layout5
:
TD2Layout
;
lstCards
:
TD2ListBox
;
lstCards
:
TD2ListBox
;
Root
:
TD2Background
;
Root
:
TD2Background
;
Scene
:
TD2Scene
;
Scene
:
TD2Scene
;
edtCardName
:
TD2TextBoxClearBtn
;
edtCardName
:
TD2TextBoxClearBtn
;
txtHistory1
:
TD2Text
;
txtHistory4
:
TD2Text
;
txtHistory3
:
TD2Text
;
txtHistory2
:
TD2Text
;
txtHistory5
:
TD2Text
;
txtHistory9
:
TD2Text
;
txtHistory8
:
TD2Text
;
txtHistory7
:
TD2Text
;
txtHistory6
:
TD2Text
;
txtHistory0
:
TD2Text
;
procedure
btnOKClick
(
Sender
:
TObject
);
procedure
btnOKClick
(
Sender
:
TObject
);
procedure
btnSearchCardClick
(
Sender
:
TObject
);
procedure
btnSearchCardClick
(
Sender
:
TObject
);
procedure
CircleButton1Click
(
Sender
:
TObject
);
procedure
edtCardNameKeyUp
(
Sender
:
TObject
;
var
Key
:
Word
;
var
KeyChar
:
System
.
Widechar
;
Shift
:
TShiftState
);
procedure
FormCreate
(
Sender
:
TObject
);
procedure
lstCardsClick
(
Sender
:
TObject
);
procedure
lstCardsClick
(
Sender
:
TObject
);
procedure
lstCardsDblClick
(
Sender
:
TObject
);
procedure
txtHistory0Click
(
Sender
:
TObject
);
private
private
FCardId
:
Int64
;
FCardId
:
Int64
;
FHistory
:
array
[
0..9
]
of
TD2Text
;
procedure
SearchCard
(
Keyword
:
string
);
procedure
SaveHistory
(
ALast
:
string
);
public
public
published
published
...
@@ -41,7 +64,7 @@ var
...
@@ -41,7 +64,7 @@ var
implementation
implementation
uses
uses
untListItem
;
untListItem
,
untConfig
;
{$R *.lfm}
{$R *.lfm}
...
@@ -50,11 +73,90 @@ uses
...
@@ -50,11 +73,90 @@ uses
procedure
TFormSearchCard
.
btnSearchCardClick
(
Sender
:
TObject
);
procedure
TFormSearchCard
.
btnSearchCardClick
(
Sender
:
TObject
);
var
var
keyword
:
string
;
keyword
:
string
;
begin
keyword
:=
edtCardName
.
Text
;
SearchCard
(
keyword
);
end
;
procedure
TFormSearchCard
.
CircleButton1Click
(
Sender
:
TObject
);
var
i
:
Integer
;
Arr
:
TStringArray
;
begin
Arr
:=
TConfigReader
.
GetSearchHistory
();
for
i
:=
0
to
9
do
begin
Arr
[
i
]
:=
''
;
FHistory
[
i
].
Text
:=
''
;
end
;
TConfigReader
.
SetSearchHistory
(
Arr
);
end
;
procedure
TFormSearchCard
.
edtCardNameKeyUp
(
Sender
:
TObject
;
var
Key
:
Word
;
var
KeyChar
:
System
.
Widechar
;
Shift
:
TShiftState
);
begin
if
(
Key
=
VK_RETURN
)
then
begin
btnSearchCardClick
(
btnSearchCard
);
end
;
end
;
procedure
TFormSearchCard
.
FormCreate
(
Sender
:
TObject
);
var
AScale
:
Double
;
Arr
:
TStringArray
;
i
:
Integer
;
begin
AScale
:=
TConfigReader
.
GetScale
();
self
.
Width
:=
Trunc
(
600
*
AScale
);
self
.
Height
:=
Trunc
(
800
*
AScale
);
Root
.
Scale
.
X
:=
AScale
;
Root
.
Scale
.
Y
:=
AScale
;
FHistory
[
0
]
:=
txtHistory0
;
FHistory
[
1
]
:=
txtHistory1
;
FHistory
[
2
]
:=
txtHistory2
;
FHistory
[
3
]
:=
txtHistory3
;
FHistory
[
4
]
:=
txtHistory4
;
FHistory
[
5
]
:=
txtHistory5
;
FHistory
[
6
]
:=
txtHistory6
;
FHistory
[
7
]
:=
txtHistory7
;
FHistory
[
8
]
:=
txtHistory8
;
FHistory
[
9
]
:=
txtHistory9
;
Arr
:=
TConfigReader
.
GetSearchHistory
();
for
i
:=
0
to
9
do
begin
FHistory
[
i
].
Text
:=
Arr
[
i
];
end
;
end
;
procedure
TFormSearchCard
.
lstCardsClick
(
Sender
:
TObject
);
begin
btnOK
.
Enabled
:=
lstCards
.
ItemIndex
>
-
1
;
end
;
procedure
TFormSearchCard
.
lstCardsDblClick
(
Sender
:
TObject
);
var
idx
:
Integer
;
begin
idx
:=
lstCards
.
ItemIndex
;
if
idx
>
-
1
then
begin
btnOKClick
(
btnOK
);
end
;
end
;
procedure
TFormSearchCard
.
txtHistory0Click
(
Sender
:
TObject
);
var
keyword
:
string
;
begin
keyword
:=
TD2Text
(
Sender
).
Text
;
SearchCard
(
keyword
);
end
;
procedure
TFormSearchCard
.
SearchCard
(
Keyword
:
string
);
var
list
:
TFPGList
<
TCard
>;
list
:
TFPGList
<
TCard
>;
i
:
Integer
;
i
:
Integer
;
item
:
TCardListItem
;
item
:
TCardListItem
;
begin
begin
keyword
:=
edtCardName
.
Text
;
if
(
keyword
=
''
)
then
Exit
;
if
(
keyword
=
''
)
then
Exit
;
list
:=
Cards
.
SearchCards
(
keyword
);
list
:=
Cards
.
SearchCards
(
keyword
);
lstCards
.
Clear
;
lstCards
.
Clear
;
...
@@ -69,11 +171,29 @@ begin
...
@@ -69,11 +171,29 @@ begin
btnOK
.
Enabled
:=
False
;
btnOK
.
Enabled
:=
False
;
// deselect all
// deselect all
lstCards
.
ItemIndex
:=
-
1
;
lstCards
.
ItemIndex
:=
-
1
;
// save history
SaveHistory
(
keyword
);
end
;
end
;
procedure
TFormSearchCard
.
lstCardsClick
(
Sender
:
TObject
);
procedure
TFormSearchCard
.
SaveHistory
(
ALast
:
string
);
var
Arr
:
TStringArray
;
i
:
Integer
;
begin
begin
btnOK
.
Enabled
:=
lstCards
.
ItemIndex
>
-
1
;
Arr
:=
TConfigReader
.
GetSearchHistory
();
for
i
:=
0
to
9
do
begin
if
Arr
[
i
]
=
ALast
then
begin
Exit
;
end
;
end
;
for
i
:=
9
downto
1
do
begin
Arr
[
i
]
:=
Arr
[
i
-
1
];
FHistory
[
i
].
Text
:=
Arr
[
i
];
end
;
Arr
[
0
]
:=
ALast
;
FHistory
[
0
].
Text
:=
Arr
[
0
];
TConfigReader
.
SetSearchHistory
(
Arr
);
end
;
end
;
procedure
TFormSearchCard
.
btnOKClick
(
Sender
:
TObject
);
procedure
TFormSearchCard
.
btnOKClick
(
Sender
:
TObject
);
...
...
untcard.pas
View file @
2341542c
...
@@ -294,10 +294,10 @@ var
...
@@ -294,10 +294,10 @@ var
i
,
j
:
Integer
;
i
,
j
:
Integer
;
begin
begin
FPuzzleId
:=
0
;
FPuzzleId
:=
0
;
FPuzzleName
:=
''
;
FPuzzleName
:=
'
我制作的游戏王残局
'
;
FAIName
:=
''
;
FAIName
:=
'
只是一个AI
'
;
FLPOpponent
:=
0
;
FLPOpponent
:=
800
0
;
FLPSelf
:=
0
;
FLPSelf
:=
800
0
;
FMessage
:=
''
;
FMessage
:=
''
;
FSolution
:=
''
;
FSolution
:=
''
;
FP0Hand
:=
TFPGList
<
TCard
>.
Create
;
FP0Hand
:=
TFPGList
<
TCard
>.
Create
;
...
...
untconfig.pas
View file @
2341542c
...
@@ -5,17 +5,23 @@ unit untConfig;
...
@@ -5,17 +5,23 @@ unit untConfig;
interface
interface
uses
uses
Classes
,
SysUtils
,
Registry
;
Classes
,
SysUtils
,
Registry
,
Forms
,
IniFiles
;
type
type
{ TConfigReader }
{ TConfigReader }
TConfigReader
=
class
TConfigReader
=
class
private
class
var
FScale
:
Double
;
public
public
class
function
GetMCToken
():
string
;
class
function
GetMCToken
():
string
;
class
procedure
SaveMCToken
(
AToken
:
string
);
class
procedure
SaveMCToken
(
AToken
:
string
);
class
function
GetMDPro3InstallPath
():
string
;
class
function
GetMDPro3InstallPath
():
string
;
class
procedure
SetScale
(
AScale
:
Double
);
class
function
GetScale
():
Double
;
class
function
GetSearchHistory
():
TStringArray
;
class
procedure
SetSearchHistory
(
Arr
:
TStringArray
);
end
;
end
;
implementation
implementation
...
@@ -86,5 +92,44 @@ begin
...
@@ -86,5 +92,44 @@ begin
Exit
(
APath
);
Exit
(
APath
);
end
;
end
;
class
procedure
TConfigReader
.
SetScale
(
AScale
:
Double
);
begin
FScale
:=
AScale
;
end
;
class
function
TConfigReader
.
GetScale
():
Double
;
begin
Exit
(
FScale
);
end
;
class
function
TConfigReader
.
GetSearchHistory
():
TStringArray
;
var
ACfgPath
:
string
;
i
:
Integer
;
ini
:
TIniFile
;
begin
SetLength
(
Result
,
10
);
ACfgPath
:=
ChangeFileExt
(
Application
.
ExeName
,
'.conf'
);
ini
:=
TIniFile
.
Create
(
ACfgPath
);
for
i
:=
0
to
9
do
begin
Result
[
i
]
:=
ini
.
ReadString
(
'HISTORY'
,
Format
(
'Key%d'
,
[
i
]),
''
);
end
;
ini
.
Free
;
end
;
class
procedure
TConfigReader
.
SetSearchHistory
(
Arr
:
TStringArray
);
var
ACfgPath
:
string
;
i
:
Integer
;
ini
:
TIniFile
;
begin
ACfgPath
:=
ChangeFileExt
(
Application
.
ExeName
,
'.conf'
);
ini
:=
TIniFile
.
Create
(
ACfgPath
);
for
i
:=
0
to
9
do
begin
ini
.
WriteString
(
'HISTORY'
,
Format
(
'Key%d'
,
[
i
]),
Arr
[
i
]);
end
;
ini
.
Free
;
end
;
end
.
end
.
untlistitem.pas
View file @
2341542c
...
@@ -32,6 +32,7 @@ type
...
@@ -32,6 +32,7 @@ type
{ TOnCardListItemOpDeleted }
{ TOnCardListItemOpDeleted }
TOnCardListItemOpDeleted
=
procedure
(
ACardId
:
Int64
;
AIndex
:
Integer
)
of
object
;
TOnCardListItemOpDeleted
=
procedure
(
ACardId
:
Int64
;
AIndex
:
Integer
)
of
object
;
TOnCardAddOneClicked
=
procedure
(
ACard
:
TCard
)
of
object
;
{ TCardListItemOp }
{ TCardListItemOp }
...
@@ -40,14 +41,17 @@ type
...
@@ -40,14 +41,17 @@ type
FCard
:
TCard
;
FCard
:
TCard
;
FCardName
:
string
;
FCardName
:
string
;
FFace
:
Integer
;
FFace
:
Integer
;
FOnCardAddOneClicked
:
TOnCardAddOneClicked
;
FShowFace
:
Boolean
;
FShowFace
:
Boolean
;
FId
:
Int64
;
FId
:
Int64
;
FIndex
:
Integer
;
FIndex
:
Integer
;
FOnDelete
:
TOnCardListItemOpDeleted
;
FOnDelete
:
TOnCardListItemOpDeleted
;
FImg
:
TD2Image
;
FImg
:
TD2Image
;
FLbl
:
TD2Label
;
FLbl
:
TD2Label
;
FBtnAddOne
:
TD2RoundButton
;
FbtnFace
:
TD2CornerButton
;
FbtnFace
:
TD2CornerButton
;
FBtnDel
:
TD2CornerButton
;
FBtnDel
:
TD2CornerButton
;
procedure
innerBtnAddOneClick
(
Sender
:
TObject
);
procedure
innerBtnDelClick
(
Sender
:
TObject
);
procedure
innerBtnDelClick
(
Sender
:
TObject
);
procedure
innerBtnFaceClick
(
Sender
:
TObject
);
procedure
innerBtnFaceClick
(
Sender
:
TObject
);
procedure
SetCardName
(
AValue
:
string
);
procedure
SetCardName
(
AValue
:
string
);
...
@@ -64,6 +68,7 @@ type
...
@@ -64,6 +68,7 @@ type
property
CardName
:
string
read
FCardName
write
SetCardName
;
property
CardName
:
string
read
FCardName
write
SetCardName
;
property
Card
:
TCard
read
FCard
write
FCard
;
property
Card
:
TCard
read
FCard
write
FCard
;
property
OnDelete
:
TOnCardListItemOpDeleted
read
FOnDelete
write
FOnDelete
;
property
OnDelete
:
TOnCardListItemOpDeleted
read
FOnDelete
write
FOnDelete
;
property
OnCardAddOneClicked
:
TOnCardAddOneClicked
read
FOnCardAddOneClicked
write
FOnCardAddOneClicked
;
property
Index
:
Integer
read
FIndex
write
FIndex
;
property
Index
:
Integer
read
FIndex
write
FIndex
;
property
Face
:
Integer
read
FFace
write
SetFace
;
property
Face
:
Integer
read
FFace
write
SetFace
;
property
ShowFace
:
Boolean
read
FShowFace
write
SetShowFace
;
property
ShowFace
:
Boolean
read
FShowFace
write
SetShowFace
;
...
@@ -263,6 +268,13 @@ begin
...
@@ -263,6 +268,13 @@ begin
end
;
end
;
end
;
end
;
procedure
TCardListItemOp
.
innerBtnAddOneClick
(
Sender
:
TObject
);
begin
if
(
Assigned
(
FOnCardAddOneClicked
))
then
begin
FOnCardAddOneClicked
(
FCard
);
end
;
end
;
procedure
TCardListItemOp
.
innerBtnFaceClick
(
Sender
:
TObject
);
procedure
TCardListItemOp
.
innerBtnFaceClick
(
Sender
:
TObject
);
begin
begin
if
(
FFace
=
0
)
then
begin
if
(
FFace
=
0
)
then
begin
...
@@ -346,27 +358,40 @@ begin
...
@@ -346,27 +358,40 @@ begin
FbtnFace
.
Parent
:=
Self
;
FbtnFace
.
Parent
:=
Self
;
FbtnFace
.
Align
:=
vaRight
;
FbtnFace
.
Align
:=
vaRight
;
FbtnFace
.
Padding
.
Right
:=
0
;
FbtnFace
.
Padding
.
Right
:=
0
;
FbtnFace
.
Padding
.
Top
:=
1
6
;
FbtnFace
.
Padding
.
Top
:=
1
8
;
FbtnFace
.
Padding
.
Bottom
:=
1
6
;
FbtnFace
.
Padding
.
Bottom
:=
1
8
;
FbtnFace
.
Padding
.
Left
:=
8
;
FbtnFace
.
Padding
.
Left
:=
8
;
FbtnFace
.
Height
:=
4
3
;
FbtnFace
.
Height
:=
4
0
;
FbtnFace
.
Width
:=
7
0
;
FbtnFace
.
Width
:=
5
0
;
FbtnFace
.
Font
.
Family
:=
'Microsoft Yahei'
;
FbtnFace
.
Font
.
Family
:=
'Microsoft Yahei'
;
FbtnFace
.
Font
.
Size
:=
1
4
;
FbtnFace
.
Font
.
Size
:=
1
2
;
FbtnFace
.
OnClick
:=
innerBtnFaceClick
;
FbtnFace
.
OnClick
:=
innerBtnFaceClick
;
FBtnAddOne
:=
TD2RoundButton
.
Create
(
Self
);
FBtnAddOne
.
Parent
:=
Self
;
FBtnAddOne
.
Align
:=
vaRight
;
FBtnAddOne
.
Padding
.
Top
:=
20
;
FBtnAddOne
.
Padding
.
Bottom
:=
20
;
FBtnAddOne
.
Padding
.
Right
:=
0
;
FBtnAddOne
.
Height
:=
36
;
FBtnAddOne
.
Width
:=
36
;
FBtnAddOne
.
Font
.
Family
:=
'Microsoft Yahei'
;
FBtnAddOne
.
Font
.
Size
:=
12
;
FBtnAddOne
.
Text
:=
'+1'
;
FBtnAddOne
.
OnClick
:=
innerBtnAddOneClick
;
FBtnDel
:=
TD2CornerButton
.
Create
(
Self
);
FBtnDel
:=
TD2CornerButton
.
Create
(
Self
);
FBtnDel
.
Parent
:=
Self
;
FBtnDel
.
Parent
:=
Self
;
FBtnDel
.
Align
:=
vaMostRight
;
FBtnDel
.
Align
:=
vaMostRight
;
FBtnDel
.
Padding
.
Right
:=
8
;
FBtnDel
.
Padding
.
Right
:=
8
;
FBtnDel
.
Padding
.
Top
:=
1
6
;
FBtnDel
.
Padding
.
Top
:=
1
8
;
FBtnDel
.
Padding
.
Bottom
:=
1
6
;
FBtnDel
.
Padding
.
Bottom
:=
1
8
;
FBtnDel
.
Padding
.
Left
:=
8
;
FBtnDel
.
Padding
.
Left
:=
8
;
FBtnDel
.
Text
:=
'删除'
;
FBtnDel
.
Text
:=
'删除'
;
FBtnDel
.
Height
:=
4
3
;
FBtnDel
.
Height
:=
4
0
;
FBtnDel
.
Width
:=
7
0
;
FBtnDel
.
Width
:=
5
0
;
FBtnDel
.
Font
.
Family
:=
'Microsoft Yahei'
;
FBtnDel
.
Font
.
Family
:=
'Microsoft Yahei'
;
FBtnDel
.
Font
.
Size
:=
1
4
;
FBtnDel
.
Font
.
Size
:=
1
2
;
FBtnDel
.
OnClick
:=
innerBtnDelClick
;
FBtnDel
.
OnClick
:=
innerBtnDelClick
;
end
;
end
;
...
...
untscriptgenerator.pas
View file @
2341542c
...
@@ -16,6 +16,7 @@ type
...
@@ -16,6 +16,7 @@ type
class
function
CardOWnerToInt
(
AO
:
TCardOwner
):
Integer
;
class
function
CardOWnerToInt
(
AO
:
TCardOwner
):
Integer
;
class
function
CardPlayerToInt
(
AP
:
TCardPlayer
):
Integer
;
class
function
CardPlayerToInt
(
AP
:
TCardPlayer
):
Integer
;
class
function
CardLocationToStr
(
AL
:
TCardLocation
):
String
;
class
function
CardLocationToStr
(
AL
:
TCardLocation
):
String
;
class
function
CardExtraSeq
(
AO
:
TCardOwner
;
ASeq
:
Integer
):
Integer
;
class
function
CardLocationToInt
(
AL
:
TCardLocation
):
Integer
;
class
function
CardLocationToInt
(
AL
:
TCardLocation
):
Integer
;
class
function
CardPositionToStr
(
AP
:
TCardPosition
):
String
;
class
function
CardPositionToStr
(
AP
:
TCardPosition
):
String
;
class
function
CardXEPositionToStr
(
AP
:
TCardPosition
):
String
;
class
function
CardXEPositionToStr
(
AP
:
TCardPosition
):
String
;
...
@@ -55,6 +56,14 @@ begin
...
@@ -55,6 +56,14 @@ begin
Exit
(
''
);
Exit
(
''
);
end
;
end
;
class
function
TScriptGenerator
.
CardExtraSeq
(
AO
:
TCardOwner
;
ASeq
:
Integer
):
Integer
;
begin
case
AO
of
coSelf
:
Exit
(
ASeq
);
coOpponent
:
if
(
ASeq
=
5
)
then
Exit
(
6
)
else
Exit
(
5
);
end
;
end
;
class
function
TScriptGenerator
.
CardLocationToInt
(
AL
:
TCardLocation
):
Integer
;
class
function
TScriptGenerator
.
CardLocationToInt
(
AL
:
TCardLocation
):
Integer
;
begin
begin
case
AL
of
case
AL
of
...
@@ -214,7 +223,7 @@ begin
...
@@ -214,7 +223,7 @@ begin
CardOWnerToInt
(
c
.
Owner
),
// owner
CardOWnerToInt
(
c
.
Owner
),
// owner
CardPlayerToInt
(
c
.
Player
),
// player
CardPlayerToInt
(
c
.
Player
),
// player
CardLocationToStr
(
c
.
Location
),
// location
CardLocationToStr
(
c
.
Location
),
// location
c
.
Seq
,
// seq
CardExtraSeq
(
c
.
Owner
,
c
.
Seq
),
// seq
CardPositionToStr
(
c
.
Position
),
// position
CardPositionToStr
(
c
.
Position
),
// position
IfThen
<
String
>(
c
.
Proc
,
'true'
,
'false'
)
// proc
IfThen
<
String
>(
c
.
Proc
,
'true'
,
'false'
)
// proc
]));
]));
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment