Changeset 252


Ignore:
Timestamp:
May 23, 2020, 12:45:14 AM (4 years ago)
Author:
chronos
Message:
  • Fixed: Scrolling under HighDPI. ScrollDC needs to be scaled as well.
Location:
branches/highdpi
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • branches/highdpi/Direct.pas

    r210 r252  
    3030    procedure SetInfo(x: string);
    3131    procedure SetState(x: integer);
    32     procedure OnGo(var m: TMessage); message WM_GO;
    33     procedure OnChangeClient(var m: TMessage); message WM_CHANGECLIENT;
    34     procedure OnNextPlayer(var m: TMessage); message WM_NEXTPLAYER;
     32    procedure OnGo(var Msg: TMessage); message WM_GO;
     33    procedure OnChangeClient(var Msg: TMessage); message WM_CHANGECLIENT;
     34    procedure OnNextPlayer(var Msg: TMessage); message WM_NEXTPLAYER;
    3535    procedure OnAIException(var Msg: TMessage); message WM_AIEXCEPTION;
    3636  end;
     
    208208end;
    209209
    210 procedure TDirectDlg.OnGo(var m: TMessage);
     210procedure TDirectDlg.OnGo(var Msg: TMessage);
    211211var
    212212  i: integer;
     
    234234        Quick := true;
    235235        DirectHelp(cHelpOnly);
    236         Close
     236        Close;
    237237      end;
    238238    end
     
    254254end;
    255255
    256 procedure TDirectDlg.OnChangeClient(var m: TMessage);
     256procedure TDirectDlg.OnChangeClient(var Msg: TMessage);
    257257begin
    258258  ChangeClient;
    259259end;
    260260
    261 procedure TDirectDlg.OnNextPlayer(var m: TMessage);
     261procedure TDirectDlg.OnNextPlayer(var Msg: TMessage);
    262262begin
    263263  NextPlayer;
  • branches/highdpi/LocalPlayer/Help.pas

    r247 r252  
    110110    procedure WaterSign(x0, y0, iix: Integer);
    111111    procedure Search(SearchString: string);
    112     procedure OnScroll(var m: TMessage); message WM_VSCROLL;
     112    procedure OnScroll(var Msg: TMessage); message WM_VSCROLL;
    113113    procedure OnMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    114114  public
     
    342342end;
    343343
    344 procedure THelpDlg.OnScroll(var m: TMessage);
     344procedure THelpDlg.OnScroll(var Msg: TMessage);
    345345begin
    346346  { TODO: Handled by MouseWheel event
    347   if ScrollBar.Process(m) then begin
     347  if ScrollBar.Process(Msg) then begin
    348348    Sel := -1;
    349349    SmartUpdateContent(true)
     
    357357    Line(Canvas, Sel, false);
    358358    Sel := -1
    359   end
     359  end;
    360360end;
    361361
  • branches/highdpi/LocalPlayer/Select.pas

    r246 r252  
    5959    function RenameCity(cix: integer): boolean;
    6060    function RenameModel(mix: integer): boolean;
    61     procedure OnScroll(var m: TMessage); message WM_VSCROLL;
     61    procedure OnScroll(var Msg: TMessage); message WM_VSCROLL;
    6262    procedure OnMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    6363  public
     
    133133end;
    134134
    135 procedure TListDlg.OnScroll(var m: TMessage);
     135procedure TListDlg.OnScroll(var Msg: TMessage);
    136136begin
    137137  { TODO: Handled by MouseWheel event
    138   if sb.Process(m) then  begin
     138  if sb.Process(Msg) then  begin
    139139    Sel := -2;
    140140    SmartUpdateContent(true);
  • branches/highdpi/LocalPlayer/Term.pas

    r251 r252  
    280280    procedure LoadSettings;
    281281    procedure SaveSettings;
    282     procedure OnScroll(var m: TMessage); message WM_VSCROLL;
     282    procedure OnScroll(var Msg: TMessage); message WM_VSCROLL;
    283283    procedure OnEOT(var Msg: TMessage); message WM_EOT;
    284284    procedure SoundPreload(Check: integer);
     
    36203620end;
    36213621
    3622 procedure TMainScreen.OnScroll(var m: TMessage);
    3623 begin
    3624   if sb.Process(m) then begin
     3622procedure TMainScreen.OnScroll(var Msg: TMessage);
     3623begin
     3624  if sb.Process(Msg) then begin
    36253625    PanelPaint;
    36263626    Update;
     
    36303630procedure TMainScreen.OnEOT(var Msg: TMessage);
    36313631begin
    3632   EndTurn
     3632  EndTurn;
    36333633end;
    36343634
     
    36383638  begin
    36393639    MessgExDlg.CancelMovie;
    3640     Server(sBreak, me, 0, nil^)
     3640    Server(sBreak, me, 0, nil^);
    36413641  end
    36423642  else if ClientMode < 0 then
     
    36473647  begin
    36483648    Jump[pTurn] := 0;
    3649     StartRunning := false
     3649    StartRunning := false;
    36503650  end
    36513651  else
    3652     EndTurn
     3652    EndTurn;
    36533653end;
    36543654
     
    41444144end;
    41454145
    4146 {$IFDEF LINUX}
    4147 // Can't do scrolling of DC under Linux, then fallback into BitBlt.
    4148 function ScrollDC(Canvas: TDpiCanvas; dx: longint; dy: longint; const lprcScroll:TRect; const lprcClip:TRect; hrgnUpdate:HRGN; lprcUpdate: PRect):Boolean;
    4149 begin
    4150   Result := DpiBitCanvas(Canvas, lprcScroll.Left + dx, lprcScroll.Top + dy, lprcScroll.Right - lprcScroll.Left, lprcScroll.Bottom - lprcScroll.Top,
    4151     Canvas, lprcScroll.Left, lprcScroll.Top);
    4152 end;
    4153 {$ENDIF}
    4154 
    41554146procedure TMainScreen.MainOffscreenPaint;
    41564147var
     
    41994190    offscreen.Canvas.Font.Assign(UniFont[ftSmall]);
    42004191    rec := Rect(0, 0, MapWidth, MapHeight);
    4201 {$IFDEF WINDOWS}
    4202     ScrollDC(offscreen.Canvas.Handle, (xwd - xw) * (xxt * 2), (ywd - yw) * yyt,
     4192    DpiScrollDC(offscreen.Canvas.Handle, (xwd - xw) * (xxt * 2), (ywd - yw) * yyt,
    42034193      rec, rec, 0, nil);
    4204 {$ENDIF}
    4205 {$IFDEF LINUX}
    4206     ScrollDC(offscreen.Canvas, (xwd - xw) * (xxt * 2), (ywd - yw) * yyt,
    4207       rec, rec, 0, nil);
    4208 {$ENDIF}
    42094194    for DoInvalidate := false to FastScrolling do
    42104195    begin
     
    42124197      begin
    42134198        rec.Bottom := MapHeight - overlap;
    4214 {$IFDEF WINDOWS}
    4215         ScrollDC(Canvas.Handle, (xwd - xw) * (xxt * 2), (ywd - yw) * yyt, rec,
     4199        DpiScrollDC(Canvas.Handle, (xwd - xw) * (xxt * 2), (ywd - yw) * yyt, rec,
    42164200          rec, 0, nil);
    4217 {$ENDIF}
    4218 {$IFDEF LINUX}
    4219         ScrollDC(Canvas, (xwd - xw) * (xxt * 2), (ywd - yw) * yyt,
    4220           rec, rec, 0, nil);
    4221 {$ENDIF}
    42224201        ProcessOptions := prInvalidate;
    42234202      end
     
    50745053          if DpiMouse.CursorPos.x = 0 then
    50755054            dx := -speed // scroll left
    5076           else if DpiMouse.CursorPos.x = DpiScreen.width - 1 then
     5055          else if DpiMouse.CursorPos.x >= DpiScreen.width - 1 then
    50775056            dx := speed; // scroll right
    50785057        if DpiMouse.CursorPos.y = 0 then
    50795058          dy := -speed // scroll up
    5080         else if (DpiMouse.CursorPos.y = DpiScreen.height - 1) and
     5059        else if (DpiMouse.CursorPos.y >= DpiScreen.height - 1) and
    50815060          (DpiMouse.CursorPos.x >= TerrainBtn.Left + TerrainBtn.width) and
    50825061          (DpiMouse.CursorPos.x < xRightPanel + 10 - 8) then
  • branches/highdpi/Packages/CevoComponents/DrawDlg.pas

    r246 r252  
    2222    // defines area to grip the window for moving (from top)
    2323    procedure InitButtons;
    24     procedure OnEraseBkgnd(var m: TMessage); message WM_ERASEBKGND;
     24    procedure OnEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;
    2525    procedure OnHitTest(var Msg: TMessage); message WM_NCHITTEST;
    2626    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     
    7979end;
    8080
    81 procedure TDrawDlg.OnEraseBkgnd(var m: TMessage);
     81procedure TDrawDlg.OnEraseBkgnd(var Msg: TMessage);
    8282begin
    8383end;
     
    9393  else
    9494  begin
    95     Pos := Point(Integer(Msg.LParam and $ffff),
    96       Integer((Msg.LParam shr 16) and $ffff));
     95    Pos := ScalePointFromNative(Point(Integer(Msg.LParam and $ffff),
     96      Integer((Msg.LParam shr 16) and $ffff)));
    9797    if Pos.Y >= Top + TitleHeight then
    9898      Msg.Result := HTCLIENT
     
    112112          end;
    113113        end;
    114       Msg.Result := HTCAPTION
     114      Msg.Result := HTCAPTION;
    115115    end;
    116116  end;
  • branches/highdpi/Packages/DpiControls/UDpiControls.pas

    r250 r252  
    902902function DpiBitBltCanvas(Dest: TDpiCanvas; X, Y, Width, Height: Integer; Src: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
    903903function DpiCreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;
     904function DpiScrollDC(hDC:HDC; dx:longint; dy:longint; const lprcScroll:RECT; const lprcClip:RECT;hrgnUpdate:HRGN; lprcUpdate: LPRECT): WINBOOL;
    904905function ScaleToNative(Value: Integer): Integer;
    905906function ScaleFromNative(Value: Integer): Integer;
     
    940941  Result := CreateRectRgn(ScaleToNative(X1), ScaleToNative(Y1), ScaleToNative(X2),
    941942    ScaleToNative(Y2));
     943end;
     944
     945{$IFDEF LINUX}
     946function LinuxScrollDC(Canvas: TDpiCanvas; dx: longint; dy: longint; const lprcScroll:TRect; const lprcClip:TRect; hrgnUpdate:HRGN; lprcUpdate: PRect):Boolean;
     947begin
     948end;
     949{$ENDIF}
     950
     951function DpiScrollDC(hDC: HDC; dx: longint; dy: longint;
     952  const lprcScroll: RECT; const lprcClip: RECT; hrgnUpdate: HRGN;
     953  lprcUpdate: LPRECT): WINBOOL;
     954begin
     955  {$IFDEF WINDOWS}
     956  Result := Windows.ScrollDC(hDC, ScaleToNative(dx), ScaleToNative(dy),
     957    ScaleRectToNative(lprcScroll), ScaleRectToNative(lprcClip),
     958    hrgnUpdate, lprcUpdate);
     959  {$ENDIF}
     960  {$IFDEF LINUX}
     961  // Can't do scrolling of DC under Linux, then fallback into BitBlt.
     962  Result := DpiBitCanvas(Canvas, lprcScroll.Left + dx, lprcScroll.Top + dy, lprcScroll.Right - lprcScroll.Left, lprcScroll.Bottom - lprcScroll.Top,
     963    Canvas, lprcScroll.Left, lprcScroll.Top);
     964  {$ENDIF}
    942965end;
    943966
Note: See TracChangeset for help on using the changeset viewer.