Skip to content

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

add: 增加搜索历史，增加一些提升用户体验的操作

parent 4021fc87
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 3857 additions and 3269 deletions
PuzzleEditor.lpi
View file @ 2341542c
......@@ -214,6 +214,12 @@
<Item>
<Name Value="ESocketError"/>
</Item>
<Item>
<Name Value="EHTTPClient"/>
</Item>
<Item>
<Name Value="EAccessViolation"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>
PuzzleEditor.lpr
View file @ 2341542c
......@@ -15,19 +15,40 @@ uses
{$R *.res}
type
{ TExceptionHandler }
TExceptionHandler = class
public
Procedure OnError(Sender : TObject; E : Exception);
end;
var
AMDPro3Path: string;
{ TExceptionHandler }
procedure TExceptionHandler.OnError(Sender: TObject; E: Exception);
begin
// do nothing
end;
var
EH: TExceptionHandler;
begin
AMDPro3Path:= TConfigReader.GetMDPro3InstallPath();
if (AMDPro3Path = '') or (not DirectoryExists(AMDPro3Path)) then begin
MessageDlg('提示', '没有安装 MDPro3，请先进行安装', mtError, [mbOK], 0);
Exit;
end;
EH:= TExceptionHandler.Create;
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.Initialize;
Application.OnException:= @EH.OnError;
Application.CreateForm(TFormHome, FormHome);
Application.Run;
EH.Free;
end.
frmabout.lfm
View file @ 2341542c
This diff is collapsed.
frmabout.pas
View file @ 2341542c
......@@ -20,13 +20,14 @@ type
lblGitlab: TD2Label;
Label5: TD2Label;
Line1: TD2Line;
Root1: TD2Background;
Root: TD2Background;
Scene: TD2Scene;
procedure FormCreate(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: char);
procedure lblGitlabClick(Sender: TObject);
procedure lblGitlabMouseEnter(Sender: TObject);
procedure lblGitlabMouseLeave(Sender: TObject);
procedure Root1Click(Sender: TObject);
procedure RootClick(Sender: TObject);
private
public
......@@ -38,6 +39,9 @@ var
implementation
uses
untConfig;
{$R *.lfm}
{ TFormAbout }
......@@ -52,6 +56,17 @@ begin
if (Key = #27) then Close;
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);
begin
LCLIntf.OpenURL('https://code.moenext.com/rarnu/puzzle-editor');
......@@ -62,7 +77,7 @@ begin
lblGitlab.Font.Style:= d2FontRegular;
end;
procedure TFormAbout.Root1Click(Sender: TObject);
procedure TFormAbout.RootClick(Sender: TObject);
begin
Close;
end;
......
frmcardlist.lfm
View file @ 2341542c
......@@ -8,9 +8,12 @@ object FormCardList: TFormCardList
Caption = '卡片列表'
ClientHeight = 800
ClientWidth = 600
Constraints.MinHeight = 800
Constraints.MinWidth = 600
OnCreate = FormCreate
OnDestroy = FormDestroy
Position = poMainFormCenter
LCLVersion = '3.6.0.0'
object Scene: TD2Scene
Left = 0
Height = 800
......@@ -1718,7 +1721,7 @@ object FormCardList: TFormCardList
000000000000F005400648656967687405000000000000008803400C50616464
696E672E52656374060928302C322C302C32290C436C69704368696C6472656E
09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F
6E74616C0E506F736974696F6E2E506F696E74060628312C383229064C6F636B
6E74616C0E506F736974696F6E2E506F696E74060628312C383629064C6F636B
6564090557696474680500000000000000EC0540064865696768740500000000
000000E404400C50616464696E672E52656374060928312C312C312C31290748
697454657374080A46696C6C2E5374796C65070F643242727573684772616469
......
frmcardlist.pas
View file @ 2341542c
......@@ -25,6 +25,7 @@ type
procedure FormDestroy(Sender: TObject);
private
FCardList: TFPGList<Int64>;
procedure addOneCardItem(ACard: TCard);
procedure deleteCardItem(ACardId: Int64; AIndex: Integer);
public
procedure FillCardIds(list: TFPGList<Int64>);
......@@ -37,7 +38,7 @@ var
implementation
uses untListItem, frmSearchCard;
uses untListItem, frmSearchCard, untConfig;
{$R *.lfm}
......@@ -46,6 +47,7 @@ uses untListItem, frmSearchCard;
procedure TFormCardList.btnAddCardClick(Sender: TObject);
var
cid: Int64 = 0;
c: TCard;
item: TCardListItemOp;
begin
with TFormSearchCard.Create(Self) do begin
......@@ -56,19 +58,30 @@ begin
end;
if cid > 0 then begin
FCardList.Add(cid);
c := Cards.GetCardInfo(cid);
lstCards.BeginUpdate;
item := TCardListItemOp.Create(lstCards);
item.CardName:= Cards.GetCardName(cid);
item.CardName:= c.CardName;
item.Id:= cid;
item.Card := c;
item.ShowFace := False;
item.Index:= lstCards.Count - 1;
item.OnDelete:= deleteCardItem;
item.OnCardAddOneClicked:= addOneCardItem;
lstCards.EndUpdate;
end;
end;
procedure TFormCardList.FormCreate(Sender: TObject);
var
AScale: Double;
begin
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;
procedure TFormCardList.FormDestroy(Sender: TObject);
......@@ -78,22 +91,49 @@ end;
procedure TFormCardList.deleteCardItem(ACardId: Int64; AIndex: Integer);
var
i: Integer;
cid: Int64;
i, j: Integer;
item: TCardListItemOp;
begin
// index matches
if (FCardList[AIndex] = ACardId) then begin
FCardList.Delete(AIndex);
lstCards.Items[AIndex].Free;
Exit;
end;
// index not match
FCardList.Remove(ACardId);
for i := 0 to lstCards.Count - 1 do begin
if TCardListItemOp(lstCards.Items[i]).Id = ACardId then begin
lstCards.Items[i].Free;
for i:= 0 to FCardList.Count - 1 do begin
cid := FCardList[i];
if cid = ACardId then begin
for j := 0 to lstCards.Count - 1 do begin
item := TCardListItemOp(lstCards.Items[j]);
if (item.Id = ACardId) and (item.Index = AIndex) then begin
FCardList.Delete(i);
item.Free;
Break;
end;
end;
Break;
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;
procedure TFormCardList.FillCardIds(list: TFPGList<Int64>);
......@@ -101,6 +141,7 @@ var
i: Integer;
item: TCardListItemOp;
cn: string;
c: TCard;
begin
FCardList.Clear;
FCardList.AddList(list);
......@@ -108,12 +149,15 @@ begin
if (list.Count > 0) then begin
lstCards.BeginUpdate;
for i:= 0 to FCardList.Count - 1 do begin
cn := Cards.GetCardName(FCardList[i]);
c := Cards.GetCardInfo(FCardList[i]);
item := TCardListItemOp.Create(lstCards);
item.CardName:= cn;
item.CardName:= c.CardName;
item.Id:= FCardList[i];
item.ShowFace := False;
item.Card := c;
item.Index:= i;
item.OnDelete:= deleteCardItem;
item.OnCardAddOneClicked:= addOneCardItem;
end;
lstCards.EndUpdate;
end;
......
frmcontinouseffected.lfm
View file @ 2341542c
......@@ -8,6 +8,8 @@ object FormContinousEffected: TFormContinousEffected
Caption = '永续受影响的卡片'
ClientHeight = 800
ClientWidth = 600
Constraints.MinHeight = 800
Constraints.MinWidth = 600
OnCreate = FormCreate
OnDestroy = FormDestroy
Position = poMainFormCenter
......@@ -1701,7 +1703,7 @@ object FormContinousEffected: TFormContinousEffected
000000000000F005400648656967687405000000000000008803400C50616464
696E672E52656374060928302C322C302C32290C436C69704368696C6472656E
09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F
6E74616C0E506F736974696F6E2E506F696E74060628312C383429064C6F636B
6E74616C0E506F736974696F6E2E506F696E74060628312C383629064C6F636B
6564090557696474680500000000000000EC0540064865696768740500000000
000000E404400C50616464696E672E52656374060928312C312C312C31290748
697454657374080A46696C6C2E5374796C65070F643242727573684772616469
......
frmcontinouseffected.pas
View file @ 2341542c
......@@ -43,15 +43,22 @@ var
implementation
uses
untUtils;
untUtils, untConfig;
{$R *.lfm}
{ TFormContinousEffected }
procedure TFormContinousEffected.FormCreate(Sender: TObject);
var
AScale: Double;
begin
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;
procedure TFormContinousEffected.CornerButton1Click(Sender: TObject);
......
frmhome.lfm
View file @ 2341542c
This diff is collapsed.
frmhome.pas
View file @ 2341542c
......@@ -240,6 +240,7 @@ type
procedure FormDestroy(Sender: TObject);
procedure fieldElementClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormShow(Sender: TObject);
private
BHand: array[0..1] of TD2CornerButton;
......@@ -268,6 +269,7 @@ type
FUserInfo: TMCUser;
function CheckSaved(AIsNew: Boolean): Boolean;
procedure currentCardListAddOne(ACard: TCard);
procedure currentCardListDelete(ACardId: Int64; AIndex: Integer);
procedure NewPuzzle();
procedure OpenPuzzle(AFilePath: string);
......@@ -313,6 +315,7 @@ procedure TFormHome.FormCreate(Sender: TObject);
var
i, j: Integer;
begin
TConfigReader.SetScale(1.0);
FPuzzle := nil;
FSaved:= True;
FFilePath:= '';
......@@ -536,11 +539,34 @@ begin
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);
begin
//
Self.Width:= Trunc(Panel2.Position.X + Panel2.Width + 32);
Self.Height:= Trunc(Panel2.Position.Y + Panel2.Height + 32);
self.Constraints.MinHeight:= Trunc(Panel2.Position.Y + Panel2.Height + 32);
self.Constraints.MinWidth:= Trunc(Panel2.Position.X + Panel2.Width + 32);;
end;
function TFormHome.CheckSaved(AIsNew: Boolean): Boolean;
......@@ -561,27 +587,59 @@ begin
end;
end;
procedure TFormHome.currentCardListDelete(ACardId: Int64; AIndex: Integer);
procedure TFormHome.currentCardListAddOne(ACard: TCard);
var
i: Integer;
item: TCardListItemOp;
c: TCard;
begin
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
if (FCurrentCardList[AIndex].CardId = ACardId) then begin
FCurrentCardList.Items[AIndex].Free;
FCurrentCardList.Delete(AIndex);
lstCardList.Items[AIndex].Free;
Exit;
// rebuild index
for i := 0 to lstCardList.Count - 1 do begin
item := TCardListItemOp(lstCardList.Items[i]);
item.Index:= i;
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
if (FCurrentCardList[i].CardId = ACardId) then begin
FCurrentCardList[i].Free;
FCurrentCardList.Delete(i);
lstCardList.Items[i].Free;
c := FCurrentCardList[i];
if c.CardId = ACardId then begin
for j := 0 to lstCardList.Count - 1 do begin
item := TCardListItemOp(lstCardList.Items[j]);
if (item.Id = ACardId) and (item.Index = AIndex) then begin
FCurrentCardList.Delete(i);
item.Free;
Break;
end;
end;
Break;
end;
end;
......@@ -968,6 +1026,7 @@ begin
end;
end;;
item.OnDelete:= currentCardListDelete;
item.OnCardAddOneClicked:= currentCardListAddOne;
end;
lstCardList.EndUpdate;
end;
......@@ -1236,6 +1295,7 @@ begin
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
......
frmlogin.lfm
View file @ 2341542c
object FormLogin: TFormLogin
Left = 650
Height = 182
Height = 200
Top = 44
Width = 500
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'MC 用户登录'
ClientHeight = 182
ClientHeight = 200
ClientWidth = 500
Constraints.MinHeight = 200
Constraints.MinWidth = 500
OnCreate = FormCreate
Position = poMainFormCenter
object Scene: TD2Scene
Left = 0
Height = 182
Height = 200
Top = 0
Width = 500
Align = alClient
......@@ -20,15 +23,16 @@ object FormLogin: TFormLogin
DesignSnapToLines = True
object Root: TD2Background
Width = 500
Height = 182
Height = 200
Margins.Rect = '(8,8,8,8)'
Padding.Rect = '(16,16,16,16)'
HitTest = False
object Layout1: TD2Layout
Align = vaTop
Position.Point = '(8,8)'
Position.Point = '(8,16)'
Width = 484
Height = 50
Padding.Rect = '(0,8,0,0)'
object Label1: TD2Label
Align = vaLeft
Position.Point = '(8,0)'
......@@ -60,7 +64,7 @@ object FormLogin: TFormLogin
end
object Layout2: TD2Layout
Align = vaTop
Position.Point = '(8,58)'
Position.Point = '(8,66)'
Width = 484
Height = 50
object Label2: TD2Label
......@@ -94,7 +98,7 @@ object FormLogin: TFormLogin
end
object Layout4: TD2Layout
Align = vaBottom
Position.Point = '(8,124)'
Position.Point = '(8,142)'
Width = 484
Height = 50
object btnOK: TD2CornerButton
......
frmlogin.pas
View file @ 2341542c
......@@ -25,6 +25,7 @@ type
edtPassword: TD2TextBox;
procedure btnOKClick(Sender: TObject);
procedure edtAccountChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FUserAccount: string;
FUserPassword: string;
......@@ -40,6 +41,9 @@ var
implementation
uses
untConfig;
{$R *.lfm}
{ TFormLogin }
......@@ -54,6 +58,17 @@ begin
btnOK.Enabled:= (acc <> '') and (pwd <> '');
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);
begin
FUserAccount:= edtAccount.Text;
......
frmpuzzleconfig.lfm
View file @ 2341542c
......@@ -8,6 +8,9 @@ object FormPuzzleConfig: TFormPuzzleConfig
Caption = '残局设置'
ClientHeight = 800
ClientWidth = 600
Constraints.MinHeight = 800
Constraints.MinWidth = 600
OnCreate = FormCreate
Position = poMainFormCenter
object Scene: TD2Scene
Left = 0
......@@ -1892,7 +1895,7 @@ object FormPuzzleConfig: TFormPuzzleConfig
000000000000F005400648656967687405000000000000008803400C50616464
696E672E52656374060928302C322C302C32290C436C69704368696C6472656E
09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F
6E74616C0E506F736974696F6E2E506F696E74060628312C383629064C6F636B
6E74616C0E506F736974696F6E2E506F696E74060628312C383829064C6F636B
6564090557696474680500000000000000EC0540064865696768740500000000
000000E404400C50616464696E672E52656374060928312C312C312C31290748
697454657374080A46696C6C2E5374796C65070F643242727573684772616469
......
frmpuzzleconfig.pas
View file @ 2341542c
......@@ -36,6 +36,7 @@ type
Scene: TD2Scene;
edtAIName: TD2TextBox;
edtPuzzleName: TD2TextBox;
procedure FormCreate(Sender: TObject);
private
function GetAIName: string;
function GetP0LP: Integer;
......@@ -66,10 +67,24 @@ var
implementation
uses
untConfig;
{$R *.lfm}
{ 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;
begin
Exit(edtAIName.Text);
......
frmsearchcard.lfm
View file @ 2341542c
......@@ -8,6 +8,9 @@ object FormSearchCard: TFormSearchCard
Caption = '卡片查询'
ClientHeight = 800
ClientWidth = 600
Constraints.MinHeight = 800
Constraints.MinWidth = 600
OnCreate = FormCreate
Position = poMainFormCenter
object Scene: TD2Scene
Left = 0
......@@ -47,6 +50,7 @@ object FormSearchCard: TFormSearchCard
Width = 300
Height = 34
Padding.Rect = '(8,8,8,8)'
OnKeyUp = edtCardNameKeyUp
TabOrder = 1
Font.Family = 'microsoft yahei'
Font.Size = 18
......@@ -74,10 +78,11 @@ object FormSearchCard: TFormSearchCard
end
object lstCards: TD2ListBox
Align = vaClient
Position.Point = '(8,58)'
Position.Point = '(8,118)'
Width = 584
Height = 676
Height = 616
OnClick = lstCardsClick
OnDblClick = lstCardsDblClick
TabOrder = 2
UseSmallScrollBars = True
Columns = 3
......@@ -126,6 +131,190 @@ object FormSearchCard: TFormSearchCard
Sides = [d2SideTop, d2SideLeft, d2SideBottom, d2SideRight]
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
object D2Resources1: TD2Resources
......@@ -1750,7 +1939,7 @@ object FormSearchCard: TFormSearchCard
000000000000F005400648656967687405000000000000008803400C50616464
696E672E52656374060928302C322C302C32290C436C69704368696C6472656E
09000C54443252656374616E676C650005416C69676E070C7661486F72697A6F
6E74616C0E506F736974696F6E2E506F696E74060628312C383429064C6F636B
6E74616C0E506F736974696F6E2E506F696E74060628312C393029064C6F636B
6564090557696474680500000000000000EC0540064865696768740500000000
000000E404400C50616464696E672E52656374060928312C312C312C31290748
697454657374080A46696C6C2E5374796C65070F643242727573684772616469
......
frmsearchcard.pas
View file @ 2341542c
......@@ -5,7 +5,7 @@ unit frmSearchCard;
interface
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
......@@ -15,20 +15,43 @@ type
btnSearchCard: TD2CornerButton;
btnCancel: TD2CornerButton;
btnOK: TD2CornerButton;
CircleButton1: TD2CircleButton;
D2Resources1: TD2Resources;
Label1: TD2Label;
Layout1: TD2Layout;
Layout2: TD2Layout;
layHistory: TD2Layout;
Layout3: TD2Layout;
Layout4: TD2Layout;
Layout5: TD2Layout;
lstCards: TD2ListBox;
Root: TD2Background;
Scene: TD2Scene;
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 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 lstCardsDblClick(Sender: TObject);
procedure txtHistory0Click(Sender: TObject);
private
FCardId: Int64;
FHistory: array[0..9] of TD2Text;
procedure SearchCard(Keyword: string);
procedure SaveHistory(ALast: string);
public
published
......@@ -41,7 +64,7 @@ var
implementation
uses
untListItem;
untListItem, untConfig;
{$R *.lfm}
......@@ -50,11 +73,90 @@ uses
procedure TFormSearchCard.btnSearchCardClick(Sender: TObject);
var
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>;
i: Integer;
item: TCardListItem;
begin
keyword:= edtCardName.Text;
if (keyword = '') then Exit;
list := Cards.SearchCards(keyword);
lstCards.Clear;
......@@ -69,11 +171,29 @@ begin
btnOK.Enabled:= False;
// deselect all
lstCards.ItemIndex:= -1;
// save history
SaveHistory(keyword);
end;
procedure TFormSearchCard.lstCardsClick(Sender: TObject);
procedure TFormSearchCard.SaveHistory(ALast: string);
var
Arr: TStringArray;
i: Integer;
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;
procedure TFormSearchCard.btnOKClick(Sender: TObject);
......
untcard.pas
View file @ 2341542c
......@@ -294,10 +294,10 @@ var
i, j: Integer;
begin
FPuzzleId := 0;
FPuzzleName:= '';
FAIName:= '';
FLPOpponent:= 0;
FLPSelf:= 0;
FPuzzleName:= '我制作的游戏王残局';
FAIName:= '只是一个AI';
FLPOpponent:= 8000;
FLPSelf:= 8000;
FMessage:= '';
FSolution := '';
FP0Hand := TFPGList<TCard>.Create;
......
untconfig.pas
View file @ 2341542c
......@@ -5,17 +5,23 @@ unit untConfig;
interface
uses
Classes, SysUtils, Registry;
Classes, SysUtils, Registry, Forms, IniFiles;
type
{ TConfigReader }
TConfigReader = class
private
class var FScale: Double;
public
class function GetMCToken(): string;
class procedure SaveMCToken(AToken: string);
class function GetMDPro3InstallPath(): string;
class procedure SetScale(AScale: Double);
class function GetScale(): Double;
class function GetSearchHistory(): TStringArray;
class procedure SetSearchHistory(Arr: TStringArray);
end;
implementation
......@@ -86,5 +92,44 @@ begin
Exit(APath);
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.
untlistitem.pas
View file @ 2341542c
......@@ -32,6 +32,7 @@ type
{ TOnCardListItemOpDeleted }
TOnCardListItemOpDeleted = procedure (ACardId: Int64; AIndex: Integer) of object;
TOnCardAddOneClicked = procedure (ACard: TCard) of object;
{ TCardListItemOp }
......@@ -40,14 +41,17 @@ type
FCard: TCard;
FCardName: string;
FFace: Integer;
FOnCardAddOneClicked: TOnCardAddOneClicked;
FShowFace: Boolean;
FId: Int64;
FIndex: Integer;
FOnDelete: TOnCardListItemOpDeleted;
FImg: TD2Image;
FLbl: TD2Label;
FBtnAddOne: TD2RoundButton;
FbtnFace: TD2CornerButton;
FBtnDel: TD2CornerButton;
procedure innerBtnAddOneClick(Sender: TObject);
procedure innerBtnDelClick(Sender: TObject);
procedure innerBtnFaceClick(Sender: TObject);
procedure SetCardName(AValue: string);
......@@ -64,6 +68,7 @@ type
property CardName: string read FCardName write SetCardName;
property Card: TCard read FCard write FCard;
property OnDelete: TOnCardListItemOpDeleted read FOnDelete write FOnDelete;
property OnCardAddOneClicked: TOnCardAddOneClicked read FOnCardAddOneClicked write FOnCardAddOneClicked;
property Index: Integer read FIndex write FIndex;
property Face: Integer read FFace write SetFace;
property ShowFace: Boolean read FShowFace write SetShowFace;
......@@ -263,6 +268,13 @@ begin
end;
end;
procedure TCardListItemOp.innerBtnAddOneClick(Sender: TObject);
begin
if (Assigned(FOnCardAddOneClicked)) then begin
FOnCardAddOneClicked(FCard);
end;
end;
procedure TCardListItemOp.innerBtnFaceClick(Sender: TObject);
begin
if (FFace = 0) then begin
......@@ -346,27 +358,40 @@ begin
FbtnFace.Parent := Self;
FbtnFace.Align:= vaRight;
FbtnFace.Padding.Right:= 0;
FbtnFace.Padding.Top:= 16;
FbtnFace.Padding.Bottom:= 16;
FbtnFace.Padding.Top:= 18;
FbtnFace.Padding.Bottom:= 18;
FbtnFace.Padding.Left:= 8;
FbtnFace.Height:= 43;
FbtnFace.Width:= 70;
FbtnFace.Height:= 40;
FbtnFace.Width:= 50;
FbtnFace.Font.Family:= 'Microsoft Yahei';
FbtnFace.Font.Size:= 14;
FbtnFace.Font.Size:= 12;
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.Parent := Self;
FBtnDel.Align:= vaMostRight;
FBtnDel.Padding.Right:= 8;
FBtnDel.Padding.Top:= 16;
FBtnDel.Padding.Bottom:= 16;
FBtnDel.Padding.Top:= 18;
FBtnDel.Padding.Bottom:= 18;
FBtnDel.Padding.Left:= 8;
FBtnDel.Text:= '删除';
FBtnDel.Height:= 43;
FBtnDel.Width:= 70;
FBtnDel.Height:= 40;
FBtnDel.Width:= 50;
FBtnDel.Font.Family:= 'Microsoft Yahei';
FBtnDel.Font.Size:= 14;
FBtnDel.Font.Size:= 12;
FBtnDel.OnClick:= innerBtnDelClick;
end;
......
untscriptgenerator.pas
View file @ 2341542c
......@@ -16,6 +16,7 @@ type
class function CardOWnerToInt(AO: TCardOwner): Integer;
class function CardPlayerToInt(AP: TCardPlayer): Integer;
class function CardLocationToStr(AL: TCardLocation): String;
class function CardExtraSeq(AO: TCardOwner; ASeq: Integer): Integer;
class function CardLocationToInt(AL: TCardLocation): Integer;
class function CardPositionToStr(AP: TCardPosition): String;
class function CardXEPositionToStr(AP: TCardPosition): String;
......@@ -55,6 +56,14 @@ begin
Exit('');
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;
begin
case AL of
......@@ -214,7 +223,7 @@ begin
CardOWnerToInt(c.Owner), // owner
CardPlayerToInt(c.Player), // player
CardLocationToStr(c.Location), // location
c.Seq, // seq
CardExtraSeq(c.Owner, c.Seq), // seq
CardPositionToStr(c.Position), // position
IfThen<String>(c.Proc, 'true', 'false') // proc
]));
......
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