Changeset 155

Timestamp:

Nov 10, 2018, 7:47:29 PM (6 years ago)

Author:

chronos

Message:

• Fixed: Wrong drawing of wonders dialog.
• Modified: Use separate offscreen bitmap for each TBufferedDrawDlg dialog.

Location:

trunk

Files:

• Components/ScreenTools.pas (modified) (1 diff)
• LocalPlayer/BaseWin.pas (modified) (7 diffs)
• LocalPlayer/LocalPlayer.pas (modified) (1 diff)
• LocalPlayer/Term.pas (modified) (3 diffs)
• LocalPlayer/Wonders.pas (modified) (7 diffs)

trunk/Components/ScreenTools.pas

@@ -920 +920 @@
 begin
   dst.BeginUpdate;
+  DstPtr.Init(dst, x0, y0);
   for y := -GlowRange + 1 to Height - 1 + GlowRange - 1 do
   begin
     for x := -GlowRange + 1 to Width - 1 + GlowRange - 1 do
     begin
-      DstPtr.Init(dst, x0 + x, y0 + y);
+      DstPtr.SetXY(x, y);
       if x < 0 then
         if y < 0 then

trunk/LocalPlayer/BaseWin.pas

@@ -9 +9 @@
 
 type
+
+  { TBufferedDrawDlg }
+
   TBufferedDrawDlg = class(TDrawDlg)
   public
     UserLeft, UserTop: integer;
     constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
     procedure FormPaint(Sender: TObject);
@@ -27 +31 @@
     procedure VPaint; virtual;
   public
+    UsedOffscreenWidth, UsedOffscreenHeight: integer;
+    Offscreen: TBitmap;
+    OffscreenUser: TForm;
     property WindowMode: integer read FWindowMode;
   end;
@@ -55 +62 @@
   SideFrame = 9;
 
-var
-  UsedOffscreenWidth, UsedOffscreenHeight: integer;
-  Offscreen: TBitmap;
-  OffscreenUser: TForm;
-
-procedure CreateOffscreen;
+procedure CreateOffscreen(var Offscreen: TBitmap);
 
 implementation
@@ -67 +69 @@
   Term, Help, ButtonBase, Area;
 
-constructor TBufferedDrawDlg.Create;
-begin
+constructor TBufferedDrawDlg.Create(AOwner: TComponent);
+begin
+  BaseWin.CreateOffscreen(Offscreen);
   OnClose := FormClose;
   OnPaint := FormPaint;
@@ -80 +83 @@
   UserLeft := (Screen.Width - Width) div 2;
   UserTop := (Screen.Height - Height) div 2;
+end;
+
+destructor TBufferedDrawDlg.Destroy;
+begin
+  Offscreen.Free;
+  inherited Destroy;
 end;
 
@@ -464 +473 @@
 end;
 
-procedure CreateOffscreen;
+procedure CreateOffscreen(var Offscreen: TBitmap);
 begin
   if Offscreen <> nil then
@@ -480 +489 @@
 initialization
 
-Offscreen := nil;
-OffscreenUser := nil;
-
 finalization
 
-Offscreen.Free;
-
 end.

trunk/LocalPlayer/LocalPlayer.pas

@@ -24 +24 @@
   begin
     FormsCreated := true;
-    BaseWin.CreateOffscreen;
     // TODO: Changing application name in runtime will cause change of Linux XML registry file path
 //    Application.MainForm := MainScreen;

trunk/LocalPlayer/Term.pas

@@ -275 +275 @@
     procedure OnEOT(var Msg: TMessage); message WM_EOT;
   public
+    UsedOffscreenWidth, UsedOffscreenHeight: integer;
+    Offscreen: TBitmap;
+    OffscreenUser: TForm;
     procedure CreateParams(var p: TCreateParams); override;
     procedure Client(Command, NewPlayer: integer; var Data);
@@ -3405 +3408 @@
   i, j: integer;
 begin
+  BaseWin.CreateOffscreen(Offscreen);
+
    // define which menu settings to save
   SaveOption[0] := mAlEffectiveMovesOnly.Tag;
@@ -3541 +3546 @@
     if AILogo[i] <> nil then
       FreeAndNil(AILogo[i]);
+  FreeAndNil(Offscreen);
 end;
 

trunk/LocalPlayer/Wonders.pas

@@ -9 +9 @@
 
 type
+
+  { TWondersDlg }
+
   TWondersDlg = class(TBufferedDrawDlg)
     CloseBtn: TButtonB;
@@ -17 +20 @@
     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
-
+  private
+    xm, ym, Selection: Integer;
+    procedure DarkIcon(i: Integer);
+    procedure Glow(i, GlowColor: Integer);
+    procedure PaintBackgroundShape;
   public
     procedure OffscreenPaint; override;
     procedure ShowNewContent(NewMode: Integer);
-
-  private
-    xm, ym, Selection: Integer;
   end;
 
