Changeset 684

Timestamp:

Jul 26, 2025, 10:38:53 PM (10 hours ago)

Author:

chronos

Message:

• Modified: Improved forms painting if resized to bigger dimensions.

Location:

trunk

Files:

• LocalPlayer/CityType.lfm (modified) (1 prop) ( previous)
• LocalPlayer/CityType.pas (modified) (3 diffs)
• LocalPlayer/Diagram.pas (modified) (3 diffs)
• LocalPlayer/Draft.pas (modified) (3 diffs)
• LocalPlayer/Enhance.pas (modified) (2 diffs)
• LocalPlayer/Help.pas (modified) (2 diffs)
• LocalPlayer/Rates.pas (modified) (3 diffs)
• LocalPlayer/Select.pas (modified) (2 diffs)
• LocalPlayer/TechTree.pas (modified) (2 diffs)
• LocalPlayer/Wonders.pas (modified) (2 diffs)
• Packages/CevoComponents/BaseWin.pas (modified) (9 diffs)
• Packages/CevoComponents/DrawDlg.pas (modified) (1 diff)
• Packages/CevoComponents/ScreenTools.pas (modified) (2 diffs)
• Packages/DpiControls/Dpi.Controls.pas (modified) (6 diffs)

trunk/LocalPlayer/CityType.pas

@@ -10 +10 @@
 
 type
+
+  { TCityTypeDlg }
+
   TCityTypeDlg = class(TFramedDlg)
     CloseBtn: TButtonB;
@@ -25 +28 @@
   protected
     procedure OffscreenPaint; override;
+    procedure DoOnResize; override;
   private
     nPool, dragiix, ctype: Integer;
@@ -190 +194 @@
 end;
 
+procedure TCityTypeDlg.DoOnResize;
+begin
+  inherited;
+  CloseBtn.Left := Width - 36;
+end;
+
 procedure TCityTypeDlg.LoadType(NewType: Integer);
 var

trunk/LocalPlayer/Diagram.pas

@@ -11 +11 @@
 type
   TDiagramKind = (dkChart, dkShip);
+
+  { TDiaDlg }
 
   TDiaDlg = class(TFramedDlg)
@@ -23 +25 @@
     procedure PlayerClick(Sender: TObject);
     procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+  private
+    Kind: TDiagramKind;
+    Player: Integer;
+    Mode: Integer;
+  protected
+    procedure DoOnResize; override;
   public
     procedure OffscreenPaint; override;
     procedure ShowNewContent_Charts(NewMode: TWindowMode);
     procedure ShowNewContent_Ship(NewMode: TWindowMode; P: Integer = -1);
-  private
-    Kind: TDiagramKind;
-    Player: Integer;
-    Mode: Integer;
   end;
 
@@ -369 +373 @@
 end;
 
+procedure TDiaDlg.DoOnResize;
+begin
+  inherited;
+  CloseBtn.Left := Width - 38;
+end;
+
 end.

trunk/LocalPlayer/Draft.pas

@@ -12 +12 @@
 
 type
+
+  { TDraftDlg }
+
   TDraftDlg = class(TBufferedDrawDlg)
     OKBtn: TButtonA;
@@ -36 +39 @@
   protected
     procedure OffscreenPaint; override;
+    procedure DoOnResize; override;
   public
     procedure ShowNewContent(NewMode: TWindowMode);
@@ -403 +407 @@
 end;
 
+procedure TDraftDlg.DoOnResize;
+begin
+  inherited;
+  CloseBtn.Left := Width - 31;
+end;
+
 procedure TDraftDlg.SetDomain(D: Integer);
 

trunk/LocalPlayer/Enhance.pas

@@ -42 +42 @@
     Page: Integer;
     procedure OffscreenPaint; override;
+    procedure DoOnResize; override;
   public
     procedure ShowNewContent(NewMode: TWindowMode; TerrType: Integer = -1);
@@ -299 +300 @@
 end;
 
+procedure TEnhanceDlg.DoOnResize;
+begin
+  inherited;
+  CloseBtn.Left := Width - 38;
+end;
+
 procedure TEnhanceDlg.CloseBtnClick(Sender: TObject);
 begin

trunk/LocalPlayer/Help.pas

@@ -141 +141 @@
   protected
     procedure OffscreenPaint; override;
+    procedure DoOnResize; override;
   public
     HistItems: THistItems;
@@ -867 +868 @@
   end;
   MarkUsedOffscreen(InnerWidth, InnerHeight + 13 + 48);
+end;
+
+procedure THelpDlg.DoOnResize;
+begin
+  inherited;
+  SearchBtn.Left := Width - 67;
+  CloseBtn.Left := Width - 38;
 end;
 

trunk/LocalPlayer/Rates.pas

@@ -11 +11 @@
 
 type
