From acfe2a5232454528209a2419d1f79ae47747e811 Mon Sep 17 00:00:00 2001 From: Raymond Date: Sat, 5 Sep 2009 20:33:20 +0000 Subject: [PATCH] Made some changes! git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@33 3f818213-9676-44b0-a9b4-5e4c4e03d09d --- Projects/SAMufasaGUI/testunit.lfm | 4 +- Projects/SAMufasaGUI/testunit.lrs | 18 +-- Units/MMLCore/finder.pas | 259 +++++++++++++++++------------- Units/MMLCore/mufasatypes.pas | 2 +- 4 files changed, 161 insertions(+), 122 deletions(-) diff --git a/Projects/SAMufasaGUI/testunit.lfm b/Projects/SAMufasaGUI/testunit.lfm index 5c20dbe..f81a6ce 100644 --- a/Projects/SAMufasaGUI/testunit.lfm +++ b/Projects/SAMufasaGUI/testunit.lfm @@ -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 diff --git a/Projects/SAMufasaGUI/testunit.lrs b/Projects/SAMufasaGUI/testunit.lrs index 12f28f7..47a086f 100644 --- a/Projects/SAMufasaGUI/testunit.lrs +++ b/Projects/SAMufasaGUI/testunit.lrs @@ -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 +]); diff --git a/Units/MMLCore/finder.pas b/Units/MMLCore/finder.pas index 8cb4ae8..f838335 100644 --- a/Units/MMLCore/finder.pas +++ b/Units/MMLCore/finder.pas @@ -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. + diff --git a/Units/MMLCore/mufasatypes.pas b/Units/MMLCore/mufasatypes.pas index 0283d61..eb2030b 100644 --- a/Units/MMLCore/mufasatypes.pas +++ b/Units/MMLCore/mufasatypes.pas @@ -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