@@ -77 +81 @@
 end;
 
-procedure TWondersDlg.OffscreenPaint;
-
-  procedure DarkIcon(i: Integer);
-  var
-    X, Y, ch, x0Dst, y0Dst, x0Src, y0Src, darken, c: Integer;
-    Src, Dst: TPixelPointer;
-  begin
-    x0Dst := ClientWidth div 2 - xSizeBig div 2 + RingPosition[i, 0];
-    y0Dst := ClientHeight div 2 - ySizeBig div 2 + RingPosition[i, 1];
-    x0Src := (i mod 7) * xSizeBig;
-    y0Src := (i div 7 + SystemIconLines) * ySizeBig;
-    Src.Init(BigImp, x0Src, y0Src);
-    Dst.Init(Offscreen, x0Dst, y0Dst);
-    for Y := 0 to ySizeBig - 1 do begin
-      for X := 0 to xSizeBig - 1 do begin
-        Darken := ((255 - Src.Pixel^.B) * 3 + (255 - Src.Pixel^.G) *
-          15 + (255 - Src.Pixel^.R) * 9) div 128;
-        for ch := 0 to 2 do begin
-          c := Dst.Pixel^.Planes[ch] - Darken;
-          if c < 0 then Dst.Pixel^.Planes[ch] := 0
-            else Dst.Pixel^.Planes[ch] := c;
-        end;
-        Src.NextPixel;
-        Dst.NextPixel;
-      end;
-      Src.NextLine;
-      Dst.NextLine;
-    end;
-  end;
-
-  procedure Glow(i, GlowColor: Integer);
-  begin
-    GlowFrame(Offscreen, ClientWidth div 2 - xSizeBig div 2 + RingPosition[i,
-      0], ClientHeight div 2 - ySizeBig div 2 + RingPosition[i, 1], xSizeBig,
-      ySizeBig, GlowColor);
-  end;
-
+procedure TWondersDlg.PaintBackgroundShape;
 const
   darken = 24;
@@ -124 +92 @@
   amin3 = 272977; // 1 shl 16*tan(5*pi/12+space);
 var
-  i, X, Y, r, ax, ch, c: Integer;
-  HaveWonder: boolean;
+  X: Integer;
+  Y: Integer;
+  ax: Integer;
+  R: Integer;
+  I: Integer;
+  C: Integer;
+  Ch: Integer;
   Line: array [0..1] of TPixelPointer;