+
+  { TRatesDlg }
+
   TRatesDlg = class(TBufferedDrawDlg)
     CloseBtn: TButtonB;
@@ -23 +26 @@
   protected
     procedure OffscreenPaint; override;
+    procedure DoOnResize; override;
   public
     procedure ShowNewContent(NewMode: TWindowMode);
@@ -153 +157 @@
 end;
 
+procedure TRatesDlg.DoOnResize;
+begin
+  inherited;
+  CloseBtn.Left := Width - 38;
+end;
+
 procedure TRatesDlg.ShowNewContent(NewMode: TWindowMode);
 begin

trunk/LocalPlayer/Select.pas

@@ -95 +95 @@
     procedure OnMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
     procedure SetSelectionIndex(Index: Integer);
+  protected
+    procedure DoOnResize; override;
   public
     Result: Integer;
@@ -1917 +1919 @@
 end;
 
+procedure TListDlg.DoOnResize;
+begin
+  inherited;
+  CloseBtn.Left := Width - 38;
+end;
+
 procedure TListDlg.FormKeyDown(Sender: TObject; var Key: Word;
   Shift: TShiftState);

trunk/LocalPlayer/TechTree.pas

@@ -30 +30 @@
     procedure CloseBtnClick(Sender: TObject);
     procedure TimerKeyPressedTimer(Sender: TObject);
+  protected
+    procedure DoOnResize; override;
   private
     Offset: TPoint;
@@ -273 +275 @@
 end;
 
+procedure TTechTreeDlg.DoOnResize;
+begin
+  inherited;
+  CloseBtn.Left := Width - 43;
+end;
+
 procedure TTechTreeDlg.Move(Diff: TPoint);
 begin

trunk/LocalPlayer/Wonders.pas

@@ -29 +29 @@
   protected
     procedure OffscreenPaint; override;
+    procedure DoOnResize; override;
   public
     procedure ShowNewContent(NewMode: TWindowMode);
@@ -278 +279 @@
 
   MarkUsedOffscreen(ClientWidth, ClientHeight);
+end;
+
+procedure TWondersDlg.DoOnResize;
+begin
+  inherited;
+  CloseBtn.Left := Width - 38;
 end;
 

trunk/Packages/CevoComponents/BaseWin.pas

@@ -23 +23 @@
     procedure OffscreenPaint; virtual;
     procedure VPaint; virtual;
+    procedure DoOnResize; override;
   public
     UserLeft: Integer;
@@ -40 +41 @@
   end;
 
+  { TFramedDlg }
+
   TFramedDlg = class(TBufferedDrawDlg)
   protected
@@ -53 +56 @@
     procedure VPaint; override;
     procedure FillOffscreen(Left, Top, Width, Height: Integer);
+    procedure DoOnResize; override;
   public
     constructor Create(AOwner: TComponent); override;
@@ -167 +171 @@
 begin
   BitBltCanvas(Canvas, 0, 0, ClientWidth, ClientHeight, Offscreen.Canvas, 0, 0);
+end;
+
+procedure TBufferedDrawDlg.DoOnResize;
+begin
+  inherited;
+  SmartUpdateContent;
 end;
 
@@ -232 +242 @@
 end;
 
-constructor TFramedDlg.Create;
+constructor TFramedDlg.Create(AOwner: TComponent);
 begin
   OnCreate := FormCreate;
@@ -247 +257 @@
   ModalIndication := True;
   Canvas.Brush.Style := TBrushStyle.bsClear;
-  InnerWidth := Width - 2 * SideFrame;
-  InnerHeight := Height - TitleHeight - NarrowFrame;
+  DoOnResize;
 end;
 
@@ -304 +313 @@
   L := BiColorTextWidth(Canvas, Caption);
   Cut := (ClientWidth - L) div 2;
-  xTexOffset := (Maintexture.Width - ClientWidth) div 2;
-  yTexOffset := (Maintexture.Height - ClientHeight) div 2;
+  xTexOffset := 0; //(Maintexture.Width - ClientWidth) div 2;
+  yTexOffset := 0; //(Maintexture.Height - ClientHeight) div 2;
   if WideBottom then
     InnerBottom := ClientHeight - WideFrame
@@ -332 +341 @@
   Frame(Canvas, SideFrame - 1, TitleHeight - 1, ClientWidth - SideFrame,
     InnerBottom, MainTexture.ColorBevelShade, MainTexture.ColorBevelLight);
+
   // RFrame(Canvas,SideFrame - 2, TitleHeight - 2, ClientWidth - SideFrame + 1,
   // InnerBottom + 1, MainTexture.ColorBevelShade, MainTexture.ColorBevelLight);
