PDA

View Full Version : Scar Plugin giving errors.



jackkat
09-07-2007, 02:14 AM
After seeing all the great implementations of HSL coloring, but not finding a function to search for HSL colors, I decided to try to create a pugin that searches for HSL colors, with tolerance. This is my first time working with delphi, so very little of this code is actually mine, I wrote the myRGBtoHSL part (thanks to freddy for the colorfinding template and testplugin for the overall template)

Here is the code:
//SCAR Plugin. Created for SCAR Divi by Kaitnieks & Freddy1990
// currently you can't call SCAR functions from plugin
library hslSearch;

uses
FastShareMem,
SysUtils,
Classes,
Windows,
Graphics;

{$R *.res}

type
TNumbers = record
n1, n2: Integer;
end;
TRGB32 = packed record
B, G, R, A: Byte;
end;
TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32) - 1] of TRGB32;
PRGB32Array = ^TRGB32Array;

//---------------------------------------
// Functions to be called from SCAR

//demonstration of procedure

procedure myRGBtoHSL(R,G,B:extended; var H,S,L:extended);
var
highest,lowest:extended;
begin
if (r=g) and (g=b) then
begin
h := 0;
s := 0;
l := r;
end else
begin
if (r>=g) and (r>=b) then
begin
highest := r;
if (g>=b) then
begin
lowest := b;
h := 60*((g-b)/(highest-lowest));
end else
begin
lowest := g;
h := 60*((g-b)/(highest-lowest))+360;
end;
end else if (g>=b) and (g>=r) then
begin
highest := g;
if (r>=b) then
begin
lowest := b;
end else
begin
lowest := r;
end;
h := 60*((b-r)/(highest-lowest))+120;
end else
begin
highest := b;
if r>=g then
begin
lowest := g;
end else
begin
lowest := r;
end;
h := 60*((r-g)/(highest-lowest))+240;
end;
l := (highest+lowest)/2;
if (l <= 1/2) then
begin
s := (highest-lowest)/(2*l);
end else
begin
s := (highest-lowest)/(2-2*l);
end;
end;
end;

function FindHSLColorTol(var x, y: Integer; h,s,l,htol,stol,ltol:extended; xs, ys, xe, ye: Integer; Window: Hwnd): Boolean;
var
Bmp: TBitmap; // Bitmap of the client
tmpDC: HDC; // Device context of the client's window handle
Size: TRect; // Rect(angle) of the client's window
cx, cy: Integer; // For-loop vars
Line: PRGB32Array; // The scanline
testh,tests,testl:extended;

begin
Result := False; // In case the color isn't found => Result = False
x := -1; // In case the color isn't found => x = -1
y := -1; // In case the color isn't found => y = -1
Bmp := TBitmap.Create; // We create our bitmap instance
tmpDC := GetWindowDC(window); // We get the device context of the client's window handle
GetWindowRect(Window, Size); // We get the rect(angle) of the client's window
Bmp.Width := Size.Right - Size.Left; // We set the width of our bitmap
Bmp.Height := Size.Bottom - Size.Top; // We set the height of our bitmap
BitBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, tmpDC, 0, 0, SRCCOPY);
// ^^^ We copy the client's canvas onto the bitmap
Bmp.PixelFormat := pf32bit; // We set the bitmap to 32bits
DeleteDC(tmpDC); // We delete the device context to avoid memory leakage
for cy := ys to ye do // Loop for the rows of pixels (y)
begin
if cy >= Bmp.Height then Break; // Break the loop if you reach the end of the bitmap
Line := Bmp.ScanLine[cy]; // We retrieve the scanline (line of pixels) from the bitmap for the current y
for cx := xs to xe do // Loop for the colums of pixels (x)
begin
if cx >= Bmp.Width then Break; // Break the loop if you reach the end of the bitmap
myRGBtoHSL(Line[cx].R/256,Line[cx].G/256,Line[cx].B/256,testH,testS,testL);
if (abs(testH-H) <= Htol) and (abs(tests-s) <= stol) and (abs(testl-l) <= ltol) then
begin // If the color is similar (or for tol 0 the same) then...
Result := True; // Result of the function
x := cx; // Returned x-value
y := cy; // Returned y-value
Line := nil; // Free the scanline to avoid memory leaks
Bmp.Free; // Free the bitmap to avoid memory leaks
Exit; // Exit the function
end;
end;
end;
Line := nil; // Free the scanline to avoid memory leaks
Bmp.Free; // Free the bitmap to avoid memory leaks
end;

