Ignore:
Timestamp:
May 21, 2020, 7:58:42 PM (5 years ago)
Author:
chronos
Message:
  • Added: Inactive scaling functions for future HighDPI support.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/CevoComponents/ScreenTools.pas

    r230 r245  
    4242procedure ImageOp_CBC(Dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height,
    4343  Color0, Color2: Integer);
    44 procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1, Color2: Integer);
     44procedure ImageOp_CCC(bmp: TBitmap; x, y, Width, Height, Color0, Color1, Color2: Integer);
    4545function BitBltCanvas(DestCanvas: TCanvas; X, Y, Width, Height: Integer;
    4646  SrcCanvas: TCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; overload;
    … …  
    5858procedure FrameImage(ca: TCanvas; Src: TBitmap;
    5959  x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False);
    60 procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: integer; cl: TColor);
     60procedure GlowFrame(Dst: TBitmap; x0, y0, Width, Height: integer; cl: TColor);
    6161procedure InitOrnament;
    6262procedure InitCityMark(const T: TTexture);
    … …  
    9393procedure Texturize(Dest, Texture: TBitmap; TransparentColor: Integer);
    9494procedure DarkenImage(Bitmap: TBitmap; Change: Integer);
     95function ScaleToNative(Value: Integer): Integer;
     96function ScaleFromNative(Value: Integer): Integer;
    9597
    9698const
    … …  
    364366  Bitmap.BeginUpdate;
    365367  PixelPtr := PixelPointer(Bitmap);
    366   for Y := 0 to Bitmap.Height - 1 do begin
    367     for X := 0 to Bitmap.Width - 1 do begin
     368  for Y := 0 to ScaleToNative(Bitmap.Height) - 1 do begin
     369    for X := 0 to ScaleToNative(Bitmap.Width) - 1 do begin
    368370      PixelPtr.Pixel^ := ApplyGammaToPixel(PixelPtr.Pixel^);
    369371      PixelPtr.NextPixel;
    … …  
    382384  SrcPtr := PixelPointer(Src);
    383385  DstPtr := PixelPointer(Dst);
    384   for Y := 0 to Src.Height - 1 do begin
    385     for X := 0 to Src.Width - 1 do begin
     386  for Y := 0 to ScaleToNative(Src.Height - 1) do begin
     387    for X := 0 to ScaleToNative(Src.Width - 1) do begin
    386388      DstPtr.Pixel^.B := SrcPtr.Pixel^.B;
    387389      DstPtr.Pixel^.G := SrcPtr.Pixel^.B;
    … …  
    404406    Path := Path + '.png';
    405407  if ExtractFileExt(Path) = '.jpg' then begin
    406     jtex := tjpegimage.Create;
     408    jtex := TJpegImage.Create;
    407409    try
    408410      jtex.LoadFromFile(Path);
    … …  
    506508    DataPixel := PixelPointer(GrExt[nGrExt].Data);
    507509    MaskPixel := PixelPointer(GrExt[nGrExt].Mask);
    508     for y := 0 to Source.Height - 1 do begin
    509       for x := 0 to xmax - 1 do begin
     510    for y := 0 to ScaleToNative(Source.Height) - 1 do begin
     511      for x := 0 to ScaleToNative(xmax) - 1 do begin
    510512        OriginalColor := DataPixel.Pixel^.ARGB and $FFFFFF;
    511513        if (OriginalColor = $FF00FF) or (OriginalColor = $7F007F) then
    … …  
    545547begin
    546548  Dst.BeginUpdate;
    547   PixelPtr := PixelPointer(Dst, X, Y);
    548   for yy := 0 to Height - 1 do begin
    549     for xx := 0 to Width - 1 do begin
     549  PixelPtr := PixelPointer(Dst, ScaleToNative(X), ScaleToNative(Y));
     550  for yy := 0 to ScaleToNative(Height) - 1 do begin
     551    for xx := 0 to ScaleToNative(Width) - 1 do begin
    550552      PixelPtr.Pixel^.B := PixelPtr.Pixel^.B div 2;
    551553      PixelPtr.Pixel^.G := PixelPtr.Pixel^.G div 2;
    … …  
    565567begin
    566568  Dst.BeginUpdate;
    567   PixelPtr := PixelPointer(Dst, X, Y);
    568   for YY := 0 to Height - 1 do begin
    569     for XX := 0 to Width - 1 do begin
     569  PixelPtr := PixelPointer(Dst, ScaleToNative(X), ScaleToNative(Y));
     570  for YY := 0 to ScaleToNative(Height) - 1 do begin
     571    for XX := 0 to ScaleToNative(Width) - 1 do begin
    570572      Gray := (Integer(PixelPtr.Pixel^.B) + Integer(PixelPtr.Pixel^.G) +
    571573        Integer(PixelPtr.Pixel^.R)) * 85 shr 8;
    … …  
    589591  PixelDst: TPixelPointer;
    590592begin
     593  xDst := ScaleToNative(xDst);
     594  yDst := ScaleToNative(yDst);
     595  xSrc := ScaleToNative(xSrc);
     596  ySrc := ScaleToNative(ySrc);
     597  Width := ScaleToNative(Width);
     598  Height := ScaleToNative(Height);
    591599  //Assert(Src.PixelFormat = pf8bit);
    592600  Assert(dst.PixelFormat = pf24bit);
    … …  
    601609    yDst := 0;
    602610  end;
    603   if xDst + Width > dst.Width then
    604     Width := dst.Width - xDst;
    605   if yDst + Height > dst.Height then
    606     Height := dst.Height - yDst;
     611  if xDst + Width > ScaleToNative(dst.Width) then
     612    Width := ScaleToNative(dst.Width) - xDst;
     613  if yDst + Height > ScaleToNative(dst.Height) then
     614    Height := ScaleToNative(dst.Height) - yDst;
    607615  if (Width < 0) or (Height < 0) then
    608616    exit;
    … …  
    651659  DstPixel: TPixelPointer;
    652660begin
     661  xDst := ScaleToNative(xDst);
     662  yDst := ScaleToNative(yDst);
     663  xSrc := ScaleToNative(xSrc);
     664  ySrc := ScaleToNative(ySrc);
     665  Width := ScaleToNative(Width);
     666  Height := ScaleToNative(Height);
    653667  if xDst < 0 then begin
    654668    Width := Width + xDst;
    … …  
    661675    yDst := 0;
    662676  end;
    663   if xDst + Width > dst.Width then
    664     Width := dst.Width - xDst;
    665   if yDst + Height > dst.Height then
    666     Height := dst.Height - yDst;
     677  if xDst + Width > ScaleToNative(dst.Width) then
     678    Width := ScaleToNative(dst.Width) - xDst;
     679  if yDst + Height > ScaleToNative(dst.Height) then
     680    Height := ScaleToNative(dst.Height) - yDst;
    667681  if (Width < 0) or (Height < 0) then
    668682    exit;
    … …  
    712726  DstPixel: TPixelPointer;
    713727begin
     728  xDst := ScaleToNative(xDst);
     729  yDst := ScaleToNative(yDst);
     730  xSrc := ScaleToNative(xSrc);
     731  ySrc := ScaleToNative(ySrc);
     732  Width := ScaleToNative(Width);
     733  Height := ScaleToNative(Height);
    714734  Src.BeginUpdate;
    715735  Dst.BeginUpdate;
    … …  
    744764end;
    745765
    746 procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1, Color2: Integer);
     766procedure ImageOp_CCC(bmp: TBitmap; x, y, Width, Height, Color0, Color1, Color2: Integer);
    747767// Bmp is template
    748768// B channel = Color0 amp, 128=original brightness
    … …  
    753773  PixelPtr: TPixelPointer;
    754774begin
     775  X := ScaleToNative(X);
     776  Y := ScaleToNative(Y);
     777  Width := ScaleToNative(Width);
     778  Height := ScaleToNative(Height);
    755779  bmp.BeginUpdate;
    756780  assert(bmp.PixelFormat = pf24bit);
    757   h := y + h;
     781  Height := y + Height;
    758782  PixelPtr := PixelPointer(Bmp, x, y);
    759   while y < h do begin
    760     for i := 0 to w - 1 do begin
     783  while y < Height do begin
     784    for i := 0 to Width - 1 do begin
    761785      Red := ((PixelPtr.Pixel^.B * (Color0 and $0000FF) + PixelPtr.Pixel^.G *
    762786        (Color1 and $0000FF) + PixelPtr.Pixel^.R * (Color2 and $0000FF)) shr 8) and $ff;
    … …  
    905929end;
    906930
    907 procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: Integer; cl: TColor);
     931procedure GlowFrame(Dst: TBitmap; x0, y0, Width, Height: Integer; cl: TColor);
    908932var
    909933  x, y, ch, r: Integer;
    910934  DstPtr: TPixelPointer;
    911 begin
    912   dst.BeginUpdate;
    913   DstPtr := PixelPointer(dst, x0 - GlowRange + 1, y0 - GlowRange + 1);
    914   for y := -GlowRange + 1 to Height - 1 + GlowRange - 1 do begin
    915     for x := -GlowRange + 1 to Width - 1 + GlowRange - 1 do begin
     935  DpiGlowRange: Integer;
     936begin
     937  DpiGlowRange := ScaleToNative(GlowRange);
     938  X0 := ScaleToNative(X0);
     939  Y0 := ScaleToNative(Y0);
     940  Width := ScaleToNative(Width);
     941  Height := ScaleToNative(Height);
     942  Dst.BeginUpdate;
     943  DstPtr := PixelPointer(Dst, x0 - DpiGlowRange + 1, y0 - DpiGlowRange + 1);
     944  for y := -DpiGlowRange + 1 to Height - 1 + DpiGlowRange - 1 do begin
     945    for x := -DpiGlowRange + 1 to Width - 1 + DpiGlowRange - 1 do begin
    916946      if x < 0 then
    917947        if y < 0 then
    … …  
    938968      if r = 0 then
    939969        r := 1;
    940       if r < GlowRange then
     970      if r < DpiGlowRange then
    941971        for ch := 0 to 2 do
    942972          DstPtr.Pixel^.Planes[2 - ch] :=
    943973            (DstPtr.Pixel^.Planes[2 - ch] * (r - 1) + (cl shr (8 * ch) and $FF) *
    944             (GlowRange - r)) div (GlowRange - 1);
     974            (DpiGlowRange - r)) div (DpiGlowRange - 1);
    945975      DstPtr.NextPixel;
    946976    end;
    947977    DstPtr.NextLine;
    948978  end;
    949   dst.EndUpdate;
     979  Dst.EndUpdate;
    950980end;
    951981
    … …  
    15121542  DstPixel := PixelPointer(Dest);
    15131543  SrcPixel := PixelPointer(Texture);
    1514   for Y := 0 to Dest.Height - 1 do begin
    1515     for X := 0 to Dest.Width - 1 do begin
     1544  for Y := 0 to ScaleToNative(Dest.Height) - 1 do begin
     1545    for X := 0 to ScaleToNative(Dest.Width) - 1 do begin
    15161546      if (DstPixel.Pixel^.ARGB and $FFFFFF) = TransparentColor then begin
    15171547        SrcPixel.SetXY(X mod TexWidth, Y mod TexHeight);
    … …  
    15341564  Bitmap.BeginUpdate;
    15351565  PicturePixel := PixelPointer(Bitmap);
    1536   for y := 0 to Bitmap.Height - 1 do begin
    1537     for x := 0 to Bitmap.Width - 1 do begin
     1566  for y := 0 to ScaleToNative(Bitmap.Height) - 1 do begin
     1567    for x := 0 to ScaleToNative(Bitmap.Width) - 1 do begin
    15381568      PicturePixel.Pixel^.B := Max(PicturePixel.Pixel^.B - Change, 0);
    15391569      PicturePixel.Pixel^.G := Max(PicturePixel.Pixel^.G - Change, 0);
    … …  
    15441574  end;
    15451575  Bitmap.EndUpdate;
     1576end;
     1577
     1578function ScaleToNative(Value: Integer): Integer;
     1579begin
     1580  Result := Value;
     1581end;
     1582
     1583function ScaleFromNative(Value: Integer): Integer;
     1584begin
     1585  Result := Value;
    15461586end;
    15471587
Note: See TracChangeset for help on using the changeset viewer.