Changeset 155 for trunk/LocalPlayer


Ignore:
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/LocalPlayer
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/LocalPlayer/BaseWin.pas

    r118 r155  
    99
    1010type
     11
     12  { TBufferedDrawDlg }
     13
    1114  TBufferedDrawDlg = class(TDrawDlg)
    1215  public
    1316    UserLeft, UserTop: integer;
    1417    constructor Create(AOwner: TComponent); override;
     18    destructor Destroy; override;
    1519    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    1620    procedure FormPaint(Sender: TObject);
    … …  
    2731    procedure VPaint; virtual;
    2832  public
     33    UsedOffscreenWidth, UsedOffscreenHeight: integer;
     34    Offscreen: TBitmap;
     35    OffscreenUser: TForm;
    2936    property WindowMode: integer read FWindowMode;
    3037  end;
    … …  
    5562  SideFrame = 9;
    5663
    57 var
    58   UsedOffscreenWidth, UsedOffscreenHeight: integer;
    59   Offscreen: TBitmap;
    60   OffscreenUser: TForm;
    61 
    62 procedure CreateOffscreen;
     64procedure CreateOffscreen(var Offscreen: TBitmap);
    6365
    6466implementation
    … …  
    6769  Term, Help, ButtonBase, Area;
    6870
    69 constructor TBufferedDrawDlg.Create;
    70 begin
     71constructor TBufferedDrawDlg.Create(AOwner: TComponent);
     72begin
     73  BaseWin.CreateOffscreen(Offscreen);
    7174  OnClose := FormClose;
    7275  OnPaint := FormPaint;
    … …  
    8083  UserLeft := (Screen.Width - Width) div 2;
    8184  UserTop := (Screen.Height - Height) div 2;
     85end;
     86
     87destructor TBufferedDrawDlg.Destroy;
     88begin
     89  Offscreen.Free;
     90  inherited Destroy;
    8291end;
    8392
    … …  
    464473end;
    465474
    466 procedure CreateOffscreen;
     475procedure CreateOffscreen(var Offscreen: TBitmap);
    467476begin
    468477  if Offscreen <> nil then
    … …  
    480489initialization
    481490
    482 Offscreen := nil;
    483 OffscreenUser := nil;
    484 
    485491finalization
    486492
    487 Offscreen.Free;
    488 
    489493end.

  • trunk/LocalPlayer/LocalPlayer.pas

    r66 r155  
    2424  begin
    2525    FormsCreated := true;
    26     BaseWin.CreateOffscreen;
    2726    // TODO: Changing application name in runtime will cause change of Linux XML registry file path
    2827//    Application.MainForm := MainScreen;

  • trunk/LocalPlayer/Term.pas

    r152 r155  
    275275    procedure OnEOT(var Msg: TMessage); message WM_EOT;
    276276  public
     277    UsedOffscreenWidth, UsedOffscreenHeight: integer;
     278    Offscreen: TBitmap;
     279    OffscreenUser: TForm;
    277280    procedure CreateParams(var p: TCreateParams); override;
    278281    procedure Client(Command, NewPlayer: integer; var Data);
    … …  
    34053408  i, j: integer;
    34063409begin
     3410  BaseWin.CreateOffscreen(Offscreen);
     3411
    34073412   // define which menu settings to save
    34083413  SaveOption[0] := mAlEffectiveMovesOnly.Tag;
    … …  
    35413546    if AILogo[i] <> nil then
    35423547      FreeAndNil(AILogo[i]);
     3548  FreeAndNil(Offscreen);
    35433549end;
    35443550

  • trunk/LocalPlayer/Wonders.pas

    r72 r155  
    99
    1010type
     11
     12  { TWondersDlg }
     13
    1114  TWondersDlg = class(TBufferedDrawDlg)
    1215    CloseBtn: TButtonB;
    … …  
    1720    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
    1821      Shift: TShiftState; X, Y: Integer);
    19 
     22  private
     23    xm, ym, Selection: Integer;
     24    procedure DarkIcon(i: Integer);
     25    procedure Glow(i, GlowColor: Integer);
     26    procedure PaintBackgroundShape;
    2027  public
    2128    procedure OffscreenPaint; override;
    2229    procedure ShowNewContent(NewMode: Integer);
    23 
    24   private
    25     xm, ym, Selection: Integer;
    2630  end;
    2731
    … …  
    7781end;
    7882
    79 procedure TWondersDlg.OffscreenPaint;
    80 
    81   procedure DarkIcon(i: Integer);
    82   var
    83     X, Y, ch, x0Dst, y0Dst, x0Src, y0Src, darken, c: Integer;
    84     Src, Dst: TPixelPointer;
    85   begin
    86     x0Dst := ClientWidth div 2 - xSizeBig div 2 + RingPosition[i, 0];
    87     y0Dst := ClientHeight div 2 - ySizeBig div 2 + RingPosition[i, 1];
    88     x0Src := (i mod 7) * xSizeBig;
    89     y0Src := (i div 7 + SystemIconLines) * ySizeBig;
    90     Src.Init(BigImp, x0Src, y0Src);
    91     Dst.Init(Offscreen, x0Dst, y0Dst);
    92     for Y := 0 to ySizeBig - 1 do begin
    93       for X := 0 to xSizeBig - 1 do begin
    94         Darken := ((255 - Src.Pixel^.B) * 3 + (255 - Src.Pixel^.G) *
    95           15 + (255 - Src.Pixel^.R) * 9) div 128;
    96         for ch := 0 to 2 do begin
    97           c := Dst.Pixel^.Planes[ch] - Darken;
    98           if c < 0 then Dst.Pixel^.Planes[ch] := 0
    99             else Dst.Pixel^.Planes[ch] := c;
    100         end;
    101         Src.NextPixel;
    102         Dst.NextPixel;
    103       end;
    104       Src.NextLine;
    105       Dst.NextLine;
    106     end;
    107   end;
    108 
    109   procedure Glow(i, GlowColor: Integer);
    110   begin
    111     GlowFrame(Offscreen, ClientWidth div 2 - xSizeBig div 2 + RingPosition[i,
    112       0], ClientHeight div 2 - ySizeBig div 2 + RingPosition[i, 1], xSizeBig,
    113       ySizeBig, GlowColor);
    114   end;
    115 
     83procedure TWondersDlg.PaintBackgroundShape;
    11684const
    11785  darken = 24;
    … …  
    12492  amin3 = 272977; // 1 shl 16*tan(5*pi/12+space);
    12593var
    126   i, X, Y, r, ax, ch, c: Integer;
    127   HaveWonder: boolean;
     94  X: Integer;
     95  Y: Integer;
     96  ax: Integer;
     97  R: Integer;
     98  I: Integer;
     99  C: Integer;
     100  Ch: Integer;
    128101  Line: array [0..1] of TPixelPointer;
    129   s: string;
    130 begin
    131   if (OffscreenUser <> nil) and (OffscreenUser <> self) then
    132     OffscreenUser.Update;
    133   // complete working with old owner to prevent rebound
    134   OffscreenUser := self;
    135 
    136   Fill(Offscreen.Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6,
    137     (wMaintexture - ClientWidth) div 2, (hMaintexture - ClientHeight) div 2);
    138   Frame(Offscreen.Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
    139   Frame(Offscreen.Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,
    140     MainTexture.clBevelLight, MainTexture.clBevelShade);
    141   Frame(Offscreen.Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
    142     MainTexture.clBevelLight, MainTexture.clBevelShade);
    143   Corner(Offscreen.Canvas, 1, 1, 0, MainTexture);
    144   Corner(Offscreen.Canvas, ClientWidth - 9, 1, 1, MainTexture);
    145   Corner(Offscreen.Canvas, 1, ClientHeight - 9, 2, MainTexture);
    146   Corner(Offscreen.Canvas, ClientWidth - 9, ClientHeight - 9, 3, MainTexture);
    147 
    148   BtnFrame(Offscreen.Canvas, CloseBtn.BoundsRect, MainTexture);
    149 
    150   Offscreen.Canvas.Font.Assign(UniFont[ftCaption]);
    151   s := Phrases.Lookup('TITLE_WONDERS');
    152   RisedTextOut(Offscreen.Canvas,
    153     (ClientWidth - BiColorTextWidth(Offscreen.Canvas, s)) div 2 - 1, 7, s);
    154   Offscreen.Canvas.Font.Assign(UniFont[ftNormal]);
    155 
     102begin
    156103  Offscreen.BeginUpdate;
    157   xm := ClientWidth div 2;
    158   ym := ClientHeight div 2;
    159104  Line[0].Init(Offscreen);
    160105  Line[1].Init(Offscreen);
    … …  
    183128  end;
    184129  Offscreen.EndUpdate;
     130end;
     131
     132procedure TWondersDlg.DarkIcon(i: Integer);
     133var
     134  X, Y, ch, x0Dst, y0Dst, x0Src, y0Src, darken, c: Integer;
     135  Src, Dst: TPixelPointer;
     136begin
     137  Offscreen.BeginUpdate;
     138  x0Dst := ClientWidth div 2 - xSizeBig div 2 + RingPosition[i, 0];
     139  y0Dst := ClientHeight div 2 - ySizeBig div 2 + RingPosition[i, 1];
     140  x0Src := (i mod 7) * xSizeBig;
     141  y0Src := (i div 7 + SystemIconLines) * ySizeBig;
     142  Src.Init(BigImp, x0Src, y0Src);
     143  Dst.Init(Offscreen, x0Dst, y0Dst);
     144  for Y := 0 to ySizeBig - 1 do begin
     145    for X := 0 to xSizeBig - 1 do begin
     146      Darken := ((255 - Src.Pixel^.B) * 3 + (255 - Src.Pixel^.G) *
     147        15 + (255 - Src.Pixel^.R) * 9) div 128;
     148      for ch := 0 to 2 do begin
     149        c := Dst.Pixel^.Planes[ch] - Darken;
     150        if c < 0 then Dst.Pixel^.Planes[ch] := 0
     151          else Dst.Pixel^.Planes[ch] := c;
     152      end;
     153      Src.NextPixel;
     154      Dst.NextPixel;
     155    end;
     156    Src.NextLine;
     157    Dst.NextLine;
     158  end;
     159  Offscreen.EndUpdate;
     160end;
     161
     162procedure TWondersDlg.Glow(i, GlowColor: Integer);
     163begin
     164  GlowFrame(Offscreen, ClientWidth div 2 - xSizeBig div 2 + RingPosition[i,
     165    0], ClientHeight div 2 - ySizeBig div 2 + RingPosition[i, 1], xSizeBig,
     166    ySizeBig, GlowColor);
     167end;
     168
     169procedure TWondersDlg.OffscreenPaint;
     170var
     171  i: Integer;
     172  HaveWonder: boolean;
     173  s: string;
     174begin
     175  if (OffscreenUser <> nil) and (OffscreenUser <> self) then
     176    OffscreenUser.Update;
     177  // complete working with old owner to prevent rebound
     178  OffscreenUser := self;
     179
     180  Fill(Offscreen.Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6,
     181    (wMaintexture - ClientWidth) div 2, (hMaintexture - ClientHeight) div 2);
     182  Frame(Offscreen.Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
     183  Frame(Offscreen.Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,
     184    MainTexture.clBevelLight, MainTexture.clBevelShade);
     185  Frame(Offscreen.Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
     186    MainTexture.clBevelLight, MainTexture.clBevelShade);
     187  Corner(Offscreen.Canvas, 1, 1, 0, MainTexture);
     188  Corner(Offscreen.Canvas, ClientWidth - 9, 1, 1, MainTexture);
     189  Corner(Offscreen.Canvas, 1, ClientHeight - 9, 2, MainTexture);
     190  Corner(Offscreen.Canvas, ClientWidth - 9, ClientHeight - 9, 3, MainTexture);
     191
     192  BtnFrame(Offscreen.Canvas, CloseBtn.BoundsRect, MainTexture);
     193
     194  Offscreen.Canvas.Font.Assign(UniFont[ftCaption]);
     195  s := Phrases.Lookup('TITLE_WONDERS');
     196  RisedTextOut(Offscreen.Canvas,
     197    (ClientWidth - BiColorTextWidth(Offscreen.Canvas, s)) div 2 - 1, 7, s);
     198  Offscreen.Canvas.Font.Assign(UniFont[ftNormal]);
     199
     200  xm := ClientWidth div 2;
     201  ym := ClientHeight div 2;
     202
     203  PaintBackgroundShape;
     204
     205  for i := 0 to 20 do
     206    if Imp[i].Preq <> preNA then
     207    begin
     208      case MyRO.Wonder[i].CityID of
     209        - 1: // not built yet
     210          begin
     211            Fill(Offscreen.Canvas, xm - xSizeBig div 2 + RingPosition[i, 0] - 3,
     212              ym - ySizeBig div 2 + RingPosition[i, 1] - 3, xSizeBig + 6,
     213              ySizeBig + 6, (wMaintexture - ClientWidth) div 2,
     214              (hMaintexture - ClientHeight) div 2);
     215            DarkIcon(i);
     216          end;
     217        -2: // destroyed
     218          begin
     219            Glow(i, $000000);
     220          end;
     221      else
     222        begin
     223          if MyRO.Wonder[i].EffectiveOwner >= 0 then
     224            Glow(i, Tribe[MyRO.Wonder[i].EffectiveOwner].Color)
     225          else
     226            Glow(i, $000000);
     227        end
     228      end
     229    end;
    185230
    186231  HaveWonder := false;
    … …  
    200245          begin
    201246            HaveWonder := true;
    202             Glow(i, $000000);
    203247            BitBlt(Offscreen.Canvas.Handle, xm - xSizeBig div 2 + RingPosition
    204248              [i, 0], ym - ySizeBig div 2 + RingPosition[i, 1], xSizeBig,
    … …  
    209253        begin
    210254          HaveWonder := true;
    211           if MyRO.Wonder[i].EffectiveOwner >= 0 then
    212             Glow(i, Tribe[MyRO.Wonder[i].EffectiveOwner].Color)
    213           else
    214             Glow(i, $000000);
    215255          BitBlt(Offscreen.Canvas.Handle, xm - xSizeBig div 2 + RingPosition[i,
    216256            0], ym - ySizeBig div 2 + RingPosition[i, 1], xSizeBig, ySizeBig,
Note: See TracChangeset for help on using the changeset viewer.