//********************************
// Change this accordingly to your function count

function GetFunctionCount(): Integer; stdcall; export;
begin
Result := 2;
end;

//*******************************
// Change this accordingly to your function definitions

function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall;
begin
case x of
0:
begin
ProcAddr := @myRGBtoHSL;
StrPCopy(ProcDef, 'procedure myRGBtoHSL(R,G,B,H,S,L:extended);');
end;
1:
begin
ProcAddr := @FindHSLColorTol;
StrPCopy(ProcDef, 'function FindHSLColorTol(var x, y: Integer; h,s,l,htol,stol,ltol:extended; xs, ys, xe, ye: Integer; Window: Hwnd): Boolean;');
end;
else
x := -1;
end;
Result := x;
end;

//********************************
// Change this accordingly to your type count

function GetTypeCount(): Integer; stdcall; export;
begin
Result := 1;
end;

//*******************************
// Types you want to add

function GetTypeInfo(x: Integer; var sType, sTypeDef: string): Integer; stdcall;
begin
case x of
0:
begin
sType := 'TNumbers';
sTypeDef := 'record n1, n2: Integer; end;';
end;
else
x := -1;
end;
Result := x;
end;

//***************************
// Don't change below this
exports GetFunctionCount;
exports GetFunctionInfo;
exports GetTypeCount;
exports GetTypeInfo;



end.


and I use this script to test it.

program hslSearchTest;
var x,y :integer;
var h,s,l:extended;
begin
myRGBtoHSL(0.5,0.5,0.5,H,S,L);
writeln('H:'+floattostr(h)+' S:'+floattostr(s)+' L:'+floattostr(l));
if FindHSLColorTol( x, y, 16, 100, 50, 1, 0, 0, MSX1, MSY1, MSX2, MSY2, GetClientWindowHandle) then
begin
writeln('X:'+inttostr(x)+' Y:'+inttostr(y));
end else
begin
writeln('Not found.');
end;
end.

The problem is, it doesn't work.
I get this error for the myRGBtoHSL call:
[Runtime Error] : Exception: Access violation at address 017D7796 in module 'hslSearch.dll'. Write of address 00000000 in line 5 in script C:\Program Files\SCAR 3.11\Scripts\RGB HSL\findHSLColortest.scar

And, when i comment that out, I get this for the FingHSLColorTol:
[Runtime Error] : Exception: in line 7 in script C:\Program Files\SCAR 3.11\Scripts\RGB HSL\findHSLColortest.scar

Does anyone know what is going wrong?
Any help would be greatly appreciated, this function should be very useful if it is fast enough.

~Jackkat

mastaraymond
09-07-2007, 06:13 AM
After seeing all the great implementations of HSL coloring, but not finding a function to search for HSL colors, I decided to try to create a pugin that searches for HSL colors, with tolerance. This is my first time working with delphi, so very little of this code is actually mine, I wrote the myRGBtoHSL part (thanks to freddy for the colorfinding template and testplugin for the overall template)

Here is the code:
//SCAR Plugin. Created for SCAR Divi by Kaitnieks & Freddy1990
// currently you can't call SCAR functions from plugin
library hslSearch;

uses
FastShareMem,
SysUtils,
Classes,
Windows,
Graphics;

{$R *.res}

