Changeset 559 for trunk/Packages
- Timestamp:
- Apr 25, 2024, 8:40:07 PM (7 months ago)
- Location:
- trunk/Packages/DpiControls
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/DpiControls/Dpi.Common.pas
r552 r559 25 25 function SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; 26 26 X, Y, cx, cy: Integer; uFlags: UINT): Boolean; 27 function ScaleToNative(Value: Integer): Integer; 27 function ScaleToNative(Value: Integer): Integer; inline; 28 28 function ScaleToNativeDist(Base, Value: Integer): Integer; 29 29 function ScaleFromNative(Value: Integer): Integer; … … 64 64 DstPixelX, DstPixelY: Integer; 65 65 DstPixelWidth, DstPixelHeight: Integer; 66 New X, NewY: Integer;66 NewY: Integer; 67 67 begin 68 68 if not Precise or (Frac(ScreenInfo.Dpi / 96) = 0) then begin … … 107 107 Dest.BeginUpdate; 108 108 SrcPixel := TPixelPointer.Create(Src.NativeBitmap); 109 DstPixel := TPixelPointer.Create(Dest.NativeBitmap );109 DstPixel := TPixelPointer.Create(Dest.NativeBitmap, ScaleToNative(X), ScaleToNative(Y)); 110 110 if Rop = SRCCOPY then begin 111 111 for YY := 0 to Height - 1 do begin 112 NewY := ScaleToNative(Y + YY);113 DstPixelHeight := ScaleToNative(Y + YY + 1) - NewY;114 112 SrcPixel.SetXY(0, ScaleToNative(YSrc + YY)); 113 DstPixelHeight := ScaleToNative(Y + YY + 1) - ScaleToNative(Y + YY); 115 114 for DstPixelY := 0 to DstPixelHeight - 1 do begin 116 DstPixel.SetXY(0, NewY + DstPixelY);117 115 for XX := 0 to Width - 1 do begin 118 116 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); 122 118 for DstPixelX := 0 to DstPixelWidth - 1 do begin 123 119 DstPixel.PixelRGB := SrcPixel.PixelARGB; … … 125 121 end; 126 122 end; 123 DstPixel.NextLine; 127 124 end; 128 125 end; … … 130 127 if Rop = SRCPAINT then begin 131 128 for YY := 0 to Height - 1 do begin 132 NewY := ScaleToNative(Y + YY);133 DstPixelHeight := ScaleToNative(Y + YY + 1) - NewY;134 129 SrcPixel.SetXY(0, ScaleToNative(YSrc + YY)); 130 DstPixelHeight := ScaleToNative(Y + YY + 1) - ScaleToNative(Y + YY); 135 131 for DstPixelY := 0 to DstPixelHeight - 1 do begin 136 DstPixel.SetXY(0, NewY + DstPixelY);137 132 for XX := 0 to Width - 1 do begin 138 133 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); 142 135 for DstPixelX := 0 to DstPixelWidth - 1 do begin 143 DstPixel.PixelRGB := SrcPixel.PixelARGB or DstPixel.PixelARGB;136 DstPixel.PixelRGB := DstPixel.PixelRGB or SrcPixel.PixelARGB; 144 137 DstPixel.NextPixel; 145 138 end; 146 139 end; 140 DstPixel.NextLine; 147 141 end; 148 142 end; … … 150 144 if Rop = SRCAND then begin 151 145 for YY := 0 to Height - 1 do begin 152 NewY := ScaleToNative(Y + YY);153 DstPixelHeight := ScaleToNative(Y + YY + 1) - NewY;154 146 SrcPixel.SetXY(0, ScaleToNative(YSrc + YY)); 147 DstPixelHeight := ScaleToNative(Y + YY + 1) - ScaleToNative(Y + YY); 155 148 for DstPixelY := 0 to DstPixelHeight - 1 do begin 156 DstPixel.SetXY(0, NewY + DstPixelY);157 149 for XX := 0 to Width - 1 do begin 158 150 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); 162 152 for DstPixelX := 0 to DstPixelWidth - 1 do begin 163 DstPixel.PixelRGB := SrcPixel.PixelARGB and DstPixel.PixelARGB;153 DstPixel.PixelRGB := DstPixel.PixelRGB and SrcPixel.PixelARGB; 164 154 DstPixel.NextPixel; 165 155 end; 166 156 end; 157 DstPixel.NextLine; 167 158 end; 168 159 end; … … 170 161 if Rop = DSTINVERT then begin 171 162 for YY := 0 to Height - 1 do begin 172 NewY := ScaleToNative(Y + YY);173 DstPixelHeight := ScaleToNative(Y + YY + 1) - NewY;174 163 SrcPixel.SetXY(0, ScaleToNative(YSrc + YY)); 164 DstPixelHeight := ScaleToNative(Y + YY + 1) - ScaleToNative(Y + YY); 175 165 for DstPixelY := 0 to DstPixelHeight - 1 do begin 176 DstPixel.SetXY(0, NewY + DstPixelY);177 166 for XX := 0 to Width - 1 do begin 178 167 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); 182 169 for DstPixelX := 0 to DstPixelWidth - 1 do begin 183 DstPixel.PixelRGB := not DstPixel.Pixel ARGB;170 DstPixel.PixelRGB := not DstPixel.PixelRGB; 184 171 DstPixel.NextPixel; 185 172 end; 186 173 end; 174 DstPixel.NextLine; 187 175 end; 188 176 end; … … 236 224 end; 237 225 238 function ScaleToNative(Value: Integer): Integer; 226 function ScaleToNative(Value: Integer): Integer; inline; 239 227 begin 240 228 Result := ScreenInfo.Lookup[Value]; -
trunk/Packages/DpiControls/Dpi.Graphics.pas
r552 r559 347 347 ToNative: Double; 348 348 FromNative: Double; 349 Lookup: array[-1000 0..10000] of Integer; // Should be sufficient for 8K screens349 Lookup: array[-1000..10000] of Integer; // Should be sufficient for 8K screens 350 350 property Dpi: Integer read FDpi write SetDpi; 351 351 end; … … 1329 1329 FDpi := AValue; 1330 1330 ToNative := ScreenInfo.Dpi / 96; 1331 1332 // Precalculate scaling coefficients 1331 1333 FromNative := 96 / ScreenInfo.Dpi; 1332 for I := -10000 to 10000do1334 for I := Low(Lookup) to High(Lookup) do 1333 1335 Lookup[I] := Ceil(I * ToNative); 1334 1336 end; -
trunk/Packages/DpiControls/NativePixelPointer.pas
r539 r559 50 50 Pixel: PPixel32; 51 51 Line: PPixel32; 52 RelLine: PPixel32;53 52 BytesPerPixel: Integer; 54 53 BytesPerLine: Integer; … … 62 61 procedure SetXY(X, Y: Integer); inline; // Set pixel position relative to base 63 62 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 64 65 procedure CheckRange; inline; // Check if current pixel position is not out of range 65 66 function PosValid: Boolean; … … 117 118 end; 118 119 119 procedure TPixelPointer.PreviousLine; 120 procedure TPixelPointer.PreviousLine; inline; 120 121 begin 121 122 Line := Pointer(Line) - BytesPerLine; … … 128 129 end; 129 130 130 procedure TPixelPointer.PreviousPixel; 131 procedure TPixelPointer.PreviousPixel; inline; 131 132 begin 132 133 Pixel := Pointer(Pixel) - BytesPerPixel; … … 144 145 end; 145 146 147 function TPixelPointer.GetY: Integer; inline; 148 begin 149 Result := (Pointer(Base) - Line) div BytesPerLine; 150 end; 151 152 function TPixelPointer.GetX: Integer; inline; 153 begin 154 Result := (Pointer(Line) - Pixel) div BytesPerPixel; 155 end; 156 146 157 procedure TPixelPointer.CheckRange; 147 158 {$IFOPT R+} … … 149 160 X: Integer; 150 161 Y: Integer; 162 D: Integer; 151 163 {$ENDIF} 152 164 begin … … 154 166 if (PByte(Pixel) < PByte(Data)) or 155 167 (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); 160 172 raise Exception.Create(Format(SOutOfRange, [X, Y, Width, Height])); 161 173 end;
Note:
See TracChangeset
for help on using the changeset viewer.