Ignore:
Timestamp:
May 21, 2020, 8:17:38 PM (4 years ago)
Author:
chronos
Message:
  • Modified: Update from trunk rev 245.
  • Modified: Vcl prefix/suffix changed to Native.
File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r244 r246  
    3535procedure Sprite(dst: TDpiBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
    3636  overload;
    37 procedure MakeBlue(dst: TDpiBitmap; x, y, Width, Height: Integer);
     37procedure MakeBlue(Dst: TDpiBitmap; X, Y, Width, Height: Integer);
     38procedure MakeRed(Dst: TDpiBitmap; X, Y, Width, Height: Integer);
    3839procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer);
    3940procedure ImageOp_BCC(dst, Src: TDpiBitmap;
    … …  
    4142procedure ImageOp_CBC(Dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, Width, Height,
    4243  Color0, Color2: Integer);
    43 procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, w, h, Color0, Color1, Color2: Integer);
     44procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, Width, Height, Color0, Color1, Color2: Integer);
    4445function DpiBitCanvas(DestCanvas: TDpiCanvas; X, Y, Width, Height: Integer;
    4546  SrcCanvas: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; overload;
    … …  
    5758procedure FrameImage(ca: TDpiCanvas; Src: TDpiBitmap;
    5859  x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False);
    59 procedure GlowFrame(dst: TDpiBitmap; x0, y0, Width, Height: integer; cl: TColor);
     60procedure GlowFrame(Dst: TDpiBitmap; x0, y0, Width, Height: integer; cl: TColor);
    6061procedure InitOrnament;
    6162procedure InitCityMark(const T: TTexture);
    … …  
    363364  Bitmap.BeginUpdate;
    364365  PixelPtr := PixelPointer(Bitmap);
    365   for Y := 0 to ScaleToVcl(Bitmap.Height) - 1 do begin
    366     for X := 0 to ScaleToVcl(Bitmap.Width) - 1 do begin
     366  for Y := 0 to ScaleToNative(Bitmap.Height) - 1 do begin
     367    for X := 0 to ScaleToNative(Bitmap.Width) - 1 do begin
    367368      PixelPtr.Pixel^ := ApplyGammaToPixel(PixelPtr.Pixel^);
    368369      PixelPtr.NextPixel;
    … …  
    381382  SrcPtr := PixelPointer(Src);
    382383  DstPtr := PixelPointer(Dst);
    383   for Y := 0 to ScaleToVcl(Src.Height) - 1 do begin
    384     for X := 0 to ScaleToVcl(Src.Width) - 1 do begin
     384  for Y := 0 to ScaleToNative(Src.Height - 1) do begin
     385    for X := 0 to ScaleToNative(Src.Width - 1) do begin
    385386      DstPtr.Pixel^.B := SrcPtr.Pixel^.B;
    386387      DstPtr.Pixel^.G := SrcPtr.Pixel^.B;
    … …  
    403404    Path := Path + '.png';
    404405  if ExtractFileExt(Path) = '.jpg' then begin
    405     jtex := tDpijpegimage.Create;
     406    jtex := TDpiJpegImage.Create;
    406407    try
    407408      jtex.LoadFromFile(Path);
    … …  
    505506    DataPixel := PixelPointer(GrExt[nGrExt].Data);
    506507    MaskPixel := PixelPointer(GrExt[nGrExt].Mask);
    507     for y := 0 to ScaleToVcl(Source.Height) - 1 do begin
    508       for x := 0 to ScaleToVcl(xmax) - 1 do begin
     508    for y := 0 to ScaleToNative(Source.Height) - 1 do begin
     509      for x := 0 to ScaleToNative(xmax) - 1 do begin
    509510        OriginalColor := DataPixel.Pixel^.ARGB and $FFFFFF;
    510511        if (OriginalColor = $FF00FF) or (OriginalColor = $7F007F) then
    … …  
    538539end;
    539540
    540 procedure MakeBlue(dst: TDpiBitmap; x, y, Width, Height: Integer);
    541 var
    542   XX, YY: integer;
     541procedure MakeBlue(Dst: TDpiBitmap; X, Y, Width, Height: Integer);
     542var
     543  XX, YY: Integer;
    543544  PixelPtr: TPixelPointer;
    544545begin
    545   X := ScaleToVcl(X);
    546   Y := ScaleToVcl(Y);
    547   Width := ScaleToVcl(Width);
    548   Height := ScaleToVcl(Height);
    549546  Dst.BeginUpdate;
    550   PixelPtr := PixelPointer(Dst, X, Y);
    551   for yy := 0 to Height - 1 do begin
    552     for xx := 0 to Width - 1 do begin
     547  PixelPtr := PixelPointer(Dst, ScaleToNative(X), ScaleToNative(Y));
     548  for yy := 0 to ScaleToNative(Height) - 1 do begin
     549    for xx := 0 to ScaleToNative(Width) - 1 do begin
    553550      PixelPtr.Pixel^.B := PixelPtr.Pixel^.B div 2;
    554551      PixelPtr.Pixel^.G := PixelPtr.Pixel^.G div 2;
    … …  
    561558end;
    562559
     560procedure MakeRed(Dst: TDpiBitmap; X, Y, Width, Height: Integer);
     561var
     562  XX, YY: Integer;
     563  Gray: Integer;
     564  PixelPtr: TPixelPointer;
     565begin
     566  Dst.BeginUpdate;
     567  PixelPtr := PixelPointer(Dst, ScaleToNative(X), ScaleToNative(Y));
     568  for YY := 0 to ScaleToNative(Height) - 1 do begin
     569    for XX := 0 to ScaleToNative(Width) - 1 do begin
     570      Gray := (Integer(PixelPtr.Pixel^.B) + Integer(PixelPtr.Pixel^.G) +
     571        Integer(PixelPtr.Pixel^.R)) * 85 shr 8;
     572      PixelPtr.Pixel^.B := 0;
     573      PixelPtr.Pixel^.G := 0;
     574      PixelPtr.Pixel^.R := Gray; // 255-(255-gray) div 2;
     575      PixelPtr.NextPixel;
     576    end;
     577    PixelPtr.NextLine;
     578  end;
     579  Dst.EndUpdate;
     580end;
     581
    563582procedure ImageOp_B(dst, Src: TDpiBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer);
    564583// Src is template
    … …  
    570589  PixelDst: TPixelPointer;
    571590begin
    572   xDst := ScaleToVcl(xDst);
    573   yDst := ScaleToVcl(yDst);
    574   xSrc := ScaleToVcl(xSrc);
    575   ySrc := ScaleToVcl(ySrc);
    576   Width := ScaleToVcl(Width);
    577   Height := ScaleToVcl(Height);
     591  xDst := ScaleToNative(xDst);
     592  yDst := ScaleToNative(yDst);
     593  xSrc := ScaleToNative(xSrc);
     594  ySrc := ScaleToNative(ySrc);
     595  Width := ScaleToNative(Width);
     596  Height := ScaleToNative(Height);
    578597  //Assert(Src.PixelFormat = pf8bit);
    579598  Assert(dst.PixelFormat = pf24bit);
    … …  
    588607    yDst := 0;
    589608  end;
    590   if xDst + Width > ScaleToVcl(dst.Width) then
    591     Width := ScaleToVcl(dst.Width) - xDst;
    592   if yDst + Height > ScaleToVcl(dst.Height) then
    593     Height := ScaleToVcl(dst.Height) - yDst;
     609  if xDst + Width > ScaleToNative(dst.Width) then
     610    Width := ScaleToNative(dst.Width) - xDst;
     611  if yDst + Height > ScaleToNative(dst.Height) then
     612    Height := ScaleToNative(dst.Height) - yDst;
    594613  if (Width < 0) or (Height < 0) then
    595614    exit;
    … …  
    638657  DstPixel: TPixelPointer;
    639658begin
    640   xDst := ScaleToVcl(xDst);
    641   yDst := ScaleToVcl(yDst);
    642   xSrc := ScaleToVcl(xSrc);
    643   ySrc := ScaleToVcl(ySrc);
    644   Width := ScaleToVcl(Width);
    645   Height := ScaleToVcl(Height);
     659  xDst := ScaleToNative(xDst);
     660  yDst := ScaleToNative(yDst);
     661  xSrc := ScaleToNative(xSrc);
     662  ySrc := ScaleToNative(ySrc);
     663  Width := ScaleToNative(Width);
     664  Height := ScaleToNative(Height);
    646665  if xDst < 0 then begin
    647666    Width := Width + xDst;
    … …  
    654673    yDst := 0;
    655674  end;
    656   if xDst + Width > ScaleToVcl(dst.Width) then
    657     Width := ScaleToVcl(dst.Width) - xDst;
    658   if yDst + Height > ScaleToVcl(dst.Height) then
    659     Height := ScaleToVcl(dst.Height) - yDst;
     675  if xDst + Width > ScaleToNative(dst.Width) then
     676    Width := ScaleToNative(dst.Width) - xDst;
     677  if yDst + Height > ScaleToNative(dst.Height) then
     678    Height := ScaleToNative(dst.Height) - yDst;
    660679  if (Width < 0) or (Height < 0) then
    661680    exit;
    … …  
    705724  DstPixel: TPixelPointer;
    706725begin
    707   xDst := ScaleToVcl(xDst);
    708   yDst := ScaleToVcl(yDst);
    709   xSrc := ScaleToVcl(xSrc);
    710   ySrc := ScaleToVcl(ySrc);
    711   Width := ScaleToVcl(Width);
    712   Height := ScaleToVcl(Height);
     726  xDst := ScaleToNative(xDst);
     727  yDst := ScaleToNative(yDst);
     728  xSrc := ScaleToNative(xSrc);
     729  ySrc := ScaleToNative(ySrc);
     730  Width := ScaleToNative(Width);
     731  Height := ScaleToNative(Height);
    713732  Src.BeginUpdate;
    714733  Dst.BeginUpdate;
    … …  
    743762end;
    744763
    745 procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, w, h, Color0, Color1, Color2: Integer);
     764procedure ImageOp_CCC(bmp: TDpiBitmap; x, y, Width, Height, Color0, Color1, Color2: Integer);
    746765// Bmp is template
    747766// B channel = Color0 amp, 128=original brightness
    … …  
    752771  PixelPtr: TPixelPointer;
    753772begin
    754   X := ScaleToVcl(X);
    755   Y := ScaleToVcl(Y);
    756   W := ScaleToVcl(W);
    757   H := ScaleToVcl(H);
     773  X := ScaleToNative(X);
     774  Y := ScaleToNative(Y);
     775  Width := ScaleToNative(Width);
     776  Height := ScaleToNative(Height);
    758777  bmp.BeginUpdate;
    759778  assert(bmp.PixelFormat = pf24bit);
    760   h := y + h;
     779  Height := y + Height;
    761780  PixelPtr := PixelPointer(Bmp, x, y);
    762   while y < h do begin
    763     for i := 0 to w - 1 do begin
     781  while y < Height do begin
     782    for i := 0 to Width - 1 do begin
    764783      Red := ((PixelPtr.Pixel^.B * (Color0 and $0000FF) + PixelPtr.Pixel^.G *
    765784        (Color1 and $0000FF) + PixelPtr.Pixel^.R * (Color2 and $0000FF)) shr 8) and $ff;
    … …  
    799818  SrcCanvas: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
    800819begin
     820  {$IFDEF WINDOWS}
     821  // LCLIntf.BitBlt is slower than direct Windows BitBlt
     822  Result := Windows.DpiBitBlt(DestCanvas.Handle, X, Y, Width, Height, SrcCanvas.Handle, XSrc, YSrc, Rop);
     823  {$ELSE}
    801824  Result := DpiBitBlt(DestCanvas.Handle, X, Y, Width, Height, SrcCanvas.Handle, XSrc, YSrc, Rop);
     825  {$ENDIF}
    802826end;
    803827
    … …  
    903927end;
    904928
    905 procedure GlowFrame(dst: TDpiBitmap; x0, y0, Width, Height: Integer; cl: TColor);
     929procedure GlowFrame(Dst: TDpiBitmap; x0, y0, Width, Height: Integer; cl: TColor);
    906930var
    907931  x, y, ch, r: Integer;
    … …  
    909933  DpiGlowRange: Integer;
    910934begin
    911   DpiGlowRange := ScaleToVcl(GlowRange);
    912   X0 := ScaleToVcl(X0);
    913   Y0 := ScaleToVcl(Y0);
    914   Width := ScaleToVcl(Width);
    915   Height := ScaleToVcl(Height);
    916   dst.BeginUpdate;
    917   DstPtr := PixelPointer(dst, x0, y0);
     935  DpiGlowRange := ScaleToNative(GlowRange);
     936  X0 := ScaleToNative(X0);
     937  Y0 := ScaleToNative(Y0);
     938  Width := ScaleToNative(Width);
     939  Height := ScaleToNative(Height);
     940  Dst.BeginUpdate;
     941  DstPtr := PixelPointer(Dst, x0 - DpiGlowRange + 1, y0 - DpiGlowRange + 1);
    918942  for y := -DpiGlowRange + 1 to Height - 1 + DpiGlowRange - 1 do begin
    919943    for x := -DpiGlowRange + 1 to Width - 1 + DpiGlowRange - 1 do begin
    920       DstPtr.SetXY(x, y);
    921944      if x < 0 then
    922945        if y < 0 then
    … …  
    937960      else if y >= Height then
    938961        r := y - (Height - 1)
    939       else
     962      else begin
     963        DstPtr.NextPixel;
    940964        continue;
     965      end;
    941966      if r = 0 then
    942967        r := 1;
    … …  
    946971            (DstPtr.Pixel^.Planes[2 - ch] * (r - 1) + (cl shr (8 * ch) and $FF) *
    947972            (DpiGlowRange - r)) div (DpiGlowRange - 1);
    948     end;
    949   end;
    950   dst.EndUpdate;
     973      DstPtr.NextPixel;
     974    end;
     975    DstPtr.NextLine;
     976  end;
     977  Dst.EndUpdate;
    951978end;
    952979
    … …  
    15091536  // texturize background
    15101537  Dest.BeginUpdate;
    1511   TexWidth := ScaleToVcl(Texture.Width);
    1512   TexHeight := ScaleToVcl(Texture.Height);
     1538  TexWidth := Texture.Width;
     1539  TexHeight := Texture.Height;
    15131540  DstPixel := PixelPointer(Dest);
    15141541  SrcPixel := PixelPointer(Texture);
    1515   for Y := 0 to ScaleToVcl(Dest.Height) - 1 do begin
    1516     for X := 0 to ScaleToVcl(Dest.Width) - 1 do begin
     1542  for Y := 0 to ScaleToNative(Dest.Height) - 1 do begin
     1543    for X := 0 to ScaleToNative(Dest.Width) - 1 do begin
    15171544      if (DstPixel.Pixel^.ARGB and $FFFFFF) = TransparentColor then begin
    15181545        SrcPixel.SetXY(X mod TexWidth, Y mod TexHeight);
    … …  
    15351562  Bitmap.BeginUpdate;
    15361563  PicturePixel := PixelPointer(Bitmap);
    1537   for y := 0 to ScaleToVcl(Bitmap.Height) - 1 do begin
    1538     for x := 0 to ScaleToVcl(Bitmap.Width) - 1 do begin
     1564  for y := 0 to ScaleToNative(Bitmap.Height) - 1 do begin
     1565    for x := 0 to ScaleToNative(Bitmap.Width) - 1 do begin
    15391566      PicturePixel.Pixel^.B := Max(PicturePixel.Pixel^.B - Change, 0);
    15401567      PicturePixel.Pixel^.G := Max(PicturePixel.Pixel^.G - Change, 0);
    … …  
    15451572  end;
    15461573  Bitmap.EndUpdate;
     1574end;
     1575
     1576function ScaleToNative(Value: Integer): Integer;
     1577begin
     1578  Result := Value;
     1579end;
     1580
     1581function ScaleFromNative(Value: Integer): Integer;
     1582begin
     1583  Result := Value;
    15471584end;
    15481585
Note: See TracChangeset for help on using the changeset viewer.