type
TNumbers = record
n1, n2: Integer;
end;
TRGB32 = packed record
B, G, R, A: Byte;
end;
TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32) - 1] of TRGB32;
PRGB32Array = ^TRGB32Array;

//---------------------------------------
// Functions to be called from SCAR

//demonstration of procedure

procedure myRGBtoHSL(R,G,B:extended; var H,S,L:extended);
var
highest,lowest:extended;
begin
if (r=g) and (g=b) then
begin
h := 0;
s := 0;
l := r;
end else
begin
if (r>=g) and (r>=b) then
begin
highest := r;
if (g>=b) then
begin
lowest := b;
h := 60*((g-b)/(highest-lowest));
end else
begin
lowest := g;
h := 60*((g-b)/(highest-lowest))+360;
end;
end else if (g>=b) and (g>=r) then
begin
highest := g;
if (r>=b) then
begin
lowest := b;
end else
begin
lowest := r;
end;
h := 60*((b-r)/(highest-lowest))+120;
end else
begin
highest := b;
if r>=g then
begin
lowest := g;
end else
begin
lowest := r;
end;
h := 60*((r-g)/(highest-lowest))+240;
end;
l := (highest+lowest)/2;
if (l <= 1/2) then
begin
s := (highest-lowest)/(2*l);
end else
begin
s := (highest-lowest)/(2-2*l);
end;
end;
end;

function FindHSLColorTol(var x, y: Integer; h,s,l,htol,stol,ltol:extended; xs, ys, xe, ye: Integer; Window: Hwnd): Boolean;
var
Bmp: TBitmap; // Bitmap of the client
tmpDC: HDC; // Device context of the client's window handle
Size: TRect; // Rect(angle) of the client's window
cx, cy: Integer; // For-loop vars
Line: PRGB32Array; // The scanline
testh,tests,testl:extended;

begin
Result := False; // In case the color isn't found => Result = False
x := -1; // In case the color isn't found => x = -1
y := -1; // In case the color isn't found => y = -1
Bmp := TBitmap.Create; // We create our bitmap instance
tmpDC := GetWindowDC(window); // We get the device context of the client's window handle
GetWindowRect(Window, Size); // We get the rect(angle) of the client's window
Bmp.Width := Size.Right - Size.Left; // We set the width of our bitmap
Bmp.Height := Size.Bottom - Size.Top; // We set the height of our bitmap
BitBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, tmpDC, 0, 0, SRCCOPY);
// ^^^ We copy the client's canvas onto the bitmap
Bmp.PixelFormat := pf32bit; // We set the bitmap to 32bits
DeleteDC(tmpDC); // We delete the device context to avoid memory leakage
for cy := ys to ye do // Loop for the rows of pixels (y)
begin
if cy >= Bmp.Height then Break; // Break the loop if you reach the end of the bitmap
Line := Bmp.ScanLine[cy]; // We retrieve the scanline (line of pixels) from the bitmap for the current y
for cx := xs to xe do // Loop for the colums of pixels (x)
begin
if cx >= Bmp.Width then Break; // Break the loop if you reach the end of the bitmap
myRGBtoHSL(Line[cx].R/256,Line[cx].G/256,Line[cx].B/256,testH,testS,testL);
if (abs(testH-H) <= Htol) and (abs(tests-s) <= stol) and (abs(testl-l) <= ltol) then
begin // If the color is similar (or for tol 0 the same) then...
Result := True; // Result of the function
x := cx; // Returned x-value
y := cy; // Returned y-value
Line := nil; // Free the scanline to avoid memory leaks
Bmp.Free; // Free the bitmap to avoid memory leaks
Exit; // Exit the function
end;
end;
end;
Line := nil; // Free the scanline to avoid memory leaks
Bmp.Free; // Free the bitmap to avoid memory leaks
end;

//********************************
// Change this accordingly to your function count

function GetFunctionCount(): Integer; stdcall; export;
begin
Result := 2;
end;

//*******************************
// Change this accordingly to your function definitions

