pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

jvcllaz: Port color component extraction routines in JvJVCLUtils.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8074 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2021-08-14 22:25:04 +00:00
parent e2cb8dd822
commit 89d246386d
1 changed files with 83 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files

139
components/jvcllaz/run/JvCore/jvjvclutils.pas
View File

@ -49,7 +49,7 @@ function IconToBitmap2(Ico: HICON; Size: Integer = 32;
TransparentColor: TColor = clNone): TBitmap;
function IconToBitmap3(Ico: HICON; Size: Integer = 32;
TransparentColor: TColor = clNone): TBitmap;
************)
// bitmap manipulation functions
// NOTE: Dest bitmap must be freed by caller!
// get red channel bitmap
@ -58,6 +58,8 @@ procedure GetRBitmap(var Dest: TBitmap; const Source: TBitmap);
procedure GetGBitmap(var Dest: TBitmap; const Source: TBitmap);
// get blue channel bitmap
procedure GetBBitmap(var Dest: TBitmap; const Source: TBitmap);
// get grayscale bitmap
procedure GetGrayscaleBitmap(var Dest: TBitmap; const Source: TBitmap);
// get monochrome bitmap
procedure GetMonochromeBitmap(var Dest: TBitmap; const Source: TBitmap);
// get hue bitmap (h part of hsv)
@ -67,6 +69,7 @@ procedure GetSaturationBitmap(var Dest: TBitmap; const Source: TBitmap);
// get value bitmap (V part of HSV)
procedure GetValueBitmap(var Dest: TBitmap; const Source: TBitmap);
(*************** NOT CONVERTED
// hides / shows the a forms caption area
procedure HideFormCaption(FormHandle: THandle; Hide: Boolean);
@ -866,7 +869,7 @@ function Scale96ToForm(ASize: Integer): Integer;
implementation
uses
sysutils, LCLIntf, GraphType, GraphUtil, Math,
sysutils, LCLIntf, GraphType, GraphUtil, FPImage, IntfGraphics, Math,
{$IFDEF MSWINDOWS}
CommCtrl,
{$ENDIF}
@ -1155,79 +1158,98 @@ begin
end;
{$ENDIF MSWINDOWS}
*****************)
type
TGetXBitmapMode =(gxRed, gxGreen, gxBlue, gxHue, gxSaturation, gxValue);
TGetXBitmapMode =(gxRed, gxGreen, gxBlue, gxHue, gxSaturation, gxValue, gxGrayscale);
procedure GetXBitmap(var Dest: TBitmap; const Source: TBitmap; Mode: TGetXBitmapMode);
var
I, J, H, S, V: Integer;
{$IFDEF CLR}
Line: array of TJvRGBTriple;
{$ELSE}
Line: PJvRGBArray;
{$ENDIF CLR}
img: TLazIntfImage;
clr: TFPColor;
i, j: Integer;
h, s, v: Double;
begin
if not Assigned(Dest) then
Dest := TBitmap.Create;
Dest.Assign(Source);
Dest.PixelFormat := pf24bit;
for J := Dest.Height - 1 downto 0 do
begin
{$IFDEF CLR}
Marshal.PtrToStructure(Dest.ScanLine[J], Line);
{$ELSE}
Line := Dest.ScanLine[J];
{$ENDIF CLR}
img := Source.CreateIntfImage;
try
case Mode of
gxRed:
for I := Dest.Width - 1 downto 0 do
begin
Line[I].rgbGreen := 0;
Line[I].rgbBlue := 0;
end;
gxGreen:
for I := Dest.Width - 1 downto 0 do
begin
Line[I].rgbRed := 0;
Line[I].rgbBlue := 0;
end;
gxBlue:
for I := Dest.Width - 1 downto 0 do
begin
Line[I].rgbRed := 0;
Line[I].rgbGreen := 0;
end;
gxHue:
for I := Dest.Width - 1 downto 0 do
with Line[I] do
for j := 0 to img.Height-1 do
for i := 0 to img.Width-1 do
begin
RGBToHSV(rgbRed, rgbGreen, rgbBlue, H, S, V);
rgbRed := H;
rgbGreen := H;
rgbBlue := H;
clr := img.Colors[i, j];
clr.Green := 0;
clr.Blue := 0;
img.Colors[i, j] := clr;
end;
gxGreen:
for j := 0 to img.Height-1 do
for i := 0 to img.Width-1 do
begin
clr := img.Colors[i, j];
clr.Red := 0;
clr.Blue := 0;
img.Colors[i, j] := clr;
end;
gxBlue:
for j := 0 to img.Height-1 do
for i := 0 to img.Width-1 do
begin
clr := img.Colors[i, j];
clr.Red := 0;
clr.Green := 0;
img.Colors[i, j] := clr;
end;
gxHue:
for j := 0 to img.Height-1 do
for i := 0 to img.Width-1 do
begin
clr := img.Colors[i, j];
ColorToHSV(FPColorToTColor(clr), h, s, v);
clr.Red := round(h*65535);
clr.Green := clr.Red;
clr.Blue := clr.Red;
img.Colors[i, j] := clr;
end;
gxSaturation:
for I := Dest.Width - 1 downto 0 do
with Line[I] do
for j := 0 to img.Height-1 do
for i := 0 to img.Width-1 do
begin
RGBToHSV(rgbRed, rgbGreen, rgbBlue, H, S, V);
rgbRed := S;
rgbGreen := S;
rgbBlue := S;
clr := img.Colors[i, j];
ColorToHSV(FPColorToTColor(clr), h, s, v);
clr.Red := round(s*65535);
clr.Green := clr.Red;
clr.Blue := clr.Red;
img.Colors[i, j] := clr;
end;
gxValue:
for I := Dest.Width - 1 downto 0 do
with Line[I] do
for j := 0 to img.Height-1 do
for i := 0 to img.Width-1 do
begin
RGBToHSV(rgbRed, rgbGreen, rgbBlue, H, S, V);
rgbRed := V;
rgbGreen := V;
rgbBlue := V;
clr := img.Colors[i, j];
ColorToHSV(FPColorToTColor(clr), h, s, v);
clr.Red := round(v*65535);
clr.Green := clr.Red;
clr.Blue := clr.Red;
img.Colors[i, j] := clr;
end;
gxGrayscale:
for j := 0 to img.Height-1 do
for i := 0 to img.Width-1 do
begin
clr := img.Colors[i, j];
clr.Red := (Int64(clr.Red) + clr.Green + clr.Blue) div 3;
clr.Green := clr.Red;
clr.Blue := clr.Red;
img.Colors[i, j] := clr;
end;
end;
Dest.LoadFromIntfImage(img);
finally
img.Free;
end;
Dest.PixelFormat := Source.PixelFormat;
end;
procedure GetRBitmap(var Dest: TBitmap; const Source: TBitmap);
@ -1245,6 +1267,11 @@ begin
GetXBitmap(Dest, Source, gxGreen);
end;
procedure GetGrayscaleBitmap(var Dest: TBitmap; const Source: TBitmap);
begin
GetXBitmap(Dest, source, gxGrayscale);
end;
procedure GetMonochromeBitmap(var Dest: TBitmap; const Source: TBitmap);
begin
if not Assigned(Dest) then
@ -1268,7 +1295,7 @@ begin
GetXBitmap(Dest, Source, gxValue);
end;
(******************* NOT CONVERTED ****
{ (rb) Duplicate of JvAppUtils.AppTaskbarIcons }
procedure HideFormCaption(FormHandle: THandle; Hide: Boolean);