Changeset 684 for trunk/Packages

Timestamp:

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

Author:

chronos

Message:

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

Location:

trunk/Packages

Files:

• CevoComponents/BaseWin.pas (modified) (9 diffs)
• CevoComponents/DrawDlg.pas (modified) (1 diff)
• CevoComponents/ScreenTools.pas (modified) (2 diffs)
• DpiControls/Dpi.Controls.pas (modified) (6 diffs)

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