Changeset 265 for branches


Ignore:
Timestamp:
Jun 25, 2020, 10:24:44 PM (4 years ago)
Author:
chronos
Message:
  • Fixed: Scaling IsoEngine ForgOfWar sprites.
  • Fixed: PopupMenu position calculated using not scaled GetSystemMetrics.
  • Fixed: Scale TDpiBitmaps using normal scaling functions to get pixels on valid expected possition.
  • Fixed: DpiBitBlt needs to be executed as StretchDraw for non-integer pixel scaling. This leads to slower drawing.
Location:
branches/highdpi
Files:
1 added
8 edited

Legend:

Unmodified
Added
Removed

  • branches/highdpi/LocalPlayer/Help.pas

    r255 r265  
    993993    Name: string;
    994994  begin
    995     RightMargin := InnerWidth - 16 - GetSystemMetrics(SM_CXVSCROLL);
     995    RightMargin := InnerWidth - 16 - DpiGetSystemMetrics(SM_CXVSCROLL);
    996996    FollowFormat := pkNormal;
    997997    while s <> '' do
    … …  
    12551255      s := List[i];
    12561256      while BiColorTextWidth(OffScreen.Canvas, s) > InnerWidth - 16 -
    1257         GetSystemMetrics(SM_CXVSCROLL) do
     1257        DpiGetSystemMetrics(SM_CXVSCROLL) do
    12581258        Delete(s, length(s), 1);
    12591259      MainText.AddLine(s);
    … …  
    12731273      s := List[i];
    12741274      while BiColorTextWidth(OffScreen.Canvas, s) > InnerWidth - 16 -
    1275         GetSystemMetrics(SM_CXVSCROLL) do
     1275        DpiGetSystemMetrics(SM_CXVSCROLL) do
    12761276        Delete(s, length(s), 1);
    12771277      MainText.AddLine(s);
    … …  
    22482248
    22492249    // cut lines to fit to window
    2250     RightMargin := InnerWidth - 16 - GetSystemMetrics(SM_CXVSCROLL);
     2250    RightMargin := InnerWidth - 16 - DpiGetSystemMetrics(SM_CXVSCROLL);
    22512251    OffScreen.Canvas.Font.Assign(UniFont[ftNormal]);
    22522252    for i := 0 to SearchResult.Count - 1 do

  • branches/highdpi/LocalPlayer/IsoEngine.pas

    r246 r265  
    375375  begin
    376376    for i := 0 to yyt * 3 - 1 do
    377       MaskLine[i] := PixelPointer(Mask24, 0, 1 + ySrc * (yyt * 3 + 1) + i);
    378     for xSrc := 0 to 9 - 1 do
    379     begin
    380       i := ySrc * 9 + xSrc;
     377      MaskLine[i] := PixelPointer(Mask24, 0, ScaleToNative(1 + ySrc * (yyt * 3 + 1) + i));
     378    for xSrc := 0 to TerrainIconCols - 1 do begin
     379      i := ySrc * TerrainIconCols + xSrc;
    381380      TSpriteSize[i].Left := 0;
    382381      repeat
    383382        Border := true;
    384383        for y := 0 to yyt * 3 - 1 do begin
    385           MaskLine[y].SetX(1 + xSrc * (xxt * 2 + 1) + TSpriteSize[i].Left);
     384          MaskLine[y].SetX(ScaleToNative(1 + xSrc * (xxt * 2 + 1) + TSpriteSize[i].Left));
    386385          if MaskLine[y].Pixel^.B = 0 then Border := false;
    387386        end;
    … …  
    392391        Border := true;
    393392        for x := 0 to xxt * 2 - 1 do begin
    394           MaskLine[TSpriteSize[i].Top].SetX(1 + xSrc * (xxt * 2 + 1) + x);
     393          MaskLine[TSpriteSize[i].Top].SetX(ScaleToNative(1 + xSrc * (xxt * 2 + 1) + x));
    395394          if MaskLine[TSpriteSize[i].Top].Pixel^.B = 0 then Border := false;
    396395        end;
    … …  
    401400        Border := true;
    402401        for y := 0 to yyt * 3 - 1 do begin
    403           MaskLine[y].SetX(xSrc * (xxt * 2 + 1) + TSpriteSize[i].Right);
     402          MaskLine[y].SetX(ScaleToNative(xSrc * (xxt * 2 + 1) + TSpriteSize[i].Right));
    404403          if MaskLine[y].Pixel^.B = 0 then Border := false;
    405404        end;
    … …  
    410409        Border := true;
    411410        for x := 0 to xxt * 2 - 1 do begin
    412           MaskLine[TSpriteSize[i].Bottom - 1].SetX(1 + xSrc * (xxt * 2 + 1) + x);
     411          MaskLine[TSpriteSize[i].Bottom - 1].SetX(ScaleToNative(1 + xSrc * (xxt * 2 + 1) + x));
    413412          if MaskLine[TSpriteSize[i].Bottom - 1].Pixel^.B = 0 then Border := false;
    414413        end;
    … …  
    10791078  if not(FoW and (Tile and fObserved = 0)) then
    10801079    PaintBorder;
    1081 
    10821080  if (Loc >= 0) and (Loc < G.lx * G.ly) and (Loc = FAdviceLoc) then
    10831081    TSprite(x, y, spPlain);
    … …  
    12891287  i: integer;
    12901288begin
     1289  FOutput.Canvas.pen.Color := $000000; // $FF shl (8*random(3));
    12911290  FOutput.Canvas.pen.Color := $000000; // $FF shl (8*random(3));
    12921291  for i := 0 to nx div 2 do
    … …  
    15601559        PaintTileExtraTerrain(x + xxt * dx, y + yyt + yyt * dy,
    15611560          dLoc(Loc, dx, dy));
     1561
    15621562  if CityOwner >= 0 then
    15631563  begin

  • branches/highdpi/LocalPlayer/Select.pas

    r252 r265  
    684684      kTribe, kMission: // center text
    685685        if Lines[0] > MaxLines then
    686           x := (InnerWidth - GetSystemMetrics(SM_CXVSCROLL)) div 2 -
     686          x := (InnerWidth - DpiGetSystemMetrics(SM_CXVSCROLL)) div 2 -
    687687            BiColorTextWidth(ca, s) div 2
    688688        else
    … …  
    15751575    kTribe:
    15761576      if Lines[0] > MaxLines then
    1577         InnerWidth := 280 + GetSystemMetrics(SM_CXVSCROLL)
     1577        InnerWidth := 280 + DpiGetSystemMetrics(SM_CXVSCROLL)
    15781578      else
    15791579        InnerWidth := 280;
    … …  
    15811581      begin
    15821582        InnerWidth := 104 - 33 + 15 + 8 + TechNameSpace + 24 * nColumn +
    1583           GetSystemMetrics(SM_CXVSCROLL);
     1583          DpiGetSystemMetrics(SM_CXVSCROLL);
    15841584        if InnerWidth + 2 * SideFrame > 640 then
    15851585        begin
    … …  
    15901590    kAdvance, kFarAdvance:
    15911591      InnerWidth := 104 - 33 + 15 + 8 + TechNameSpace + 24 +
    1592         GetSystemMetrics(SM_CXVSCROLL);
     1592        DpiGetSystemMetrics(SM_CXVSCROLL);
    15931593    kChooseTech, kChooseETech, kStealTech:
    15941594      InnerWidth := 104 - 33 + 15 + 8 + TechNameSpace +
    1595         GetSystemMetrics(SM_CXVSCROLL);
     1595        DpiGetSystemMetrics(SM_CXVSCROLL);
    15961596  else
    15971597    InnerWidth := 363;
    … …  
    16041604  { TODO:
    16051605  SetWindowPos(sb.ScrollBar.Handle, 0, SideFrame + InnerWidth - GetSystemMetrics(SM_CXVSCROLL),
    1606     TitleHeight, GetSystemMetrics(SM_CXVSCROLL), LineDistance * DispLines + 48,
     1606    TitleHeight, DpiGetSystemMetrics(SM_CXVSCROLL), LineDistance * DispLines + 48,
    16071607    SWP_NOZORDER or SWP_NOREDRAW);
    16081608  }

  • branches/highdpi/LocalPlayer/Term.pas

    r254 r265  
    563563  nx := BigImp.Width div xSizeBig * xSizeSmall;
    564564  ny := BigImp.Height div ySizeBig * ySizeSmall;
     565  SmallImp.SetSize(nx, ny);
     566  SmallImp.Canvas.StretchDraw(Rect(0, 0, SmallImp.Width, SmallImp.Height), BigImp);
     567
     568{  nx := BigImp.Width div xSizeBig * xSizeSmall;
     569  ny := BigImp.Height div ySizeBig * ySizeSmall;
    565570
    566571  // resample icons
    … …  
    636641  SmallImp.EndUpdate;
    637642  FreeMem(Resampled);
     643  }
    638644end;
    639645
    … …  
    35833589  sb.SetBorderSpacing(ClientHeight - yTroop - 24, ClientWidth - xRightPanel + 8, 8);
    35843590  {TODO:
    3585   SetWindowPos(sb.ScrollBar.Handle, 0, xRightPanel + 10 - 14 - GetSystemMetrics(SM_CXVSCROLL),
     3591  SetWindowPos(sb.ScrollBar.Handle, 0, xRightPanel + 10 - 14 - DpiGetSystemMetrics(SM_CXVSCROLL),
    35863592    ClientHeight - MidPanelHeight + 8, 0, 0, SWP_NOSIZE or SWP_NOZORDER);
    35873593    }
    … …  
    36693675    if SmallScreen and not supervising then
    36703676      xTroop := xRightPanel + 10 - 3 * 66 -
    3671         GetSystemMetrics(SM_CXVSCROLL) - 19 - 4;
     3677        DpiGetSystemMetrics(SM_CXVSCROLL) - 19 - 4;
    36723678    // not perfect but we assume almost no one is still playing on a 800x600 screen
    36733679  end;
    3674   TrRow := (xRightPanel + 10 - xTroop - GetSystemMetrics(SM_CXVSCROLL) - 19)
     3680  TrRow := (xRightPanel + 10 - xTroop - DpiGetSystemMetrics(SM_CXVSCROLL) - 19)
    36753681    div TrPitch;
    36763682end;
    … …  
    53305336      else
    53315337        EditPopup.Popup(Left + x + 4,
    5332           Top + y + GetSystemMetrics(SM_CYCAPTION) + 4);
     5338          Top + y + DpiGetSystemMetrics(SM_CYCAPTION) + 4);
    53335339    end
    53345340    else if (UnFocus >= 0) and (MyUn[UnFocus].Loc <> MouseLoc) then
    … …  
    62146220        StatPopup.Popup(Left + ClientWidth - xPalace + 6,
    62156221          Top + ClientHeight - PanelHeight + yPalace + ySizeBig +
    6216           GetSystemMetrics(SM_CYCAPTION) + 3)
     6222          DpiGetSystemMetrics(SM_CYCAPTION) + 3)
    62176223    end
    62186224    (* else if (x>=xAdvisor-3) and (y>=yAdvisor-3)
    … …  
    63066312begin
    63076313  TroopLoc := Loc;
    6308   TrRow := (xRightPanel + 10 - xTroop - GetSystemMetrics(SM_CXVSCROLL) - 19)
     6314  TrRow := (xRightPanel + 10 - xTroop - DpiGetSystemMetrics(SM_CXVSCROLL) - 19)
    63096315    div TrPitch;
    63106316  TrCnt := 0;
    … …  
    74407446  else
    74417447    Popup.Popup(Left + TDpiControl(Sender).Left + 4, Top + TDpiControl(Sender).Top +
    7442       GetSystemMetrics(SM_CYCAPTION) + 4);
     7448      DpiGetSystemMetrics(SM_CYCAPTION) + 4);
    74437449end;
    74447450
    … …  
    76007606          GamePopup.Popup(Left, Top + TopBarHeight - 1)
    76017607        else
    7602           GamePopup.Popup(Left + 4, Top + GetSystemMetrics(SM_CYCAPTION) + 4 +
     7608          GamePopup.Popup(Left + 4, Top + DpiGetSystemMetrics(SM_CYCAPTION) + 4 +
    76037609            TopBarHeight - 1);
    76047610      end
    … …  
    78907896      GamePopup.Popup(Left, Top + TopBarHeight - 1)
    78917897    else
    7892       GamePopup.Popup(Left + 4, Top + GetSystemMetrics(SM_CYCAPTION) + 4 +
     7898      GamePopup.Popup(Left + 4, Top + DpiGetSystemMetrics(SM_CYCAPTION) + 4 +
    78937899        TopBarHeight - 1);
    78947900    exit

  • branches/highdpi/Packages/CevoComponents/ScreenTools.pas

    r251 r265  
    589589  PixelDst: TPixelPointer;
    590590begin
     591  Width := ScaleToNativeDist(xSrc, Width);
     592  Height := ScaleToNativeDist(ySrc, Height);
    591593  xDst := ScaleToNative(xDst);
    592594  yDst := ScaleToNative(yDst);
    593595  xSrc := ScaleToNative(xSrc);
    594596  ySrc := ScaleToNative(ySrc);
    595   Width := ScaleToNative(Width);
    596   Height := ScaleToNative(Height);
    597597  //Assert(Src.PixelFormat = pf8bit);
    598598  Assert(dst.PixelFormat = pf24bit);
    … …  
    657657  DstPixel: TPixelPointer;
    658658begin
     659  Width := ScaleToNativeDist(xSrc, Width);
     660  Height := ScaleToNativeDist(ySrc, Height);
    659661  xDst := ScaleToNative(xDst);
    660662  yDst := ScaleToNative(yDst);
    661663  xSrc := ScaleToNative(xSrc);
    662664  ySrc := ScaleToNative(ySrc);
    663   Width := ScaleToNative(Width);
    664   Height := ScaleToNative(Height);
    665665  if xDst < 0 then begin
    666666    Width := Width + xDst;
    … …  
    724724  DstPixel: TPixelPointer;
    725725begin
     726  Width := ScaleToNativeDist(xSrc, Width);
     727  Height := ScaleToNativeDist(ySrc, Height);
    726728  xDst := ScaleToNative(xDst);
    727729  yDst := ScaleToNative(yDst);
    728730  xSrc := ScaleToNative(xSrc);
    729731  ySrc := ScaleToNative(ySrc);
    730   Width := ScaleToNative(Width);
    731   Height := ScaleToNative(Height);
    732732  Src.BeginUpdate;
    733733  Dst.BeginUpdate;
    … …  
    771771  PixelPtr: TPixelPointer;
    772772begin
     773  Width := ScaleToNativeDist(X, Width);
     774  Height := ScaleToNativeDist(Y, Height);
    773775  X := ScaleToNative(X);
    774776  Y := ScaleToNative(Y);
    775   Width := ScaleToNative(Width);
    776   Height := ScaleToNative(Height);
    777777  bmp.BeginUpdate;
    778778  assert(bmp.PixelFormat = pf24bit);

  • branches/highdpi/Packages/DpiControls/DpiControls.lpk

    r178 r265  
    1414    <License Value="Copyleft, public domain"/>
    1515    <Version Minor="1"/>
    16     <Files Count="1">
     16    <Files Count="2">
    1717      <Item1>
    1818        <Filename Value="UDpiControls.pas"/>
    … …  
    2020        <UnitName Value="UDpiControls"/>
    2121      </Item1>
     22      <Item2>
     23        <Filename Value="UPixelPointer2.pas"/>
     24        <UnitName Value="UPixelPointer2"/>
     25      </Item2>
    2226    </Files>
    2327    <RequiredPkgs Count="3">

  • branches/highdpi/Packages/DpiControls/DpiControls.pas

    r178 r265  
    99
    1010uses
    11   UDpiControls, LazarusPackageIntf;
     11  UDpiControls, UPixelPointer2, LazarusPackageIntf;
    1212
    1313implementation

  • branches/highdpi/Packages/DpiControls/UDpiControls.pas

    r255 r265  
    88  {$IFDEF WINDOWS}Windows, {$ENDIF}Classes, SysUtils, LCLProc, LResources, Forms, FormEditingIntf, ProjectIntf,
    99  Controls, StdCtrls, fgl, Graphics, ComCtrls, ExtCtrls, LCLType, GraphType,
    10   Types, CustApp, LMessages, LCLIntf, Menus, Math;
     10  Types, CustApp, LMessages, LCLIntf, Menus, Math, UPixelPointer2;
    1111
    1212type
    … …  
    953953  const lprcClip:TRect; hrgnUpdate: Handle; lprcUpdate: PRect): Boolean;
    954954function ScaleToNative(Value: Integer): Integer;
     955function ScaleToNativeDist(Base, Value: Integer): Integer;
    955956function ScaleFromNative(Value: Integer): Integer;
    956957function ScalePointToNative(Value: TPoint): TPoint;
    … …  
    963964function ScaleFloatFromNative(Value: Double): Double;
    964965procedure WriteLog(Text: string);
     966function DpiGetSystemMetrics(nIndex: Integer): Integer;
    965967
    966968implementation
    … …  
    10291031end;
    10301032
     1033function ScaleToNativeDist(Base, Value: Integer): Integer;
     1034begin
     1035  Result := ScaleToNative(Base + Value) - ScaleToNative(Base);
     1036end;
     1037
    10311038function ScaleFromNative(Value: Integer): Integer;
    10321039begin
    … …  
    10961103end;
    10971104
     1105function DpiGetSystemMetrics(nIndex: Integer): Integer;
     1106begin
     1107  Result := ScaleFromNative(GetSystemMetrics(nIndex));
     1108end;
     1109
    10981110function DpiBitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc,
    10991111  YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
     1112var
     1113  DstWidth, DstHeight: Integer;
     1114  SrcWidth, SrcHeight: Integer;
    11001115begin
    11011116  {$IFDEF WINDOWS}
    … …  
    11051120    ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
    11061121  {$ELSE}
    1107   Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
     1122
     1123
     1124  DstWidth := ScaleToNativeDist(X, Width);
     1125  DstHeight := ScaleToNativeDist(Y, Height);
     1126  SrcWidth := ScaleToNativeDist(XSrc, Width);
     1127  SrcHeight := ScaleToNativeDist(YSrc, Height);
     1128  if (DstWidth = SrcWidth) and (DstHeight = SrcHeight) then begin
     1129    Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
     1130      DstWidth, DstHeight, SrcDC,
     1131      ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
     1132  end else begin
     1133    Result := StretchBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
     1134      DstWidth, DstHeight, SrcDC,
     1135      ScaleToNative(XSrc), ScaleToNative(YSrc),
     1136      SrcWidth, SrcHeight, Rop);
     1137  end;
     1138
     1139{  Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
    11081140    ScaleToNative(Width), ScaleToNative(Height), SrcDC,
    11091141    ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
     1142 }
    11101143  {$ENDIF}
    11111144end;
    … …  
    18861919end;
    18871920
     1921procedure StretchDrawBitmap(Src: TRasterImage; Dst: TBitmap);
     1922var
     1923  SrcPtr: TPixelPointer;
     1924  DstPtr: TPixelPointer;
     1925  xx, yy: Integer;
     1926  SrcX, SrcY: Integer;
     1927  DstX, DstY: Integer;
     1928  DstWidth, DstHeight: Integer;
     1929begin
     1930  Dst.BeginUpdate;
     1931  SrcPtr := PixelPointer(Src, 0, 0);
     1932  DstPtr := PixelPointer(Dst, 0, 0);
     1933  {for yy := 0 to Dst.Height - 1 do begin
     1934    for xx := 0 to Dst.Width - 1 do begin
     1935      SrcPtr.SetXY(Min(ScaleFromNative(xx), Src.Width - 1),
     1936        Min(ScaleFromNative(yy), Src.Height - 1));
     1937      DstPtr.Pixel^.B := SrcPtr.Pixel^.B;
     1938      DstPtr.Pixel^.G := SrcPtr.Pixel^.G;
     1939      DstPtr.Pixel^.R := SrcPtr.Pixel^.R;
     1940      DstPtr.NextPixel;
     1941    end;
     1942    DstPtr.NextLine;
     1943  end;
     1944  }
     1945  for SrcY := 0 to Src.Height - 1 do begin
     1946    DstHeight := ScaleToNative(SrcY + 1) - ScaleToNative(SrcY);
     1947    for DstY := 0 to DstHeight - 1 do begin
     1948      for SrcX := 0 to Src.Width - 1 do begin
     1949        DstWidth := ScaleToNative(SrcX + 1) - ScaleToNative(SrcX);
     1950        for DstX := 0 to DstWidth - 1 do begin
     1951          DstPtr.Pixel^.B := SrcPtr.Pixel^.B;
     1952          DstPtr.Pixel^.G := SrcPtr.Pixel^.G;
     1953          DstPtr.Pixel^.R := SrcPtr.Pixel^.R;
     1954          DstPtr.NextPixel;
     1955        end;
     1956        SrcPtr.NextPixel;
     1957      end;
     1958      DstPtr.NextLine;
     1959      SrcPtr.SetX(0);
     1960    end;
     1961    SrcPtr.NextLine;
     1962  end;
     1963  Dst.EndUpdate;
     1964end;
     1965
    18881966procedure TDpiGraphic.LoadFromFile(const Filename: string);
    18891967var
    … …  
    18941972  Width := Bitmap.Width;
    18951973  Height := Bitmap.Height;
    1896   if Self is TDpiBitmap then
    1897     TBitmap(GetNativeGraphic).Canvas.StretchDraw(Bounds(0, 0,
    1898     TBitmap(GetNativeGraphic).Width, TBitmap(GetNativeGraphic).Height), Bitmap)
    1899     else raise Exception.Create('Unsupported class ' + Self.ClassName);
     1974  if Self is TDpiBitmap then begin
     1975    StretchDrawBitmap(TRasterImage(Bitmap), TBitmap(GetNativeGraphic));
     1976    //TBitmap(GetNativeGraphic).Canvas.StretchDraw(Bounds(0, 0,
     1977    //TBitmap(GetNativeGraphic).Width, TBitmap(GetNativeGraphic).Height), Bitmap);
     1978  end else raise Exception.Create('Unsupported class ' + Self.ClassName);
    19001979  Bitmap.Free;
    19011980end;
    … …  
    28062885begin
    28072886  //Dpi := 96 * 2; //Screen.PixelsPerInch;
    2808   //Dpi := 144; //Round(96 * 1.25)
     2887  //Dpi := Round(96 * 1.35);
     2888  //Dpi := 144; //Round(96 * 2);
    28092889  //Dpi := Round(96 * 1.6);
    28102890  Dpi := Screen.PixelsPerInch;
Note: See TracChangeset for help on using the changeset viewer.