Changeset 565

Timestamp:

May 1, 2024, 12:08:20 PM (2 weeks ago)

Author:

chronos

Message:

• Modified: Start form changed to use Offscreen bitmap for drawing as Qt5 doesn't support copying from form canvas.

Location:

trunk

Files:

• Direct.pas (modified) (1 diff)
• Inp.pas (modified) (1 diff)
• LocalPlayer/Battle.pas (modified) (1 diff)
• LocalPlayer/Rates.pas (modified) (2 diffs)
• LocalPlayer/Wonders.pas (modified) (2 diffs)
• Packages/CevoComponents/DrawDlg.pas (modified) (3 diffs)
• Packages/CevoComponents/ScreenTools.pas (modified) (2 diffs)
• Settings.lfm (modified) (1 diff)
• Settings.pas (modified) (1 diff)
• Start.lfm (modified) (1 diff)
• Start.pas (modified) (11 diffs)

trunk/Direct.pas

@@ -278 +278 @@
 procedure TDirectDlg.FormPaint(Sender: TObject);
 begin
-  PaintBackground(Self, 3, 3, ClientWidth - 6, ClientHeight - 6);
+  PaintBackground(Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6,
+    ClientWidth, ClientHeight);
   Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
   Frame(Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,

trunk/Inp.pas

@@ -44 +44 @@
 procedure TInputDlg.FormPaint(Sender: TObject);
 begin
-  PaintBackground(Self, 3, 3, Width - 6, Height - 6);
+  PaintBackground(Canvas, 3, 3, Width - 6, Height - 6, Width, Height);
   Frame(Canvas, 0, 0, Width - 1, Height - 1, 0, 0);
   Frame(Canvas, 1, 1, Width - 2, Height - 2,

trunk/LocalPlayer/Battle.pas

@@ -229 +229 @@
     FillRect(Rect(0, 0, ClientWidth, ClientHeight));
     Brush.Style := TBrushStyle.bsClear;
-    PaintBackground(Self, 3 + Border, 3 + Border,
-      ClientWidth - (6 + 2 * Border), ClientHeight - (6 + 2 * Border));
+    PaintBackground(Canvas, 3 + Border, 3 + Border,
+      ClientWidth - (6 + 2 * Border), ClientHeight - (6 + 2 * Border),
+      ClientWidth, ClientHeight);
   end;
   Frame(Canvas, Border + 1, Border + 1, ClientWidth - (2 + Border),

trunk/LocalPlayer/Rates.pas

@@ -21 +21 @@
     procedure FormCreate(Sender: TObject);
     procedure TaxLuxBtnClick(Sender: TObject);
+  protected
+    procedure OffscreenPaint; override;
   public
-    procedure OffscreenPaint; override;
     procedure ShowNewContent(NewMode: TWindowMode);
   end;
@@ -48 +49 @@
   S, s1: string;
 begin
-  if (OffscreenUser <> nil) and (OffscreenUser <> Self) then
-    OffscreenUser.Update;
-  // complete working with old owner to prevent rebound
-  OffscreenUser := Self;
+  inherited;
 
   Fill(Offscreen.Canvas, 0, 0, ClientWidth, ClientHeight,

trunk/LocalPlayer/Wonders.pas

@@ -27 +27 @@
     procedure Glow(I, GlowColor: Integer);
     procedure PaintBackgroundShape;
+  protected
+    procedure OffscreenPaint; override;
   public
-    procedure OffscreenPaint; override;
     procedure ShowNewContent(NewMode: TWindowMode);
   end;
@@ -193 +194 @@
   S: string;
 begin
-  if (OffscreenUser <> nil) and (OffscreenUser <> Self) then
-    OffscreenUser.Update;
-  // complete working with old owner to prevent rebound
-  OffscreenUser := Self;
+  inherited;
 
   Fill(Offscreen.Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6,

trunk/Packages/CevoComponents/DrawDlg.pas

@@ -21 +21 @@
     procedure DoDeactivate(Sender: TObject);
   protected
+    // Defines area to grip the window for moving (from top)
     TitleHeight: Integer;
-    // defines area to grip the window for moving (from top)
     procedure InitButtons;
     procedure OnEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;
@@ -237 +237 @@
 procedure TDrawDlg.SmartInvalidate;
 var
-  i: Integer;
-  r0, r1: HRgn;
-begin
-  r0 := CreateRectRgn(0, 0, Width, Height);
-  for i := 0 to ControlCount - 1 do
-    if not (Controls[i] is TArea) and Controls[i].Visible then
-    begin
-      with Controls[i].BoundsRect do
-        r1 := CreateRectRgn(Left, Top, Right, Bottom);
-      CombineRgn(r0, r0, r1, RGN_DIFF);
-      DeleteObject(r1);
-    end;
-  InvalidateRgn(Handle, r0, False);
-  DeleteObject(r0);
+  I: Integer;
+  R0, R1: HRgn;
+begin
+  R0 := CreateRectRgn(0, 0, Width, Height);
+  for I := 0 to ControlCount - 1 do
+    if not (Controls[I] is TArea) and Controls[I].Visible then begin
+      with Controls[I].BoundsRect do
+        R1 := CreateRectRgn(Left, Top, Right, Bottom);
+      CombineRgn(R0, R0, R1, RGN_DIFF);
+      DeleteObject(R1);
+    end;
+  InvalidateRgn(Handle, R0, False);
+  DeleteObject(R0);
 end;
 
@@ -272 +271 @@
 begin
   if csDesigning in ComponentState then Exit;
-  PaintBackground(Self, 3 + Border, 3 + Border, Width - (6 + 2 * Border),
-    Height - (6 + 2 * Border));
+  PaintBackground(Canvas, 3 + Border, 3 + Border, Width - (6 + 2 * Border),
+    Height - (6 + 2 * Border), Width, Height);
   for I := 0 to Border do
-    Frame(Canvas, I, I, Width - 1 - I, Height - 1 - I,
-      $000000, $000000);
+    Frame(Canvas, I, I, Width - 1 - I, Height - 1 - I, $000000, $000000);
   Frame(Canvas, Border + 1, Border + 1, Width - (2 + Border),
     Height - (2 + Border), MainTexture.ColorBevelLight,

trunk/Packages/CevoComponents/ScreenTools.pas

@@ -75 +75 @@
 procedure FillRectSeamless(Canvas: TCanvas; x0, y0, x1, y1, xOffset, yOffset: Integer;
   const Texture: TBitmap);
-procedure PaintBackground(Form: TForm; Left, Top, Width, Height: Integer);
+procedure PaintBackground(Canvas: TCanvas; Left, Top, Width, Height, FormWidth,
+  FormHeight: Integer);
 procedure Corner(Canvas: TCanvas; X, Y, Kind: Integer; T: TTexture);
 procedure BiColorTextOut(Canvas: TCanvas; clMain, clBack: TColor; X, Y: Integer; S: string);
@@ -1202 +1203 @@
 end;
 
-procedure PaintBackground(Form: TForm; Left, Top, Width, Height: Integer);
-begin
-  Fill(Form.Canvas, Left, Top, Width, Height, (MainTexture.Width - Form.ClientWidth) div
-    2, (MainTexture.Height - Form.ClientHeight) div 2);
+procedure PaintBackground(Canvas: TCanvas; Left, Top, Width, Height, FormWidth,
+  FormHeight: Integer);
+begin
+  Fill(Canvas, Left, Top, Width, Height, (MainTexture.Width - FormWidth) div
+    2, (MainTexture.Height - FormHeight) div 2);
 end;
 

trunk/Settings.lfm

@@ -9 +9 @@
   ClientWidth = 483
   Color = clBtnFace
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
   DesignTimePPI = 144
   FormStyle = fsStayOnTop

trunk/Settings.pas

@@ -203 +203 @@
 procedure TSettingsDlg.FormPaint(Sender: TObject);
 begin
-  PaintBackground(Self, 3, 3, ClientWidth - 6, ClientHeight - 6);
+  PaintBackground(Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6,
+    ClientWidth, ClientHeight);
   Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
   Frame(Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,

trunk/Start.lfm

@@ -23 +23 @@
   OnMouseMove = FormMouseMove
   OnMouseUp = FormMouseUp
-  OnPaint = FormPaint
   OnShow = FormShow
   LCLVersion = '2.0.12.0'

trunk/Start.pas

@@ -6 +6 @@
 uses
   GameServer, Messg, ButtonBase, ButtonA, ButtonC, ButtonB, Area, Types,
-  LCLIntf, LCLType, SysUtils, Classes,
+  LCLIntf, LCLType, SysUtils, Classes, BaseWin,
   Registry, DrawDlg, Generics.Collections, Protocol, MiniMap, Brain, Translator,
   {$IFDEF DPI}System.UITypes, Dpi.Graphics, Dpi.Controls, Dpi.Forms, Dpi.StdCtrls,
@@ -42 +42 @@
   { TStartDlg }
 
-  TStartDlg = class(TDrawDlg)
+  TStartDlg = class(TBufferedDrawDlg)
     PopupMenu1: TPopupMenu;
     StartBtn: TButtonA;
@@ -62 +62 @@
     procedure ListKeyPress(Sender: TObject; var Key: Char);
     procedure StartBtnClick(Sender: TObject);
-    procedure FormPaint(Sender: TObject);
     procedure FormShow(Sender: TObject);
     procedure FormHide(Sender: TObject);
@@ -131 +130 @@
     procedure UnlistBackupFile(FileName: string);
     procedure SmartInvalidate(x0, y0, x1, y1: Integer;
-      invalidateTab0: Boolean = False); overload;
+      InvalidateTab0: Boolean = False); overload;
     procedure LoadConfig;
     procedure SaveConfig;
@@ -138 +137 @@
     procedure UpdateInterface;
     procedure ShowSettings;
+  protected
+    procedure OffscreenPaint; override;
   public
     EmptyPicture: TBitmap;
@@ -338 +339 @@
 var
   I: Integer;
-  r0, r1: HRgn;
-begin
-  r0 := CreateRectRgn(x0, y0, x1, y1);
+  R0, R1: HRgn;
+begin
+  OffscreenUser := nil;
+  R0 := CreateRectRgn(x0, y0, x1, y1);
   for I := 0 to ControlCount - 1 do
     if not (Controls[I] is TArea) and Controls[I].Visible then
     begin
       with Controls[I].BoundsRect do
-        r1 := CreateRectRgn(Left, Top, Right, Bottom);
-      CombineRgn(r0, r0, r1, RGN_DIFF);
-      DeleteObject(r1);
-    end;
-  if not invalidateTab0 then begin
-    r1 := CreateRectRgn(0, 0, 6 + 36, 3 + 38); // tab 0 icon
-    CombineRgn(r0, r0, r1, RGN_DIFF);
-    DeleteObject(r1);
-  end;
-  InvalidateRgn(Handle, r0, False);
-  DeleteObject(r0);
+        R1 := CreateRectRgn(Left, Top, Right, Bottom);
+      CombineRgn(R0, R0, R1, RGN_DIFF);
+      DeleteObject(R1);
+    end;
+  if not InvalidateTab0 then begin
+    R1 := CreateRectRgn(0, 0, 6 + 36, 3 + 38); // tab 0 icon
+    CombineRgn(R0, R0, R1, RGN_DIFF);
+    DeleteObject(R1);
+  end;
+  InvalidateRgn(Handle, R0, False);
+  DeleteObject(R0);
 end;
 
@@ -536 +538 @@
 procedure TStartDlg.DrawAction(Y, IconIndex: Integer; HeaderItem, TextItem: string);
 begin
-  Canvas.Font.Assign(UniFont[ftCaption]);
-  Canvas.Font.Style := Canvas.Font.Style + [TFontStyle.fsUnderline];
-  RisedTextOut(Canvas, xAction, Y - 3, Phrases2.Lookup(HeaderItem));
-  Canvas.Font.Assign(UniFont[ftNormal]);
-  BiColorTextOut(Canvas, Colors.Canvas.Pixels[clkAge0 - 1, cliDimmedText],
-    $000000, xAction, Y + 21, Phrases2.Lookup(TextItem));
-
-  UnshareBitmap(DrawBuffer);
-  DrawBufferEnsureSize(50, 50);
-  BitBltCanvas(DrawBuffer.Canvas, 0, 0, 50, 50, Canvas,
-    xActionIcon - 2, Y - 2);
-  GlowFrame(DrawBuffer, 8, 8, 34, 34, $202020);
-  BitBltCanvas(Canvas, xActionIcon - 2, Y - 2, 50, 50,
-    DrawBuffer.Canvas, 0, 0);
-  BitBltCanvas(Canvas, xActionIcon, Y, 40, 40, BigImp.Canvas,
-    (IconIndex mod 7) * xSizeBig + 8, (IconIndex div 7) * ySizeBig);
-  RFrame(Canvas, xActionIcon - 1, Y - 1, xActionIcon + 40, Y + 40,
-    $000000, $000000);
-end;
-
-procedure TStartDlg.FormPaint(Sender: TObject);
+  with Offscreen do begin
+    Canvas.Font.Assign(UniFont[ftCaption]);
+    Canvas.Font.Style := Canvas.Font.Style + [TFontStyle.fsUnderline];
+    RisedTextOut(Canvas, xAction, Y - 3, Phrases2.Lookup(HeaderItem));
+    Canvas.Font.Assign(UniFont[ftNormal]);
+    BiColorTextOut(Canvas, Colors.Canvas.Pixels[clkAge0 - 1, cliDimmedText],
+      $000000, xAction, Y + 21, Phrases2.Lookup(TextItem));
+
+    UnshareBitmap(DrawBuffer);
+    DrawBufferEnsureSize(50, 50);
+    BitBltCanvas(DrawBuffer.Canvas, 0, 0, 50, 50, Canvas,
+      xActionIcon - 2, Y - 2);
+    GlowFrame(DrawBuffer, 8, 8, 34, 34, $202020);
+    BitBltCanvas(Canvas, xActionIcon - 2, Y - 2, 50, 50,
+      DrawBuffer.Canvas, 0, 0);
+    BitBltCanvas(Canvas, xActionIcon, Y, 40, 40, BigImp.Canvas,
+      (IconIndex mod 7) * xSizeBig + 8, (IconIndex div 7) * ySizeBig);
+    RFrame(Canvas, xActionIcon - 1, Y - 1, xActionIcon + 40, Y + 40,
+      $000000, $000000);
+  end;
+end;
+
+procedure TStartDlg.OffscreenPaint;
 const
   TabNames: array[TStartTab] of Integer = (0, 11, 3, 4);
@@ -565 +569 @@
   MainAction: TMainAction;
 begin
-  PaintBackground(Self, 3, 3, TabOffset + 4 * TabSize - 4, TabHeight - 3);
-  PaintBackground(Self, 3, TabHeight + 3, ClientWidth - 6,
-    ClientHeight - TabHeight - 6);
+  inherited;
+
+  with Offscreen do begin
+  PaintBackground(Canvas, 3, 3, TabOffset + 4 * TabSize - 4, TabHeight - 3,
+    ClientWidth, ClientHeight);
+  PaintBackground(Canvas, 3, TabHeight + 3, ClientWidth - 6,
+    ClientHeight - TabHeight - 6, ClientWidth, ClientHeight);
   with Canvas do
   begin
@@ -626 +634 @@
   if Tab = tbMain then
   begin
-    PaintBackground(Self, 3, TabHeight - 1, TabSize - 4 - 3 + TabOffset + 3, 4);
+    PaintBackground(Canvas, 3, TabHeight - 1, TabSize - 4 - 3 + TabOffset + 3, 4,
+      ClientWidth, ClientHeight);
     Canvas.Pixels[2, TabHeight] := MainTexture.ColorBevelLight;
   end
   else
   begin
-    PaintBackground(Self, TabOffset + 3 + Integer(Tab) * TabSize, TabHeight - 1,
-      TabSize - 4, 4);
+    PaintBackground(Canvas, TabOffset + 3 + Integer(Tab) * TabSize, TabHeight - 1,
+      TabSize - 4, 4, ClientWidth, ClientHeight);
     Canvas.Pixels[TabOffset + Integer(Tab) * TabSize + 2, TabHeight] :=
       MainTexture.ColorBevelLight;
@@ -904 +913 @@
         y0Mini - 8, S);
   end;
+  end;
+  MarkUsedOffscreen(ClientWidth, ClientHeight);
 end;
 
@@ -1438 +1449 @@
     ReplayBtn.Visible := MiniMap.Mode <> mmMultiPlayer;
   List.Invalidate;
-  SmartInvalidate(0, 0, ClientWidth, ClientHeight, invalidateTab0);
+  SmartInvalidate(0, 0, ClientWidth, ClientHeight, InvalidateTab0);
 end;