mirror of
https://github.com/moparisthebest/Simba
synced 2025-02-07 02:30:19 -05:00
Made some changes!
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@33 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond
parent
036f11e249
commit
acfe2a5232
@ -10,9 +10,9 @@ object Form1: TForm1
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '0.9.29'
|
||||
object Button1: TButton
|
||||
Left = 69
|
||||
Left = 8
|
||||
Height = 25
|
||||
Top = 32
|
||||
Top = 16
|
||||
Width = 75
|
||||
Caption = 'Button1'
|
||||
OnClick = Button1Click
|
||||
|
||||
@ -1,10 +1,10 @@
|
||||
{ This is an automatically generated lazarus resource file }
|
||||
|
||||
LazarusResources.Add('TForm1','FORMDATA',[
|
||||
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#237#0#6'Height'#3#15#2#3'Top'#3#190#0#5'W'
|
||||
+'idth'#3#11#3#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#12'Client'
|
||||
+'Height'#3#15#2#11'ClientWidth'#3#11#3#8'Position'#7#14'poScreenCenter'#10'L'
|
||||
+'CLVersion'#6#6'0.9.29'#0#7'TButton'#7'Button1'#4'Left'#2'E'#6'Height'#2#25#3
|
||||
+'Top'#2' '#5'Width'#2'K'#7'Caption'#6#7'Button1'#7'OnClick'#7#12'Button1Clic'
|
||||
+'k'#8'TabOrder'#2#0#0#0#0
|
||||
]);
|
||||
|
||||
LazarusResources.Add('TForm1','FORMDATA',[
|
||||
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#237#0#6'Height'#3#15#2#3'Top'#3#190#0#5'W'
|
||||
+'idth'#3#11#3#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#12'Client'
|
||||
+'Height'#3#15#2#11'ClientWidth'#3#11#3#8'Position'#7#14'poScreenCenter'#10'L'
|
||||
+'CLVersion'#6#6'0.9.29'#0#7'TButton'#7'Button1'#4'Left'#2#8#6'Height'#2#25#3
|
||||
+'Top'#2#16#5'Width'#2'K'#7'Caption'#6#7'Button1'#7'OnClick'#7#12'Button1Clic'
|
||||
+'k'#8'TabOrder'#2#0#0#0#0
|
||||
]);
|
||||
|
||||
@ -1,110 +1,149 @@
|
||||
unit finder;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
{ TMFinder Class }
|
||||
|
||||
{
|
||||
Should be 100% independant, as all platform dependant code is in the
|
||||
Window and Input classes.
|
||||
|
||||
Let's try not to use any OS-specific defines here? ;)
|
||||
}
|
||||
|
||||
type
|
||||
TMFinder = class(TObject)
|
||||
constructor Create(aClient: TObject);
|
||||
destructor Destroy; override;
|
||||
public
|
||||
// Possibly turn x, y into a TPoint var.
|
||||
function FindColor(var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean;
|
||||
protected
|
||||
Client: TObject;
|
||||
private
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
Client, // For the Client Casts.
|
||||
MufasaTypes // Types
|
||||
;
|
||||
|
||||
constructor TMFinder.Create(aClient: TObject);
|
||||
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
Self.Client := aClient;
|
||||
|
||||
end;
|
||||
|
||||
destructor TMFinder.Destroy;
|
||||
begin
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TMFinder.FindColor(Var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean;
|
||||
var
|
||||
PtrData: TRetData;
|
||||
Ptr: PRGB32;
|
||||
PtrInc: Integer;
|
||||
dX, dY, clR, clG, clB, xx, yy: Integer;
|
||||
|
||||
begin
|
||||
|
||||
// checks for valid x1,y1,x2,y2? (may involve GetDimensions)
|
||||
|
||||
{if bla > bla) then etc }
|
||||
|
||||
// calculate delta x and y
|
||||
dX := x2 - x1;
|
||||
dY := y2 - y1;
|
||||
//next, convert the color to r,g,b
|
||||
{
|
||||
ColorToRGB(Color, clR, clG, clB);
|
||||
}
|
||||
|
||||
PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX, dY);
|
||||
|
||||
// Do we want to "cache" these vars?
|
||||
// We will, for now. Easier to type.
|
||||
Ptr := PtrData.Ptr;
|
||||
PtrInc := PtrData.IncPtrWith;
|
||||
|
||||
for yy := 0 to dY do
|
||||
begin
|
||||
for xx := 0 to dX do
|
||||
begin
|
||||
// Colour comparison here. Possibly with tolerance? ;)
|
||||
if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then
|
||||
begin
|
||||
{
|
||||
If we are only looking for one colour, result = true, free data, exit.
|
||||
|
||||
Else, add to the "hit" tpa, and increate the count.
|
||||
}
|
||||
|
||||
Result := True;
|
||||
x := xx;
|
||||
y := yy;
|
||||
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
Exit;
|
||||
end;
|
||||
Inc(Ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc)
|
||||
end;
|
||||
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
unit finder;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, MufasaTypes; // Types
|
||||
|
||||
{ TMFinder Class }
|
||||
|
||||
{
|
||||
Should be 100% independant, as all platform dependant code is in the
|
||||
Window and Input classes.
|
||||
|
||||
Let's try not to use any OS-specific defines here? ;)
|
||||
}
|
||||
|
||||
type
|
||||
TMFinder = class(TObject)
|
||||
constructor Create(aClient: TObject);
|
||||
destructor Destroy; override;
|
||||
private
|
||||
Procedure UpdateCachedValues(NewWidth,NewHeight : integer);
|
||||
procedure DefaultOperations(var x1,y1,x2,y2 : integer);
|
||||
public
|
||||
// Possibly turn x, y into a TPoint var.
|
||||
function FindColor(var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean;
|
||||
protected
|
||||
Client: TObject;
|
||||
CachedWidth, CachedHeight : integer;
|
||||
ClientTPA : TPointArray;
|
||||
//CTS : integer;
|
||||
|
||||
private
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
Client; // For the Client Casts.
|
||||
|
||||
|
||||
constructor TMFinder.Create(aClient: TObject);
|
||||
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
Self.Client := aClient;
|
||||
|
||||
end;
|
||||
|
||||
destructor TMFinder.Destroy;
|
||||
begin
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TMFinder.UpdateCachedValues(NewWidth, NewHeight: integer);
|
||||
begin
|
||||
CachedWidth := NewWidth;
|
||||
CachedHeight := NewHeight;
|
||||
SetLength(ClientTPA,NewWidth * NewHeight);
|
||||
end;
|
||||
|
||||
procedure TMFinder.DefaultOperations(var x1, y1, x2, y2: integer);
|
||||
var
|
||||
w,h : integer;
|
||||
begin
|
||||
{ if x1 > x2 then
|
||||
Swap(x1,x2);
|
||||
if y1 > y2 then
|
||||
Swap(y1,y2);}
|
||||
if x1 < 0 then
|
||||
x1 := 0;
|
||||
if y1 < 0 then
|
||||
y1 := 0;
|
||||
TClient(Self.Client).MWindow.GetDimensions(w,h);
|
||||
if (w <> CachedWidth) or (h <> CachedHeight) then
|
||||
UpdateCachedValues(w,h);
|
||||
if x2 >= w then
|
||||
x2 := w-1;
|
||||
if y2 >= h then
|
||||
y2 := h-1;
|
||||
end;
|
||||
|
||||
function TMFinder.FindColor(var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean;
|
||||
var
|
||||
PtrData: TRetData;
|
||||
Ptr: PRGB32;
|
||||
PtrInc: Integer;
|
||||
dX, dY, clR, clG, clB, xx, yy: Integer;
|
||||
|
||||
begin
|
||||
|
||||
// checks for valid x1,y1,x2,y2? (may involve GetDimensions)
|
||||
DefaultOperations(x1,y1,x2,y2);
|
||||
|
||||
// calculate delta x and y
|
||||
dX := x2 - x1;
|
||||
dY := y2 - y1;
|
||||
//next, convert the color to r,g,b
|
||||
{
|
||||
ColorToRGB(Color, clR, clG, clB);
|
||||
}
|
||||
|
||||
PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1);
|
||||
|
||||
// Do we want to "cache" these vars?
|
||||
// We will, for now. Easier to type.
|
||||
Ptr := PtrData.Ptr;
|
||||
PtrInc := PtrData.IncPtrWith;
|
||||
|
||||
{ for yy := 0 to dY do
|
||||
begin
|
||||
for xx := 0 to dX do
|
||||
begin}
|
||||
//Since we do an Inc on the Ptr, no need to start with an y:=0 value, unless it's faster ofcourse.
|
||||
for yy := y1 to y2 do
|
||||
begin;
|
||||
for xx := x1 to x2 do
|
||||
begin;
|
||||
// Colour comparison here. Possibly with tolerance? ;)
|
||||
if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then
|
||||
begin
|
||||
{
|
||||
If we are only looking for one colour, result = true, free data, exit.
|
||||
|
||||
Else, add to the "hit" tpa, and increate the count.
|
||||
Note to Wizzuop: FindColor doesnt have a TPA, dummy.
|
||||
}
|
||||
|
||||
Result := True;
|
||||
x := xx;
|
||||
y := yy;
|
||||
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
Exit;
|
||||
end;
|
||||
Inc(Ptr);
|
||||
end;
|
||||
Inc(Ptr, PtrInc)
|
||||
end;
|
||||
|
||||
TClient(Client).MWindow.FreeReturnData;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -22,7 +22,7 @@ type
|
||||
TTargetWindowMode = (w_BMP, w_Window, w_HDC, w_ArrayPtr, w_XWindow);
|
||||
TClickType = (mouse_Left, mouse_Right, mouse_Middle);
|
||||
TMousePress = (mouse_Down, mouse_Up);
|
||||
|
||||
TPointArray = array of TPoint;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
Loading…
Reference in New Issue
Block a user