function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall;
begin
case x of
0:
begin
ProcAddr := @myRGBtoHSL;
StrPCopy(ProcDef, 'procedure myRGBtoHSL(R,G,B,H,S,L:extended);');
end;
1:
begin
ProcAddr := @FindHSLColorTol;
StrPCopy(ProcDef, 'function FindHSLColorTol(var x, y: Integer; h,s,l,htol,stol,ltol:extended; xs, ys, xe, ye: Integer; Window: Hwnd): Boolean;');
end;
else
x := -1;
end;
Result := x;
end;

//********************************
// Change this accordingly to your type count

function GetTypeCount(): Integer; stdcall; export;
begin
Result := 1;
end;

//*******************************
// Types you want to add

function GetTypeInfo(x: Integer; var sType, sTypeDef: string): Integer; stdcall;
begin
case x of
0:
begin
sType := 'TNumbers';
sTypeDef := 'record n1, n2: Integer; end;';
end;
else
x := -1;
end;
Result := x;
end;

//***************************
// Don't change below this
exports GetFunctionCount;
exports GetFunctionInfo;
exports GetTypeCount;
exports GetTypeInfo;



end.


and I use this script to test it.

program hslSearchTest;
var x,y :integer;
var h,s,l:extended;
begin
myRGBtoHSL(0.5,0.5,0.5,H,S,L);
writeln('H:'+floattostr(h)+' S:'+floattostr(s)+' L:'+floattostr(l));
if FindHSLColorTol( x, y, 16, 100, 50, 1, 0, 0, MSX1, MSY1, MSX2, MSY2, GetClientWindowHandle) then
begin
writeln('X:'+inttostr(x)+' Y:'+inttostr(y));
end else
begin
writeln('Not found.');
end;
end.

The problem is, it doesn't work.
I get this error for the myRGBtoHSL call:
[Runtime Error] : Exception: Access violation at address 017D7796 in module 'hslSearch.dll'. Write of address 00000000 in line 5 in script C:\Program Files\SCAR 3.11\Scripts\RGB HSL\findHSLColortest.scar

And, when i comment that out, I get this for the FingHSLColorTol:
[Runtime Error] : Exception: in line 7 in script C:\Program Files\SCAR 3.11\Scripts\RGB HSL\findHSLColortest.scar

Does anyone know what is going wrong?
Any help would be greatly appreciated, this function should be very useful if it is fast enough.

~Jackkat Look at TestPlugin.dpr, *cough* stdcall; *cough*. Btw, that color line function is Freddy's x).

jackkat
09-07-2007, 10:41 AM
Ok, now it works, thanks for that.
I knew it would be something simple like that.

Also, I did give freddy credit:

This is my first time working with delphi, so very little of this code is actually mine, I wrote the myRGBtoHSL part (thanks to freddy for the colorfinding template and testplugin for the overall template)

BTW, the benchmark on my computer for that HSL colorfinding is 47ms, definitely fast enough to be useful.

shaunthasheep
09-10-2007, 10:31 PM
These may help you... :confused:

procedure ColorToleranceSpeed(x: Integer);
Sets the speed of tolerance comparisons. ColorToleranceSpeed(1) is a little slower then 0 but more accurate. ColorToleranceSpeed(0) is faster but not as accurate as 1. ColorToleranceSpeed(2) uses Hue, Saturation and Lightness to determine color similarity.

procedure SetColorspeed2Modifiers(huemodifier, saturationmodifier: Extended);
These work when ColorToleranceSpeed(2) has been set. Normally Tolerance parameter in this mode applies to Luminance directly. For an example, SimilarColors(c1, c2, 10) would work if both colors differ by 10 max luminance. After calling SetColorspeed2Modifiers(0.2, 2) it would mean that SimilarColors(c1, c2, 10) would check for Hue in range of 2 and Saturation in range of 20. Default huemodifier and saturationmodifier is 0.2.