Ignore:
Timestamp:
Apr 25, 2024, 8:40:07 PM (7 months ago)
Author:
chronos
Message:
Location:
trunk/Packages/DpiControls
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/DpiControls/Dpi.Common.pas

    r552 r559  
    2525function SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND;
    2626  X, Y, cx, cy: Integer; uFlags: UINT): Boolean;
    27 function ScaleToNative(Value: Integer): Integer;
     27function ScaleToNative(Value: Integer): Integer; inline;
    2828function ScaleToNativeDist(Base, Value: Integer): Integer;
    2929function ScaleFromNative(Value: Integer): Integer;
    … …  
    6464  DstPixelX, DstPixelY: Integer;
    6565  DstPixelWidth, DstPixelHeight: Integer;
    66   NewX, NewY: Integer;
     66  NewY: Integer;
    6767begin
    6868  if not Precise or (Frac(ScreenInfo.Dpi / 96) = 0) then begin
    … …  
    107107  Dest.BeginUpdate;
    108108  SrcPixel := TPixelPointer.Create(Src.NativeBitmap);
    109   DstPixel := TPixelPointer.Create(Dest.NativeBitmap);
     109  DstPixel := TPixelPointer.Create(Dest.NativeBitmap, ScaleToNative(X), ScaleToNative(Y));
    110110  if Rop = SRCCOPY then begin
    111111    for YY := 0 to Height - 1 do begin
    112       NewY := ScaleToNative(Y + YY);
    113       DstPixelHeight := ScaleToNative(Y + YY + 1) - NewY;
    114112      SrcPixel.SetXY(0, ScaleToNative(YSrc + YY));
     113      DstPixelHeight := ScaleToNative(Y + YY + 1) - ScaleToNative(Y + YY);
    115114      for DstPixelY := 0 to DstPixelHeight - 1 do begin
    116         DstPixel.SetXY(0, NewY + DstPixelY);
    117115        for XX := 0 to Width - 1 do begin
    118116          SrcPixel.SetX(ScaleToNative(XSrc + XX));
    119           NewX := ScaleToNative(X + XX);
    120           DstPixel.SetX(NewX);
    121           DstPixelWidth := ScaleToNative(X + XX + 1) - NewX;
     117          DstPixelWidth := ScaleToNative(X + XX + 1) - ScaleToNative(X + XX);
    122118          for DstPixelX := 0 to DstPixelWidth - 1 do begin
    123119            DstPixel.PixelRGB := SrcPixel.PixelARGB;
    … …  
    125121          end;
    126122        end;
     123        DstPixel.NextLine;
    127124      end;
    128125    end;
    … …  
    130127  if Rop = SRCPAINT then begin
    131128    for YY := 0 to Height - 1 do begin
    132       NewY := ScaleToNative(Y + YY);
    133       DstPixelHeight := ScaleToNative(Y + YY + 1) - NewY;
    134129      SrcPixel.SetXY(0, ScaleToNative(YSrc + YY));
     130      DstPixelHeight := ScaleToNative(Y + YY + 1) - ScaleToNative(Y + YY);
    135131      for DstPixelY := 0 to DstPixelHeight - 1 do begin
    136         DstPixel.SetXY(0, NewY + DstPixelY);
    137132        for XX := 0 to Width - 1 do begin
    138133          SrcPixel.SetX(ScaleToNative(XSrc + XX));
    139           NewX := ScaleToNative(X + XX);
    140           DstPixel.SetX(NewX);
    141           DstPixelWidth := ScaleToNative(X + XX + 1) - NewX;
     134          DstPixelWidth := ScaleToNative(X + XX + 1) - ScaleToNative(X + XX);
    142135          for DstPixelX := 0 to DstPixelWidth - 1 do begin
    143             DstPixel.PixelRGB := SrcPixel.PixelARGB or DstPixel.PixelARGB;
     136            DstPixel.PixelRGB := DstPixel.PixelRGB or SrcPixel.PixelARGB;
    144137            DstPixel.NextPixel;
    145138          end;
    146139        end;
     140        DstPixel.NextLine;
    147141      end;
    148142    end;
    … …  
    150144  if Rop = SRCAND then begin
    151145    for YY := 0 to Height - 1 do begin
    152       NewY := ScaleToNative(Y + YY);
    153       DstPixelHeight := ScaleToNative(Y + YY + 1) - NewY;
    154146      SrcPixel.SetXY(0, ScaleToNative(YSrc + YY));
     147      DstPixelHeight := ScaleToNative(Y + YY + 1) - ScaleToNative(Y + YY);
    155148      for DstPixelY := 0 to DstPixelHeight - 1 do begin
    156         DstPixel.SetXY(0, NewY + DstPixelY);
    157149        for XX := 0 to Width - 1 do begin
    158150          SrcPixel.SetX(ScaleToNative(XSrc + XX));
    159           NewX := ScaleToNative(X + XX);
    160           DstPixel.SetX(NewX);
    161           DstPixelWidth := ScaleToNative(X + XX + 1) - NewX;
     151          DstPixelWidth := ScaleToNative(X + XX + 1) - ScaleToNative(X + XX);
    162152          for DstPixelX := 0 to DstPixelWidth - 1 do begin
    163             DstPixel.PixelRGB := SrcPixel.PixelARGB and DstPixel.PixelARGB;
     153            DstPixel.PixelRGB := DstPixel.PixelRGB and SrcPixel.PixelARGB;
    164154            DstPixel.NextPixel;
    165155          end;
    166156        end;
     157        DstPixel.NextLine;
    167158      end;
    168159    end;
    … …  
    170161  if Rop = DSTINVERT then begin
    171162    for YY := 0 to Height - 1 do begin
    172       NewY := ScaleToNative(Y + YY);
    173       DstPixelHeight := ScaleToNative(Y + YY + 1) - NewY;
    174163      SrcPixel.SetXY(0, ScaleToNative(YSrc + YY));
     164      DstPixelHeight := ScaleToNative(Y + YY + 1) - ScaleToNative(Y + YY);
    175165      for DstPixelY := 0 to DstPixelHeight - 1 do begin
    176         DstPixel.SetXY(0, NewY + DstPixelY);
    177166        for XX := 0 to Width - 1 do begin
    178167          SrcPixel.SetX(ScaleToNative(XSrc + XX));
    179           NewX := ScaleToNative(X + XX);
    180           DstPixel.SetX(NewX);
    181           DstPixelWidth := ScaleToNative(X + XX + 1) - NewX;
     168          DstPixelWidth := ScaleToNative(X + XX + 1) - ScaleToNative(X + XX);
    182169          for DstPixelX := 0 to DstPixelWidth - 1 do begin
    183             DstPixel.PixelRGB := not DstPixel.PixelARGB;
     170            DstPixel.PixelRGB := not DstPixel.PixelRGB;
    184171            DstPixel.NextPixel;
    185172          end;
    186173        end;
     174        DstPixel.NextLine;
    187175      end;
    188176    end;
    … …  
    236224end;
    237225
    238 function ScaleToNative(Value: Integer): Integer;
     226function ScaleToNative(Value: Integer): Integer; inline;
    239227begin
    240228  Result := ScreenInfo.Lookup[Value];

  • trunk/Packages/DpiControls/Dpi.Graphics.pas

    r552 r559  
    347347    ToNative: Double;
    348348    FromNative: Double;
    349     Lookup: array[-10000..10000] of Integer; // Should be sufficient for 8K screens
     349    Lookup: array[-1000..10000] of Integer; // Should be sufficient for 8K screens
    350350    property Dpi: Integer read FDpi write SetDpi;
    351351  end;
    … …  
    13291329  FDpi := AValue;
    13301330  ToNative := ScreenInfo.Dpi / 96;
     1331
     1332  // Precalculate scaling coefficients
    13311333  FromNative := 96 / ScreenInfo.Dpi;
    1332   for I := -10000 to 10000 do
     1334  for I := Low(Lookup) to High(Lookup) do
    13331335    Lookup[I] := Ceil(I * ToNative);
    13341336end;

  • trunk/Packages/DpiControls/NativePixelPointer.pas

    r539 r559  
    5050    Pixel: PPixel32;
    5151    Line: PPixel32;
    52     RelLine: PPixel32;
    5352    BytesPerPixel: Integer;
    5453    BytesPerLine: Integer;
    … …  
    6261    procedure SetXY(X, Y: Integer); inline; // Set pixel position relative to base
    6362    procedure SetX(X: Integer); inline; // Set horizontal pixel position relative to base
     63    function GetY: Integer; inline; // Set pixel position relative to base
     64    function GetX: Integer; inline; // Set horizontal pixel position relative to base
    6465    procedure CheckRange; inline; // Check if current pixel position is not out of range
    6566    function PosValid: Boolean;
    … …  
    117118end;
    118119
    119 procedure TPixelPointer.PreviousLine;
     120procedure TPixelPointer.PreviousLine; inline;
    120121begin
    121122  Line := Pointer(Line) - BytesPerLine;
    … …  
    128129end;
    129130
    130 procedure TPixelPointer.PreviousPixel;
     131procedure TPixelPointer.PreviousPixel; inline;
    131132begin
    132133  Pixel := Pointer(Pixel) - BytesPerPixel;
    … …  
    144145end;
    145146
     147function TPixelPointer.GetY: Integer; inline;
     148begin
     149  Result := (Pointer(Base) - Line) div BytesPerLine;
     150end;
     151
     152function TPixelPointer.GetX: Integer; inline;
     153begin
     154  Result := (Pointer(Line) - Pixel) div BytesPerPixel;
     155end;
     156
    146157procedure TPixelPointer.CheckRange;
    147158{$IFOPT R+}
    … …  
    149160  X: Integer;
    150161  Y: Integer;
     162  D: Integer;
    151163{$ENDIF}
    152164begin
    … …  
    154166  if (PByte(Pixel) < PByte(Data)) or
    155167    (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine) then begin
    156     X := PByte(Pixel) - PByte(Data);
    157     Y := Floor(X / BytesPerLine);
    158     X := X - Y * BytesPerLine;
    159     X := Floor(X / BytesPerPixel);
     168    D := PByte(Pixel) - PByte(Data);
     169    Y := Trunc(D / BytesPerLine);
     170    X := D - Y * BytesPerLine;
     171    X := Trunc(X / BytesPerPixel);
    160172    raise Exception.Create(Format(SOutOfRange, [X, Y, Width, Height]));
    161173  end;
Note: See TracChangeset for help on using the changeset viewer.