-  s: string;
-begin
-  if (OffscreenUser <> nil) and (OffscreenUser <> self) then
-    OffscreenUser.Update;
-  // complete working with old owner to prevent rebound
-  OffscreenUser := self;
-
-  Fill(Offscreen.Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6,
-    (wMaintexture - ClientWidth) div 2, (hMaintexture - ClientHeight) div 2);
-  Frame(Offscreen.Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
-  Frame(Offscreen.Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,
-    MainTexture.clBevelLight, MainTexture.clBevelShade);
-  Frame(Offscreen.Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
-    MainTexture.clBevelLight, MainTexture.clBevelShade);
-  Corner(Offscreen.Canvas, 1, 1, 0, MainTexture);
-  Corner(Offscreen.Canvas, ClientWidth - 9, 1, 1, MainTexture);
-  Corner(Offscreen.Canvas, 1, ClientHeight - 9, 2, MainTexture);
-  Corner(Offscreen.Canvas, ClientWidth - 9, ClientHeight - 9, 3, MainTexture);
-
-  BtnFrame(Offscreen.Canvas, CloseBtn.BoundsRect, MainTexture);
-
-  Offscreen.Canvas.Font.Assign(UniFont[ftCaption]);
-  s := Phrases.Lookup('TITLE_WONDERS');
-  RisedTextOut(Offscreen.Canvas,
-    (ClientWidth - BiColorTextWidth(Offscreen.Canvas, s)) div 2 - 1, 7, s);
-  Offscreen.Canvas.Font.Assign(UniFont[ftNormal]);
-
+begin
   Offscreen.BeginUpdate;
-  xm := ClientWidth div 2;
-  ym := ClientHeight div 2;
   Line[0].Init(Offscreen);
   Line[1].Init(Offscreen);
@@ -183 +128 @@
   end;
   Offscreen.EndUpdate;
+end;
+
+procedure TWondersDlg.DarkIcon(i: Integer);
+var
+  X, Y, ch, x0Dst, y0Dst, x0Src, y0Src, darken, c: Integer;
+  Src, Dst: TPixelPointer;
+begin
+  Offscreen.BeginUpdate;
+  x0Dst := ClientWidth div 2 - xSizeBig div 2 + RingPosition[i, 0];
+  y0Dst := ClientHeight div 2 - ySizeBig div 2 + RingPosition[i, 1];
+  x0Src := (i mod 7) * xSizeBig;
+  y0Src := (i div 7 + SystemIconLines) * ySizeBig;
+  Src.Init(BigImp, x0Src, y0Src);
+  Dst.Init(Offscreen, x0Dst, y0Dst);
+  for Y := 0 to ySizeBig - 1 do begin
+    for X := 0 to xSizeBig - 1 do begin
+      Darken := ((255 - Src.Pixel^.B) * 3 + (255 - Src.Pixel^.G) *
+        15 + (255 - Src.Pixel^.R) * 9) div 128;
+      for ch := 0 to 2 do begin
+        c := Dst.Pixel^.Planes[ch] - Darken;
+        if c < 0 then Dst.Pixel^.Planes[ch] := 0
+          else Dst.Pixel^.Planes[ch] := c;
+      end;
+      Src.NextPixel;
+      Dst.NextPixel;
+    end;
+    Src.NextLine;
+    Dst.NextLine;
+  end;
+  Offscreen.EndUpdate;
+end;
+
+procedure TWondersDlg.Glow(i, GlowColor: Integer);
+begin
+  GlowFrame(Offscreen, ClientWidth div 2 - xSizeBig div 2 + RingPosition[i,
+    0], ClientHeight div 2 - ySizeBig div 2 + RingPosition[i, 1], xSizeBig,
+    ySizeBig, GlowColor);
+end;
+
+procedure TWondersDlg.OffscreenPaint;
+var
+  i: Integer;
+  HaveWonder: boolean;
+  s: string;
+begin
+  if (OffscreenUser <> nil) and (OffscreenUser <> self) then
+    OffscreenUser.Update;
+  // complete working with old owner to prevent rebound
+  OffscreenUser := self;
+
+  Fill(Offscreen.Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6,
+    (wMaintexture - ClientWidth) div 2, (hMaintexture - ClientHeight) div 2);
+  Frame(Offscreen.Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
+  Frame(Offscreen.Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,
+    MainTexture.clBevelLight, MainTexture.clBevelShade);
+  Frame(Offscreen.Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
+    MainTexture.clBevelLight, MainTexture.clBevelShade);
+  Corner(Offscreen.Canvas, 1, 1, 0, MainTexture);
+  Corner(Offscreen.Canvas, ClientWidth - 9, 1, 1, MainTexture);
+  Corner(Offscreen.Canvas, 1, ClientHeight - 9, 2, MainTexture);
+  Corner(Offscreen.Canvas, ClientWidth - 9, ClientHeight - 9, 3, MainTexture);
+
+  BtnFrame(Offscreen.Canvas, CloseBtn.BoundsRect, MainTexture);
+
+  Offscreen.Canvas.Font.Assign(UniFont[ftCaption]);
+  s := Phrases.Lookup('TITLE_WONDERS');
+  RisedTextOut(Offscreen.Canvas,
+    (ClientWidth - BiColorTextWidth(Offscreen.Canvas, s)) div 2 - 1, 7, s);
+  Offscreen.Canvas.Font.Assign(UniFont[ftNormal]);
+
+  xm := ClientWidth div 2;
+  ym := ClientHeight div 2;
+
+  PaintBackgroundShape;
+
+  for i := 0 to 20 do
+    if Imp[i].Preq <> preNA then
+    begin
+      case MyRO.Wonder[i].CityID of
+        - 1: // not built yet
+          begin
+            Fill(Offscreen.Canvas, xm - xSizeBig div 2 + RingPosition[i, 0] - 3,
+              ym - ySizeBig div 2 + RingPosition[i, 1] - 3, xSizeBig + 6,
+              ySizeBig + 6, (wMaintexture - ClientWidth) div 2,
+              (hMaintexture - ClientHeight) div 2);
+            DarkIcon(i);
+          end;
+        -2: // destroyed
+          begin
+            Glow(i, $000000);
+          end;
+      else
+        begin
+          if MyRO.Wonder[i].EffectiveOwner >= 0 then
+            Glow(i, Tribe[MyRO.Wonder[i].EffectiveOwner].Color)
+          else
+            Glow(i, $000000);
+        end
+      end
+    end;
 
   HaveWonder := false;
@@ -200 +245 @@
           begin
             HaveWonder := true;
-            Glow(i, $000000);
             BitBlt(Offscreen.Canvas.Handle, xm - xSizeBig div 2 + RingPosition
               [i, 0], ym - ySizeBig div 2 + RingPosition[i, 1], xSizeBig,
@@ -209 +253 @@
         begin
           HaveWonder := true;
-          if MyRO.Wonder[i].EffectiveOwner >= 0 then
-            Glow(i, Tribe[MyRO.Wonder[i].EffectiveOwner].Color)
-          else
-            Glow(i, $000000);
           BitBlt(Offscreen.Canvas.Handle, xm - xSizeBig div 2 + RingPosition[i,
             0], ym - ySizeBig div 2 + RingPosition[i, 1], xSizeBig, ySizeBig,