[LAPE] TRecord.Create and Self. problem

[bg5]

I'm not familiar with Lape, so it's my first try:

program new;

type TCol = record
col, tol, cts :integer;
hue, sat : extended;
end;

procedure TCol.Create(Col, Tol, CTS : integer; hue, sat: extended);
begin
Self.col := Col;
Self.Tol := Tol;
Self.cts := CTS;
Self.hue := hue;
Self.sat := sat;
end;
procedure TCol.Create(Col, Tol, CTS : integer); overload;
begin
Self.col := Col;
Self.Tol := Tol;
Self.cts := CTS;
end;

var
CopperCl : TCol;
begin

CopperCl.Create( 3880739 , 7 , 2 , 0.37 , 0.64 );
writeln(CopperCl);

end.

bam!


Compiled successfully in 468 ms.
{COL = 0, TOL = 0, CTS = 0, HUE = 0, SAT = 0}
Successfully executed.

It looks like Self.property works on local copy, not on object itself? How can I do what I want?

[Frement]

Your parameters cant have the same names as the local variables within the record.

Self.Col is the same as the parameter Col. Naming the parameter to _Col or something different, will solve your problems.

[bg5]

Oh, so Self. is even not needed, I changed to:
procedure TCol.Create(_Col, _Tol, _CTS : integer; _hue, _sat: extended);
begin
col := _Col;
Tol := _Tol;
cts := _CTS;
hue := _hue;
sat := _sat;
end;

and it works fine.
Thanks for quick answer :)

[masterBB]

What you are creating looks similar to Janilabos TColorSetting.

[bg5]

We,ve got propably same idea :) I've always felt a need to shorten number of rows in oridinary TPA search and clean up all those CTS2 messes.
Here is the rest of the code, if you would like to read, although I've wrapped only one function, which I use most often in scripts, because I'm not making include, I just wrote it to script faster in my current project.


type TCol = record
col, tol, cts :integer;
hue, sat : extended;
end;

procedure TCol.Create(_Col, _Tol, _CTS : integer; _hue, _sat: extended);
begin
col := _Col;
Tol := _Tol;
cts := _CTS;
hue := _hue;
sat := _sat;
end;
procedure TCol.Create(_Col, _Tol, _CTS : integer); overload;
begin
col := _Col;
Tol := _Tol;
cts := _CTS;
end;

function TCol.FindTPA (var TPA:TPointArray; Box: TBox ): boolean;
var tempCTS : integer;
begin
tempCTS := GetToleranceSpeed();
SetColorToleranceSpeed(Self.cts);
if (Self.cts = 2) then
SetToleranceSpeed2Modifiers(Self.hue, Self.sat);
Result := FindColorsTolerance(TPA,Self.col,Box.x1,Box.y1,Box .x2,Box.y2,Self.tol);
SetColorToleranceSpeed(tempCTS);
end;

function TCol.FindTPA (var TPA:TPointArray ): boolean; overload;
var tempCTS,w,h : integer;
var Box :Tbox;
begin
GetClientDimensions(w,h);
Box := IntToBox(1,1,w-1,h-1);
tempCTS := GetToleranceSpeed();
SetColorToleranceSpeed(Self.cts);
if (Self.cts = 2) then
SetToleranceSpeed2Modifiers(Self.hue, Self.sat);
Result := FindColorsTolerance(TPA,Self.col,Box.x1,Box.y1,Box .x2,Box.y2,Self.tol);
SetColorToleranceSpeed(tempCTS);
end;

[Ashaman88]

Bg there is already tcolorsettings which does the exact same thing :) same with your findtpa (see tpa include file)

But still very nice!

[masterBB]

In SRL 6 this is already included ;)

demonCS := ColorSetting(2, 0.20, 0.10);

...

if (countColorTolerance(color, mainscreen.getBounds(), tol, demonCS) > 20) then

or

if (countColorTolerance(color, mainscreen.getBounds(), tol, ColorSetting(2, 0.20, 0.10)) > 20) then

or


demonCS.Create(2, 0.20, 0.10);

oldCS.retreive();
demonCS.apply();

..

if (countColorTolerance(color, mainscreen.getBounds(), tol) > 20) then


oldCS.apply();

All do the same. Notice how these functions automatically restore old color settings to keep SRL working.