Changeset 501
- Timestamp:
- Dec 23, 2023, 11:11:19 AM (11 months ago)
- Location:
- trunk/Packages
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/CevoComponents/ScreenTools.pas
r492 r501 40 40 procedure MakeBlue(Dst: TBitmap; X, Y, Width, Height: Integer); 41 41 procedure MakeRed(Dst: TBitmap; X, Y, Width, Height: Integer); 42 procedure ImageOp_B( dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer);42 procedure ImageOp_B(Dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer); 43 43 procedure ImageOp_BCC(Dst, Src: TBitmap; 44 44 xDst, yDst, xSrc, ySrc, Width, Height, Color1, Color2: Integer); overload; … … 47 47 procedure ImageOp_CBC(Dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height, 48 48 Color0, Color2: Integer); 49 procedure ImageOp_CCC( bmp: TBitmap; X, Y, Width, Height, Color0, Color1, Color2: Integer);49 procedure ImageOp_CCC(Bmp: TBitmap; X, Y, Width, Height, Color0, Color1, Color2: Integer); 50 50 function BitBltCanvas(DestCanvas: TCanvas; X, Y, Width, Height: Integer; 51 51 SrcCanvas: TCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; overload; … … 627 627 end; 628 628 629 procedure ImageOp_B( dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer);629 procedure ImageOp_B(Dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer); 630 630 // Src is template 631 631 // X channel = background amp (old Dst content), 128=original brightness … … 643 643 Height := ScaleToNative(Height); 644 644 //Assert(Src.PixelFormat = pf8bit); 645 Assert( dst.PixelFormat = TPixelFormat.pf24bit);645 Assert(Dst.PixelFormat = TPixelFormat.pf24bit); 646 646 if xDst < 0 then begin 647 647 Width := Width + xDst; … … 654 654 yDst := 0; 655 655 end; 656 if xDst + Width > ScaleToNative( dst.Width) then657 Width := ScaleToNative( dst.Width) - xDst;658 if yDst + Height > ScaleToNative( dst.Height) then659 Height := ScaleToNative( dst.Height) - yDst;656 if xDst + Width > ScaleToNative(Dst.Width) then 657 Width := ScaleToNative(Dst.Width) - xDst; 658 if yDst + Height > ScaleToNative(Dst.Height) then 659 Height := ScaleToNative(Dst.Height) - yDst; 660 660 if (Width < 0) or (Height < 0) then 661 661 Exit; 662 662 663 dst.BeginUpdate;663 Dst.BeginUpdate; 664 664 Src.BeginUpdate; 665 665 PixelDst := TPixelPointer.Create(Dst, xDst, yDst); … … 690 690 end; 691 691 src.EndUpdate; 692 dst.EndUpdate;693 end; 694 695 procedure ImageOp_BCC( dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height,692 Dst.EndUpdate; 693 end; 694 695 procedure ImageOp_BCC(Dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height, 696 696 Color1, Color2: Integer); 697 697 // Src is template … … 720 720 yDst := 0; 721 721 end; 722 if xDst + Width > ScaleToNative( dst.Width) then723 Width := ScaleToNative( dst.Width) - xDst;724 if yDst + Height > ScaleToNative( dst.Height) then725 Height := ScaleToNative( dst.Height) - yDst;722 if xDst + Width > ScaleToNative(Dst.Width) then 723 Width := ScaleToNative(Dst.Width) - xDst; 724 if yDst + Height > ScaleToNative(Dst.Height) then 725 Height := ScaleToNative(Dst.Height) - yDst; 726 726 if (Width < 0) or (Height < 0) then 727 727 Exit; 728 728 729 729 Src.BeginUpdate; 730 dst.BeginUpdate;730 Dst.BeginUpdate; 731 731 SrcPixel := TPixelPointer.Create(Src, xSrc, ySrc); 732 732 DstPixel := TPixelPointer.Create(Dst, xDst, yDst); … … 757 757 end; 758 758 Src.EndUpdate; 759 dst.EndUpdate;759 Dst.EndUpdate; 760 760 end; 761 761 … … 816 816 end; 817 817 818 procedure ImageOp_CCC( bmp: TBitmap; X, Y, Width, Height, Color0, Color1, Color2: Integer);818 procedure ImageOp_CCC(Bmp: TBitmap; X, Y, Width, Height, Color0, Color1, Color2: Integer); 819 819 // Bmp is template 820 820 // B channel = Color0 amp, 128=original brightness … … 822 822 // R channel = Color2 amp, 128=original brightness 823 823 var 824 I, Red, Green: Integer; 824 XX, YY: Integer; 825 Red, Green: Integer; 825 826 PixelPtr: TPixelPointer; 826 827 begin 827 828 X := ScaleToNative(X); 828 829 Y := ScaleToNative(Y); 829 Width := ScaleToNative(Width); 830 Height := ScaleToNative(Height); 831 bmp.BeginUpdate; 832 Assert(bmp.PixelFormat = TPixelFormat.pf24bit); 833 Height := Y + Height; 830 Width := ScaleToNativeDist(X, Width); 831 Height := ScaleToNativeDist(Y, Height); 832 833 if X + Width > ScaleToNative(Bmp.Width) then 834 Width := ScaleToNative(Bmp.Width) - X; 835 if Y + Height > ScaleToNative(Bmp.Height) then 836 Height := ScaleToNative(Bmp.Height) - Y; 837 if (Width < 0) or (Height < 0) then 838 Exit; 839 840 Bmp.BeginUpdate; 841 Assert(Bmp.PixelFormat = TPixelFormat.pf24bit); 834 842 PixelPtr := TPixelPointer.Create(Bmp, X, Y); 835 while Y < Heightdo begin836 for I:= 0 to Width - 1 do begin843 for YY := 0 to Height - 1 do begin 844 for XX := 0 to Width - 1 do begin 837 845 Red := ((PixelPtr.Pixel^.B * (Color0 and $0000FF) + PixelPtr.Pixel^.G * 838 846 (Color1 and $0000FF) + PixelPtr.Pixel^.R * (Color2 and $0000FF)) shr 8) and $ff; … … 847 855 PixelPtr.NextPixel; 848 856 end; 849 Inc(Y);850 857 PixelPtr.NextLine; 851 858 end; 852 bmp.EndUpdate;859 Bmp.EndUpdate; 853 860 end; 854 861 -
trunk/Packages/DpiControls/Dpi.PixelPointer.pas
r487 r501 4 4 5 5 uses 6 Classes, SysUtils, Dpi.Graphics, Dpi.Common;6 Math, Classes, SysUtils, Dpi.Graphics, Dpi.Common; 7 7 8 8 type … … 68 68 69 69 resourcestring 70 SOutOfRange = 'Pixel pointer out of range ';70 SOutOfRange = 'Pixel pointer out of range [X: %d. Y: %d]'; 71 71 SWrongBitmapSize = 'Wrong bitmap size [width: %d, height: %d]'; 72 72 … … 126 126 127 127 procedure TPixelPointer.CheckRange; 128 var 129 X: Integer; 130 Y: Integer; 128 131 begin 129 132 {$IFOPT R+} 130 133 if (PByte(Pixel) < PByte(Data)) or 131 (PByte(Pixel) >= PByte(Data) + (Width + Height * BytesPerLine) * BytesPerPixel) then 132 raise Exception.Create(SOutOfRange); 134 (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine + BytesPerLine) then begin 135 X := PByte(Pixel) - PByte(Data); 136 Y := Floor(X / BytesPerLine); 137 X := X - Y * BytesPerLine; 138 X := Floor(X / BytesPerPixel); 139 raise Exception.Create(Format(SOutOfRange, [X, Y])); 140 end; 133 141 {$ENDIF} 134 142 end;
Note:
See TracChangeset
for help on using the changeset viewer.