add: 增加自动缩放

PuzzleEditor.lpr

@@ -32,6 +32,7 @@ var
 procedure TExceptionHandler.OnError(Sender: TObject; E: Exception);
 begin
   // do nothing
+
 end;
 
 var

frmcardlist.pas

@@ -63,7 +63,7 @@ begin
     item := TCardListItemOp.Create(lstCards);
     item.CardName:= c.CardName;
     item.Id:= cid;
-    item.Card := c;
+    item.SetCardForFree(c, True);
     item.ShowFace := False;
     item.Index:= lstCards.Count - 1;
     item.OnDelete:= deleteCardItem;
@@ -128,7 +128,7 @@ begin
   item:= TCardListItemOp.Create(lstCards);
   item.CardName:= c.CardName;
   item.Id:= c.CardId;
-  item.Card := c;
+  item.SetCardForFree(c, True);
   item.ShowFace:= False;
   item.Index:= lstCards.Count - 1;
   item.OnDelete:= deleteCardItem;
@@ -154,7 +154,7 @@ begin
       item.CardName:= c.CardName;
       item.Id:= FCardList[i];
       item.ShowFace := False;
-      item.Card := c;
+      item.SetCardForFree(c, True);
       item.Index:= i;
       item.OnDelete:= deleteCardItem;
       item.OnCardAddOneClicked:= addOneCardItem;

frmhome.pas

@@ -314,8 +314,16 @@ uses
 procedure TFormHome.FormCreate(Sender: TObject);
 var
   i, j: Integer;
+  AScale: Double;
 begin
-  TConfigReader.SetScale(1.0);
+  TConfigReader.LoadScale();
+  AScale:= TConfigReader.GetScale();
+
+  self.Width:= Trunc(1330 * AScale);
+  self.Height:= Trunc(880 * AScale);
+  Root.Scale.X:= AScale;
+  Root.Scale.Y:= AScale;
+
   FPuzzle := nil;
   FSaved:= True;
   FFilePath:= '';
@@ -433,6 +441,7 @@ end;
 
 procedure TFormHome.FormDestroy(Sender: TObject);
 begin
+  TConfigReader.SaveScale();
   if FPuzzle <> nil then begin
     FPuzzle.Free;
   end;
@@ -549,10 +558,7 @@ begin
   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
+  if (Self.Width / self.Height <> ARate) then begin
     Self.Height:= Trunc(Self.Width / ARate);
     // self.Width:= Trunc(self.Height * ARate);
   end;
@@ -565,8 +571,8 @@ end;
 
 procedure TFormHome.FormShow(Sender: TObject);
 begin
-  self.Constraints.MinHeight:= Trunc(Panel2.Position.Y + Panel2.Height + 32);
-  self.Constraints.MinWidth:= Trunc(Panel2.Position.X + Panel2.Width + 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;
@@ -599,7 +605,7 @@ begin
   item := TCardListItemOp.Create(lstCardList);
   item.CardName:= c.CardName;
   item.Id:= c.CardId;
-  item.Card := c;
+  item.SetCardForFree(c, False);
   item.Index:= lstCardList.Count - 1;
   item.OnDelete:= currentCardListDelete;
   item.OnCardAddOneClicked:= currentCardListAddOne;
@@ -635,6 +641,7 @@ 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
+          c.Free;
           FCurrentCardList.Delete(i);
           item.Free;
           Break;
@@ -1012,7 +1019,7 @@ begin
     item := TCardListItemOp.Create(lstCardList);
     item.CardName:= FCurrentCardList[i].CardName;
     item.Id:= FCurrentCardList[i].CardId;
-    item.Card := FCurrentCardList[i];
+    item.SetCardForFree(FCurrentCardList[i], False);
     item.Index:= i;
     if (FFieldInfo.Location = clGrave) then begin
       // only face up
@@ -1292,7 +1299,7 @@ begin
     item := TCardListItemOp.Create(lstCardList);
     item.CardName:= c.CardName;
     item.Id:= cid;
-    item.Card := c;
+    item.SetCardForFree(c, False);
     item.Index:= lstCardList.Count - 1;
     item.OnDelete:= currentCardListDelete;
     item.OnCardAddOneClicked:= currentCardListAddOne;

untconfig.pas

@@ -20,6 +20,8 @@ type
     class function GetMDPro3InstallPath(): string;
     class procedure SetScale(AScale: Double);
     class function GetScale(): Double;
+    class procedure SaveScale();
+    class procedure LoadScale();
     class function GetSearchHistory(): TStringArray;
     class procedure SetSearchHistory(Arr: TStringArray);
   end;
@@ -102,6 +104,28 @@ begin
   Exit(FScale);
 end;
 
+class procedure TConfigReader.SaveScale();
+var
+  ACfgPath: string;
+  ini: TIniFile;
+begin
+  ACfgPath:= ChangeFileExt(Application.ExeName, '.conf');
+  ini := TIniFile.Create(ACfgPath);
+  ini.WriteFloat('SCALE', 'value', FScale);
+  ini.Free;
+end;
+
+class procedure TConfigReader.LoadScale();
+var
+  ACfgPath: string;
+  ini: TIniFile;
+begin
+  ACfgPath:= ChangeFileExt(Application.ExeName, '.conf');
+  ini := TIniFile.Create(ACfgPath);
+  FScale:= ini.ReadFloat('SCALE', 'value', 1.0);
+  ini.Free;
+end;
+
 class function TConfigReader.GetSearchHistory(): TStringArray;
 var
   ACfgPath: string;

untlistitem.pas

@@ -51,6 +51,7 @@ type
     FBtnAddOne: TD2RoundButton;
     FbtnFace: TD2CornerButton;
     FBtnDel: TD2CornerButton;
+    FNeedFree: Boolean;
     procedure innerBtnAddOneClick(Sender: TObject);
     procedure innerBtnDelClick(Sender: TObject);
     procedure innerBtnFaceClick(Sender: TObject);
@@ -63,6 +64,7 @@ type
   public
     constructor Create(AOwner: TComponent); Override;
     destructor Destroy; Override;
+    procedure SetCardForFree(ACard: TCard; AFree: Boolean);
   published
     property Id: Int64 read FId write SetId;
     property CardName: string read FCardName write SetCardName;
@@ -284,6 +286,12 @@ begin
   end;
 end;
 
+procedure TCardListItemOp.SetCardForFree(ACard: TCard; AFree: Boolean);
+begin
+  FCard := ACard;
+  FNeedFree:= AFree;
+end;
+
 procedure TCardListItemOp.SetId(AValue: Int64);
 var
   AImgPath: string;
@@ -327,6 +335,8 @@ begin
   Parent := TD2Object(AOwner);
   Align:= vaTop;
 
+  FNeedFree := False;
+
   Width:= 500;
   Height:= 75;
 
@@ -398,6 +408,9 @@ end;
 
 destructor TCardListItemOp.Destroy;
 begin
+  if (FNeedFree) then begin
+    FCard.Free;
+  end;
   FImg.Free;
   FLbl.Free;
   FBtnDel.Free;