@@ -471 +481 @@
 begin
   Fill(Offscreen.Canvas, Left, Top, Width, Height,
-    SideFrame + (Maintexture.Width - ClientWidth) div 2,
-    TitleHeight + (Maintexture.Height - ClientHeight) div 2);
+    SideFrame, TitleHeight);
+end;
+
+procedure TFramedDlg.DoOnResize;
+begin
+  inherited;
+  InnerWidth := Width - 2 * SideFrame;
+  InnerHeight := Height - TitleHeight - NarrowFrame;
+  SmartUpdateContent;
 end;
 

trunk/Packages/CevoComponents/DrawDlg.pas

@@ -73 +73 @@
 begin
   inherited;
+
+  // Make all dialogs resizable
+  //BorderStyle := TBorderStyle.bsSizeable;
+  //BorderIcons := [TBorderIcon.biSystemMenu, TBorderIcon.biMinimize, TBorderIcon.biMaximize];
+
   Color := clBlack;
   TitleHeight := 0;

trunk/Packages/CevoComponents/ScreenTools.pas

@@ -1123 +1123 @@
 
 procedure Fill(Canvas: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer);
-begin
-  //Assert((Left + xOffset >= 0) and (Left + xOffset + Width <= MainTexture.Width) and
-  //  (Top + yOffset >= 0) and (Top + yOffset + Height <= MainTexture.Height));
-  BitBltCanvas(Canvas, Left, Top, Width, Height, MainTexture.Image.Canvas,
-    Left + xOffset, Top + yOffset);
+var
+  X, Y: Integer;
+  XX, YY: Integer;
+  W, H: Integer;
+begin
+  // BitBltCanvas(Canvas, Left, Top, Width, Height, MainTexture.Image.Canvas,
+  //   Left + xOffset, Top + yOffset);
+  if Width < MainTexture.Width then W := Width
+    else W := MainTexture.Width;
+  if Height < MainTexture.Height then H := Height
+    else H := MainTexture.Height;
+  if MainTexture.Height > 0 then YY := Trunc(Height / MainTexture.Height)
+    else YY := 0;
+  if MainTexture.Width > 0 then XX := Trunc(Width / MainTexture.Width)
+    else XX := 0;
+  for Y := 0 to YY do
+  for X := 0 to XX do
+    begin
+    BitBltCanvas(Canvas, Left + X * MainTexture.Width, Top + Y * MainTexture.Height,
+      W, H, MainTexture.Image.Canvas, 0, 0);
+  end;
 end;
 
@@ -1212 +1228 @@
 procedure PaintBackground(Canvas: TCanvas; Left, Top, Width, Height, FormWidth,
   FormHeight: Integer);
-var
-  X, Y: Integer;
-  XX, YY: Integer;
-begin
-  if MainTexture.Height > 0 then YY := Trunc(Height / MainTexture.Height)
-    else YY := 0;
-  if MainTexture.Width > 0 then XX := Trunc(Width / MainTexture.Width)
-    else XX := 0;
-  for Y := 0 to YY do
-  for X := 0 to XX do
-  begin
-    Fill(Canvas, Left + X * MainTexture.Width, Top + Y * MainTexture.Height, Width, Height,
-      -(Left + X * MainTexture.Width), -(Top + Y * MainTexture.Height));
-  end;
+begin
+  Fill(Canvas, Left, Top, Width, Height, 0, 0)
 end;
 

trunk/Packages/DpiControls/Dpi.Controls.pas

@@ -122 +122 @@
     procedure SetParentFont(AValue: Boolean);
     procedure SetShowHint(AValue: Boolean);
-    procedure NativeFormResize(Sender: TObject);
+    procedure NativeResize(Sender: TObject);
     procedure NativeChangeBounds(Sender: TObject);
-    procedure DoFormResize;
     procedure DoChangeBounds;
     procedure MouseDownHandler(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
@@ -138 +137 @@
     function ColorIsStored: Boolean; virtual;
   protected
+    procedure DoOnResize; virtual;
     procedure DoBorderSpacingChange(Sender: TObject; InnerSpaceChanged: Boolean); virtual;
     function GetText: TCaption; virtual;
@@ -604 +604 @@
 begin
   Font.NativeFont := GetNativeControl.Font;
-  GetNativeControl.OnResize := NativeFormResize;
+  GetNativeControl.OnResize := NativeResize;
   GetNativeControl.OnChangeBounds := NativeChangeBounds;
 
@@ -1034 +1034 @@
 end;
 
-procedure TControl.NativeFormResize(Sender: TObject);
+procedure TControl.NativeResize(Sender: TObject);
 var
   R: TRect;
@@ -1043 +1043 @@
   FWidth := R.Width;
   FHeight := R.Height;
-  DoFormResize;
+  DoOnResize;
 end;
 
@@ -1060 +1060 @@
 end;
 
-procedure TControl.DoFormResize;
+procedure TControl.DoOnResize;
 begin
   if Assigned(FOnResize) then begin