Changeset 565 for trunk


Ignore:
Timestamp:
May 1, 2024, 12:08:20 PM (7 months 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:
11 edited

Legend:

Unmodified
Added
Removed

  • trunk/Direct.pas

    r544 r565  
    278278procedure TDirectDlg.FormPaint(Sender: TObject);
    279279begin
    280   PaintBackground(Self, 3, 3, ClientWidth - 6, ClientHeight - 6);
     280  PaintBackground(Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6,
     281    ClientWidth, ClientHeight);
    281282  Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
    282283  Frame(Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,

  • trunk/Inp.pas

    r474 r565  
    4444procedure TInputDlg.FormPaint(Sender: TObject);
    4545begin
    46   PaintBackground(Self, 3, 3, Width - 6, Height - 6);
     46  PaintBackground(Canvas, 3, 3, Width - 6, Height - 6, Width, Height);
    4747  Frame(Canvas, 0, 0, Width - 1, Height - 1, 0, 0);
    4848  Frame(Canvas, 1, 1, Width - 2, Height - 2,

  • trunk/LocalPlayer/Battle.pas

    r548 r565  
    229229    FillRect(Rect(0, 0, ClientWidth, ClientHeight));
    230230    Brush.Style := TBrushStyle.bsClear;
    231     PaintBackground(Self, 3 + Border, 3 + Border,
    232       ClientWidth - (6 + 2 * Border), ClientHeight - (6 + 2 * Border));
     231    PaintBackground(Canvas, 3 + Border, 3 + Border,
     232      ClientWidth - (6 + 2 * Border), ClientHeight - (6 + 2 * Border),
     233      ClientWidth, ClientHeight);
    233234  end;
    234235  Frame(Canvas, Border + 1, Border + 1, ClientWidth - (2 + Border),

  • trunk/LocalPlayer/Rates.pas

    r531 r565  
    2121    procedure FormCreate(Sender: TObject);
    2222    procedure TaxLuxBtnClick(Sender: TObject);
     23  protected
     24    procedure OffscreenPaint; override;
    2325  public
    24     procedure OffscreenPaint; override;
    2526    procedure ShowNewContent(NewMode: TWindowMode);
    2627  end;
    … …  
    4849  S, s1: string;
    4950begin
    50   if (OffscreenUser <> nil) and (OffscreenUser <> Self) then
    51     OffscreenUser.Update;
    52   // complete working with old owner to prevent rebound
    53   OffscreenUser := Self;
     51  inherited;
    5452
    5553  Fill(Offscreen.Canvas, 0, 0, ClientWidth, ClientHeight,

  • trunk/LocalPlayer/Wonders.pas

    r548 r565  
    2727    procedure Glow(I, GlowColor: Integer);
    2828    procedure PaintBackgroundShape;
     29  protected
     30    procedure OffscreenPaint; override;
    2931  public
    30     procedure OffscreenPaint; override;
    3132    procedure ShowNewContent(NewMode: TWindowMode);
    3233  end;
    … …  
    193194  S: string;
    194195begin
    195   if (OffscreenUser <> nil) and (OffscreenUser <> Self) then
    196     OffscreenUser.Update;
    197   // complete working with old owner to prevent rebound
    198   OffscreenUser := Self;
     196  inherited;
    199197
    200198  Fill(Offscreen.Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6,

  • trunk/Packages/CevoComponents/DrawDlg.pas

    r554 r565  
    2121    procedure DoDeactivate(Sender: TObject);
    2222  protected
     23    // Defines area to grip the window for moving (from top)
    2324    TitleHeight: Integer;
    24     // defines area to grip the window for moving (from top)
    2525    procedure InitButtons;
    2626    procedure OnEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;
    … …  
    237237procedure TDrawDlg.SmartInvalidate;
    238238var
    239   i: Integer;
    240   r0, r1: HRgn;
    241 begin
    242   r0 := CreateRectRgn(0, 0, Width, Height);
    243   for i := 0 to ControlCount - 1 do
    244     if not (Controls[i] is TArea) and Controls[i].Visible then
    245     begin
    246       with Controls[i].BoundsRect do
    247         r1 := CreateRectRgn(Left, Top, Right, Bottom);
    248       CombineRgn(r0, r0, r1, RGN_DIFF);
    249       DeleteObject(r1);
    250     end;
    251   InvalidateRgn(Handle, r0, False);
    252   DeleteObject(r0);
     239  I: Integer;
     240  R0, R1: HRgn;
     241begin
     242  R0 := CreateRectRgn(0, 0, Width, Height);
     243  for I := 0 to ControlCount - 1 do
     244    if not (Controls[I] is TArea) and Controls[I].Visible then begin
     245      with Controls[I].BoundsRect do
     246        R1 := CreateRectRgn(Left, Top, Right, Bottom);
     247      CombineRgn(R0, R0, R1, RGN_DIFF);
     248      DeleteObject(R1);
     249    end;
     250  InvalidateRgn(Handle, R0, False);
     251  DeleteObject(R0);
    253252end;
    254253
    … …  
    272271begin
    273272  if csDesigning in ComponentState then Exit;
    274   PaintBackground(Self, 3 + Border, 3 + Border, Width - (6 + 2 * Border),
    275     Height - (6 + 2 * Border));
     273  PaintBackground(Canvas, 3 + Border, 3 + Border, Width - (6 + 2 * Border),
     274    Height - (6 + 2 * Border), Width, Height);
    276275  for I := 0 to Border do
    277     Frame(Canvas, I, I, Width - 1 - I, Height - 1 - I,
    278       $000000, $000000);
     276    Frame(Canvas, I, I, Width - 1 - I, Height - 1 - I, $000000, $000000);
    279277  Frame(Canvas, Border + 1, Border + 1, Width - (2 + Border),
    280278    Height - (2 + Border), MainTexture.ColorBevelLight,

  • trunk/Packages/CevoComponents/ScreenTools.pas

    r548 r565  
    7575procedure FillRectSeamless(Canvas: TCanvas; x0, y0, x1, y1, xOffset, yOffset: Integer;
    7676  const Texture: TBitmap);
    77 procedure PaintBackground(Form: TForm; Left, Top, Width, Height: Integer);
     77procedure PaintBackground(Canvas: TCanvas; Left, Top, Width, Height, FormWidth,
     78  FormHeight: Integer);
    7879procedure Corner(Canvas: TCanvas; X, Y, Kind: Integer; T: TTexture);
    7980procedure BiColorTextOut(Canvas: TCanvas; clMain, clBack: TColor; X, Y: Integer; S: string);
    … …  
    12021203end;
    12031204
    1204 procedure PaintBackground(Form: TForm; Left, Top, Width, Height: Integer);
    1205 begin
    1206   Fill(Form.Canvas, Left, Top, Width, Height, (MainTexture.Width - Form.ClientWidth) div
    1207     2, (MainTexture.Height - Form.ClientHeight) div 2);
     1205procedure PaintBackground(Canvas: TCanvas; Left, Top, Width, Height, FormWidth,
     1206  FormHeight: Integer);
     1207begin
     1208  Fill(Canvas, Left, Top, Width, Height, (MainTexture.Width - FormWidth) div
     1209    2, (MainTexture.Height - FormHeight) div 2);
    12081210end;
    12091211

  • trunk/Settings.lfm

    r473 r565  
    99  ClientWidth = 483
    1010  Color = clBtnFace
     11  Font.Color = clWindowText
     12  Font.Height = -11
     13  Font.Name = 'MS Sans Serif'
    1114  DesignTimePPI = 144
    1215  FormStyle = fsStayOnTop

  • trunk/Settings.pas

    r524 r565  
    203203procedure TSettingsDlg.FormPaint(Sender: TObject);
    204204begin
    205   PaintBackground(Self, 3, 3, ClientWidth - 6, ClientHeight - 6);
     205  PaintBackground(Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6,
     206    ClientWidth, ClientHeight);
    206207  Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
    207208  Frame(Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,

  • trunk/Start.lfm

    r426 r565  
    2323  OnMouseMove = FormMouseMove
    2424  OnMouseUp = FormMouseUp
    25   OnPaint = FormPaint
    2625  OnShow = FormShow
    2726  LCLVersion = '2.0.12.0'

  • trunk/Start.pas

    r554 r565  
    66uses
    77  GameServer, Messg, ButtonBase, ButtonA, ButtonC, ButtonB, Area, Types,
    8   LCLIntf, LCLType, SysUtils, Classes,
     8  LCLIntf, LCLType, SysUtils, Classes, BaseWin,
    99  Registry, DrawDlg, Generics.Collections, Protocol, MiniMap, Brain, Translator,
    1010  {$IFDEF DPI}System.UITypes, Dpi.Graphics, Dpi.Controls, Dpi.Forms, Dpi.StdCtrls,
    … …  
    4242  { TStartDlg }
    4343
    44   TStartDlg = class(TDrawDlg)
     44  TStartDlg = class(TBufferedDrawDlg)
    4545    PopupMenu1: TPopupMenu;
    4646    StartBtn: TButtonA;
    … …  
    6262    procedure ListKeyPress(Sender: TObject; var Key: Char);
    6363    procedure StartBtnClick(Sender: TObject);
    64     procedure FormPaint(Sender: TObject);
    6564    procedure FormShow(Sender: TObject);
    6665    procedure FormHide(Sender: TObject);
    … …  
    131130    procedure UnlistBackupFile(FileName: string);
    132131    procedure SmartInvalidate(x0, y0, x1, y1: Integer;
    133       invalidateTab0: Boolean = False); overload;
     132      InvalidateTab0: Boolean = False); overload;
    134133    procedure LoadConfig;
    135134    procedure SaveConfig;
    … …  
    138137    procedure UpdateInterface;
    139138    procedure ShowSettings;
     139  protected
     140    procedure OffscreenPaint; override;
    140141  public
    141142    EmptyPicture: TBitmap;
    … …  
    338339var
    339340  I: Integer;
    340   r0, r1: HRgn;
    341 begin
    342   r0 := CreateRectRgn(x0, y0, x1, y1);
     341  R0, R1: HRgn;
     342begin
     343  OffscreenUser := nil;
     344  R0 := CreateRectRgn(x0, y0, x1, y1);
    343345  for I := 0 to ControlCount - 1 do
    344346    if not (Controls[I] is TArea) and Controls[I].Visible then
    345347    begin
    346348      with Controls[I].BoundsRect do
    347         r1 := CreateRectRgn(Left, Top, Right, Bottom);
    348       CombineRgn(r0, r0, r1, RGN_DIFF);
    349       DeleteObject(r1);
    350     end;
    351   if not invalidateTab0 then begin
    352     r1 := CreateRectRgn(0, 0, 6 + 36, 3 + 38); // tab 0 icon
    353     CombineRgn(r0, r0, r1, RGN_DIFF);
    354     DeleteObject(r1);
    355   end;
    356   InvalidateRgn(Handle, r0, False);
    357   DeleteObject(r0);
     349        R1 := CreateRectRgn(Left, Top, Right, Bottom);
     350      CombineRgn(R0, R0, R1, RGN_DIFF);
     351      DeleteObject(R1);
     352    end;
     353  if not InvalidateTab0 then begin
     354    R1 := CreateRectRgn(0, 0, 6 + 36, 3 + 38); // tab 0 icon
     355    CombineRgn(R0, R0, R1, RGN_DIFF);
     356    DeleteObject(R1);
     357  end;
     358  InvalidateRgn(Handle, R0, False);
     359  DeleteObject(R0);
    358360end;
    359361
    … …  
    536538procedure TStartDlg.DrawAction(Y, IconIndex: Integer; HeaderItem, TextItem: string);
    537539begin
    538   Canvas.Font.Assign(UniFont[ftCaption]);
    539   Canvas.Font.Style := Canvas.Font.Style + [TFontStyle.fsUnderline];
    540   RisedTextOut(Canvas, xAction, Y - 3, Phrases2.Lookup(HeaderItem));
    541   Canvas.Font.Assign(UniFont[ftNormal]);
    542   BiColorTextOut(Canvas, Colors.Canvas.Pixels[clkAge0 - 1, cliDimmedText],
    543     $000000, xAction, Y + 21, Phrases2.Lookup(TextItem));
    544 
    545   UnshareBitmap(DrawBuffer);
    546   DrawBufferEnsureSize(50, 50);
    547   BitBltCanvas(DrawBuffer.Canvas, 0, 0, 50, 50, Canvas,
    548     xActionIcon - 2, Y - 2);
    549   GlowFrame(DrawBuffer, 8, 8, 34, 34, $202020);
    550   BitBltCanvas(Canvas, xActionIcon - 2, Y - 2, 50, 50,
    551     DrawBuffer.Canvas, 0, 0);
    552   BitBltCanvas(Canvas, xActionIcon, Y, 40, 40, BigImp.Canvas,
    553     (IconIndex mod 7) * xSizeBig + 8, (IconIndex div 7) * ySizeBig);
    554   RFrame(Canvas, xActionIcon - 1, Y - 1, xActionIcon + 40, Y + 40,
    555     $000000, $000000);
    556 end;
    557 
    558 procedure TStartDlg.FormPaint(Sender: TObject);
     540  with Offscreen do begin
     541    Canvas.Font.Assign(UniFont[ftCaption]);
     542    Canvas.Font.Style := Canvas.Font.Style + [TFontStyle.fsUnderline];
     543    RisedTextOut(Canvas, xAction, Y - 3, Phrases2.Lookup(HeaderItem));
     544    Canvas.Font.Assign(UniFont[ftNormal]);
     545    BiColorTextOut(Canvas, Colors.Canvas.Pixels[clkAge0 - 1, cliDimmedText],
     546      $000000, xAction, Y + 21, Phrases2.Lookup(TextItem));
     547
     548    UnshareBitmap(DrawBuffer);
     549    DrawBufferEnsureSize(50, 50);
     550    BitBltCanvas(DrawBuffer.Canvas, 0, 0, 50, 50, Canvas,
     551      xActionIcon - 2, Y - 2);
     552    GlowFrame(DrawBuffer, 8, 8, 34, 34, $202020);
     553    BitBltCanvas(Canvas, xActionIcon - 2, Y - 2, 50, 50,
     554      DrawBuffer.Canvas, 0, 0);
     555    BitBltCanvas(Canvas, xActionIcon, Y, 40, 40, BigImp.Canvas,
     556      (IconIndex mod 7) * xSizeBig + 8, (IconIndex div 7) * ySizeBig);
     557    RFrame(Canvas, xActionIcon - 1, Y - 1, xActionIcon + 40, Y + 40,
     558      $000000, $000000);
     559  end;
     560end;
     561
     562procedure TStartDlg.OffscreenPaint;
    559563const
    560564  TabNames: array[TStartTab] of Integer = (0, 11, 3, 4);
    … …  
    565569  MainAction: TMainAction;
    566570begin
    567   PaintBackground(Self, 3, 3, TabOffset + 4 * TabSize - 4, TabHeight - 3);
    568   PaintBackground(Self, 3, TabHeight + 3, ClientWidth - 6,
    569     ClientHeight - TabHeight - 6);
     571  inherited;
     572
     573  with Offscreen do begin
     574  PaintBackground(Canvas, 3, 3, TabOffset + 4 * TabSize - 4, TabHeight - 3,
     575    ClientWidth, ClientHeight);
     576  PaintBackground(Canvas, 3, TabHeight + 3, ClientWidth - 6,
     577    ClientHeight - TabHeight - 6, ClientWidth, ClientHeight);
    570578  with Canvas do
    571579  begin
    … …  
    626634  if Tab = tbMain then
    627635  begin
    628     PaintBackground(Self, 3, TabHeight - 1, TabSize - 4 - 3 + TabOffset + 3, 4);
     636    PaintBackground(Canvas, 3, TabHeight - 1, TabSize - 4 - 3 + TabOffset + 3, 4,
     637      ClientWidth, ClientHeight);
    629638    Canvas.Pixels[2, TabHeight] := MainTexture.ColorBevelLight;
    630639  end
    631640  else
    632641  begin
    633     PaintBackground(Self, TabOffset + 3 + Integer(Tab) * TabSize, TabHeight - 1,
    634       TabSize - 4, 4);
     642    PaintBackground(Canvas, TabOffset + 3 + Integer(Tab) * TabSize, TabHeight - 1,
     643      TabSize - 4, 4, ClientWidth, ClientHeight);
    635644    Canvas.Pixels[TabOffset + Integer(Tab) * TabSize + 2, TabHeight] :=
    636645      MainTexture.ColorBevelLight;
    … …  
    904913        y0Mini - 8, S);
    905914  end;
     915  end;
     916  MarkUsedOffscreen(ClientWidth, ClientHeight);
    906917end;
    907918
    … …  
    14381449    ReplayBtn.Visible := MiniMap.Mode <> mmMultiPlayer;
    14391450  List.Invalidate;
    1440   SmartInvalidate(0, 0, ClientWidth, ClientHeight, invalidateTab0);
     1451  SmartInvalidate(0, 0, ClientWidth, ClientHeight, InvalidateTab0);
    14411452end;
    14421453
Note: See TracChangeset for help on using the changeset viewer.