moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2025-02-16 07:10:10 -05:00
Code Issues Releases Wiki Activity

Exported Color Conversions, also added a few conversions.

Browse Source 
Nothing was changed in finder, was just using code hints :|



git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@424 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Nava2 2010-01-18 02:47:56 +00:00
parent 076f12e2c8
commit 1839f12c24
7 changed files with 1016 additions and 1154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1994
Projects/SAMufasaGUI/project1.lpi
View File

File diff suppressed because it is too large Load Diff

9
Projects/SAMufasaGUI/testunit.pas
View File

@ -37,10 +37,9 @@ uses
mmlpsthread,synedittypes,
window, // for the comp picker and selector
colourpicker, framescript, windowselector, lcltype, ActnList, StdActns,
SynExportHTML,
SynEditKeyCmds, SynEditHighlighter, SynEditMarkupSpecialLine,SynEditMarkupHighAll,
SynEditMiscClasses, LMessages, Buttons, PairSplitter,about, framefunctionlist,
ocr, updateform, simbasettings;
SynExportHTML, SynEditKeyCmds, SynEditHighlighter, SynEditMarkupSpecialLine,
SynEditMarkupHighAll, SynEditMiscClasses, LMessages, Buttons, PairSplitter,
ColorBox, about, framefunctionlist, ocr, updateform, simbasettings;
const
SimbaVersion = 423;
@ -202,6 +201,7 @@ type
TB_SelectClient: TToolButton;
ToolButton8: TToolButton;
MTrayIcon: TTrayIcon;
ColorListBox1: TColorListBox;
procedure ActionClearDebugExecute(Sender: TObject);
procedure ActionCloseTabExecute(Sender: TObject);
procedure ActionCopyExecute(Sender: TObject);
@ -1092,6 +1092,7 @@ begin
if CurrScript.SynEdit.CanFocus then
CurrScript.SynEdit.SetFocus;
end;
procedure TForm1.StopCodeCompletion;
begin
if frmFunctionList.InCodeCompletion then

15
Units/MMLAddon/PSInc/Wrappers/colour.inc
View File

@ -50,6 +50,21 @@ begin
CurrThread.Client.MFinder.SetToleranceSpeed(cts);
end;
function GetToleranceSpeed: Integer;
begin
CurrThread.Client.MFinder.GetToleranceSpeed;
end;
procedure SetToleranceSpeed2Modifiers(nHue, nSat: Extended);
begin
CurrThread.Client.MFinder.SetToleranceSpeed2Modifiers(nHue, nSat);
end;
procedure GetToleranceSpeed2Modifiers(out hMod, sMod: Extended);
begin
CurrThread.Client.MFinder.GetToleranceSpeed2Modifiers(hMod, sMod);
end;
function SimilarColors(Col1,Col2,Tol : integer) : boolean;
begin;
Result := CurrThread.Client.MFinder.SimilarColors(Col1,Col2,Tol);

55
Units/MMLAddon/PSInc/psexportedmethods.inc
View File

@ -55,8 +55,8 @@ AddFunction(@ps_RandomRange,'function RandomRange(aFrom,aTo: Integer): Integer;'
{window}
SetCurrSection('Window');
AddFunction(@Freeze, 'function freeze:boolean;');
AddFunction(@Unfreeze, 'function unfreeze: boolean;');
AddFunction(@Freeze, 'function Freeze:boolean;');
AddFunction(@Unfreeze, 'function Unfreeze: boolean;');
AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(out w, h:integer);');
AddFunction(@SetTargetBitmap,'procedure SetTargetBitmap(Bitmap : integer);');
AddFunction(@SetDesktopAsClient,'procedure SetDesktopAsClient');
@ -84,13 +84,13 @@ AddFunction(@psWait, 'procedure Sleep(t: integer);');
AddFunction(@GetTickCount, 'function GetSystemTime: LongWord;');
AddFunction(@GetTickCount, 'function GetTickCount: LongWord;');
AddFunction(@GetTimeRunning,'function GetTimeRunning: LongWord;');
AddFunction(@ConvertTime,'procedure ConvertTime(Time : integer; var h,m,s : integer);');
AddFunction(@ConvertTime,'procedure ConvertTime(Time: integer; var h, m, s: integer);');
AddFunction(@HakunaMatata,'procedure HakunaMatata;');
AddFunction(@TerminateScript,'procedure TerminateScript;');
AddFunction(@DisplayDebugImgWindow,'procedure DisplayDebugImgWindow(w,h : integer);');
AddFunction(@DrawBitmapDebugImg,'procedure DrawBitmapDebugImg(bmp : integer);');
AddFunction(@GetDebugBitmap,'function GetDebugBitmap : integer;');
AddFunction(@Random,'function Random(Int : integer): integer;');
AddFunction(@DisplayDebugImgWindow,'procedure DisplayDebugImgWindow(w, h: integer);');
AddFunction(@DrawBitmapDebugImg,'procedure DrawBitmapDebugImg(bmp: integer);');
AddFunction(@GetDebugBitmap,'function GetDebugBitmap: integer;');
AddFunction(@Random,'function Random(Int: integer): integer;');
AddFunction(@NewThreadCall,'function NewThreadCall(procname : string) : cardinal');
@ -105,24 +105,39 @@ AddFunction(@OpenWebPage,'procedure OpenWebPage(url : string);');
AddFunction(@ps_GetPage,'function GetPage(url : string): string;');
{Color + Color Finders}
{ Color Conversions and Speed }
SetCurrSection('Color Convert');
AddFunction(@ColorToRGB, 'procedure ColorToRGB(Color: integer; out r, g, b: Integer);');
AddFunction(@RGBToColor, 'function RGBtoColor(r, g, b: integer): TColor;');
AddFunction(@ColorToHSL, 'procedure ColorToHSL(Color: Integer; out h, s, l: Extended);');
AddFunction(@HSLToColor, 'function HSLToColor(H, S, L: Extended): TColor;');
AddFunction(@ColorToXYZ, 'procedure ColorToXYZ(Color: Integer; out x, y, z: Extended);');
AddFunction(@XYZToColor, 'function XYZToColor(X, Y, Z: Extended): TColor;');
AddFunction(@RGBToHSL, 'procedure RGBToHSL(R, G, B: Integer; out h, s, l: Extended);');
AddFunction(@HSLToRGB, 'procedure HSLtoRGB(H, S, L: extended; out R, G ,B: Integer);');
AddFunction(@RGBToXYZ, 'procedure RGBToXYZ(R, G, B: Integer;out x, y ,z: Extended);');
AddFunction(@XYZToRGB, 'procedure XYZToRGB(X, Y, Z: Extended; out R, G, B: integer);');
{ Color Finding }
SetCurrSection('Color');
AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
AddFunction(@GetToleranceSpeed, 'function GetToleranceSpeed: Integer;');
AddFunction(@SetToleranceSpeed2Modifiers, 'procedure SetToleranceSpeed2Modifiers(nHue, nSat: Extended);');
AddFunction(@GetToleranceSpeed2Modifiers, 'procedure GetToleranceSpeed2Modifiers(out hMod, sMod: Extended);');
AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;');
AddFunction(@FindColor, 'function findcolor(out x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
AddFunction(@findcolortoleranceOptimised, 'function findcolortoleranceOptimised(out x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
AddFunction(@FindColorTolerance, 'function findcolortolerance(out x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
AddFunction(@FindColors, 'function findcolors(out TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;');
AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean');
AddFunction(@FindColor, 'function FindColor(out x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
AddFunction(@findcolortoleranceOptimised, 'function FindColorToleranceOptimised(out x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
AddFunction(@FindColorTolerance, 'function FindColorTolerance(out x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
AddFunction(@FindColors, 'function FindColors(out TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;');
AddFunction(@SimilarColors,'function SimilarColors(Col1, Col2, Tolerance: integer): boolean');
AddFunction(@CountColor,'function CountColor(Color, xs, ys, xe, ye: Integer): Integer;');
AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;');
AddFunction(@FindColorsToleranceOptimised,'function FindColorsToleranceOptimised(out Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;');
AddFunction(@FindColorsTolerance,'function FindColorsTolerance(out Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;');
AddFunction(@FindColorSpiral,'function FindColorSpiral(var x, y: Integer; color, xs, ys, xe, ye: Integer): Boolean;');
AddFunction(@FindColorsSpiralTolerance,'function FindColorsSpiralTolerance(x, y: Integer; out Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean;');
AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
AddFunction(@FindColoredArea, 'function FindColoredArea(var x, y : Integer; color, xs, ys, xe, ye, MinArea : Integer): Boolean');
AddFunction(@FindColoredArea, 'function FindColoredArea(var x, y: Integer; color, xs, ys, xe, ye, MinArea: Integer): Boolean');
AddFunction(@FindColoredAreaTolerance, 'function FindColoredAreaTolerance(var x, y : Integer; color, xs, ys, xe, ye, MinArea, Tolerance : Integer): Boolean');
AddFunction(@ColorToHSL, 'procedure ColorToHSL(c: integer; out r,g,b: extended);');
{Mouse etc.}
SetCurrSection('Mouse');
@ -139,7 +154,7 @@ AddFunction(@KeyDown, 'procedure KeyDown(key: Word);');
AddFunction(@KeyUp, 'procedure KeyUp(key: Word);');
AddFunction(@PressKey, 'procedure PressKey(key: Word);');
AddFunction(@SendKeys, 'procedure SendKeys(s: string);');
AddFunction(@isKeyDown, 'function isKeyDown(key: Word): Boolean;');
AddFunction(@isKeyDown, 'function IsKeyDown(key: Word): Boolean;');
AddFunction(@GetKeyCode, 'function GetKeyCode(Key : char) : byte');
{ OCR}
@ -190,9 +205,9 @@ AddFunction(@CreateBitmapMask,'function CreateBitmapMask(Bitmap : integer) : TMa
AddFunction(@FindMaskTolerance,'function FindMaskTolerance(mask: TMask; out x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
AddFunction(@FindBitmapMaskTolerance,'function FindBitmapMaskTolerance(mask: Integer; out x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
AddFunction(@FindDeformedBitmapToleranceIn,'function FindDeformedBitmapToleranceIn(bitmap: integer; out x,y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; out accuracy: Extended): Boolean;');
AddFunction(@DrawTPABitmap,'procedure DrawTPABitmap(bitmap : integer; TPA : TPointArray; Color : integer);');
AddFunction(@DrawATPABitmap,'procedure DrawATPABitmap(bitmap : integer; ATPA : T2DPointArray);');
AddFunction(@DrawATPABitmapEx,'procedure DrawATPABitmapEx(bitmap : integer; ATPA : T2DPointArray; Colors : TIntegerArray);');
AddFunction(@DrawTPABitmap,'procedure DrawTPABitmap(bitmap: integer; TPA: TPointArray; Color: integer);');
AddFunction(@DrawATPABitmap,'procedure DrawATPABitmap(bitmap: integer; ATPA: T2DPointArray);');
AddFunction(@DrawATPABitmapEx,'procedure DrawATPABitmapEx(bitmap: integer; ATPA: T2DPointArray; Colors: TIntegerArray);');
{tpa}
SetCurrSection('TPA');

44
Units/MMLAddon/newinternets.pas
View File

@ -8,6 +8,9 @@ uses
Classes, SysUtils;
type
{
Record to hold the information of a $_POST variable and value.
}
TPostVariable = record
variable, value: String;
end;
@ -21,35 +24,30 @@ type
ConnURL: String;
//contains post paramaters and vars
PostVars: TList;
PostFreeSpots: array of Integer;
PostVarsLen, PostVarsHigh, FreeSpotsHigh, FreeSpotsLen : integer;
private
function createPostVariable(variable, value: String): TPostVariable;
public
constructor Create(URL: String);
destructor Destroy; override;
//POST variable functions for PHP transmission
//$_POST variable functions for PHP transmission
procedure AddPostVariable(theVar, theValue: String);
procedure DelPostVariable(theVar: String);
procedure ReplacePostVariable(searchVar, replaceVar, value: String);
function PostHTTP(out dataStream: TStream): Boolean;
end;
TInternetArray = class(TObject)
TMufasaInternet = class(TObject)
protected
FreeSpots: array of Integer;
// TList storing all of the connection infos
ConnList : TList;
ConnArray: array of TInternetConnection;
ConnHigh, FreeSpotsHigh, FreeSpotsLen : integer;
public
function ConnectionOpen(URL: String): Integer;
function ConnectionClose(ConnInd: Integer): Boolean;
destructor Destroy; override;
//POST variable functions for PHP transmission
//$_POST variable functions for PHP
procedure AddPostVariable(connInd: Integer; theVar, theValue: String);
procedure DelPostVariable(connInd: Integer; theVar: String);
procedure ReplacePostVariable(connInd: Integer; searchVar, replaceVar, value: String);
@ -60,7 +58,7 @@ function GetPage(URL: String): String;
implementation
uses
httpsend;
httpsend, synacode;
function replace(sStr, rStr, iStr: String): String;
@ -80,7 +78,7 @@ end;
procedure TInternetConnection.Create(URL: String);
begin
inherited;
Self.ConnURL := URL;
Self.ConnURL := EncodeURL(URL);
Self.PostVars.Create;
end;
@ -97,8 +95,8 @@ procedure TInternetConnect.AddPostVariable(theVar, theValue: String);
var
currentIndex: Integer;
begin
theVar := replace(' ', '%20', theVar); // more needs to be done, I only knew the ' ' replace.
theValue := replace(' ', '%20', theValue);
theVar := EncodeURLElement(theVar);
theValue := EncodeURLElement(theValue);
Self.PostVars.Add(createPostVariable(theVar, theValue));
{ with Self do
begin
@ -179,7 +177,7 @@ begin
Delete(URLData, Length(URLData) - 1, 1);
{I DONT KNOW (TStream), this should work since we don't reuse it after.}
dataStream := nil;
dataStream := TStream.Create;
HttpPostURL(ConnURL, URLData, dataStream);
// Lets remove all Post Variable data so fresh start next time.
@ -192,12 +190,12 @@ begin
result := true;
end;
{ TInternetArray }
{ TMufasaInternet }
{
Allocate space in the ConnArray, then open the connection.
}
function TInternetArray.ConnectionOpen(URL: String): Integer;
function TMufasaInternet.ConnectionOpen(URL: String): Integer;
var
currentIndex: Integer;
begin
@ -212,7 +210,7 @@ end;
{
Close the connection, add the index to the FreeSpots.
}
function TInternetArray.ConnectionClose(theInd: Integer): Boolean;
function TMufasaInternet.ConnectionClose(theInd: Integer): Boolean;
var
tempConn: TInternetConnection;
begin
@ -243,7 +241,7 @@ end;
Wrapper for the TInternetConnection.PostVariableAdd procedure which accepts
a connection index.
}
procedure TInternetArray.PostVariableAdd(connInd: Integer; theVar, theValue: String);
procedure TMufasaInternet.PostVariableAdd(connInd: Integer; theVar, theValue: String);
begin
try
ConnList.Items[commInd].PostVariableAdd(theVar, theValue);
@ -257,7 +255,7 @@ end;
Wrapper for the TInternetConnection.PostVariableDel procedure which accepts
a connection index.
}
procedure TInternetArray.PostVariableDel(connInd: Integer; theVar: String);
procedure TMufasaInternet.PostVariableDel(connInd: Integer; theVar: String);
begin
try
ConnList.Items[commInd].PostVariableAdd(theVar);
@ -271,7 +269,7 @@ end;
Wrapper for the TInternetConnection.PostVariableReplace procedure which accepts
a connection index.
}
procedure TInternetArray.PostVariableReplace(connInd: Integer; searchVar, replaceVar, value: String);
procedure TMufasaInternet.PostVariableReplace(connInd: Integer; searchVar, replaceVar, value: String);
begin
try
ConnList.Items[commInd].PostVariableAdd(searchVar, replaceVar, value);
@ -281,7 +279,7 @@ begin
end;
end;
function TInternetArray.PostHTTP(connInd: Integer; out dataStream: TStream): Boolean;
function TMufasaInternet.PostHTTP(connInd: Integer; out dataStream: TStream): Boolean;
begin
try
result := ConnList.Items[commInd].PostHTTP(dataStream);

29
Units/MMLCore/colour_conv.pas
View File

@ -44,6 +44,10 @@ Procedure RGBToHSLNonFixed(RR,GG,BB : integer;out H,S,L : Extended); inline;
Procedure HSLtoRGB(H,S,L : extended;out R,G,B : Byte); inline;overload;
Procedure HSLtoRGB(H,S,L : extended;out R,G,B : Integer); inline;overload;
Procedure ColorToHSL(Col: Integer; out h, s, l: Extended); inline;
procedure ColorToXYZ(color: Integer; out X, Y, Z: Extended); inline;
function XYZToColor(X, Y, Z: Extended): TColor; inline;
function HSLToColor(H, S, L: Extended): TColor; inline;
implementation
@ -345,5 +349,28 @@ Begin
RGBToHSL(R, G, B, H, S, L);
End;
end.
procedure ColorToXYZ(color: Integer; out X, Y, Z: Extended); inline;
var
R, G, B: Integer;
begin
ColorToRGB(Color, R, G, B);
RGBToXYZ(R, G, B, X, Y, Z);
end;
function HSLToColor(H, S, L: Extended): TColor; inline;
var
r, g, b: Integer;
begin
HSLToRGB(H, S, L, r, g, b);
Result := RGBToColor(r, g, b);
end;
function XYZToColor(X, Y, Z: Extended): TColor; inline;
var
r, g, b: Integer;
begin
XYZToRGB(X, Y, Z, r, g, b);
Result := RGBToColor(r, g, b);
end;
end.

24
Units/MMLCore/finder.pas
View File

@ -58,7 +58,6 @@ type
xe, ye, tol: Integer): Boolean;
function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;
function CountColor(Color, xs, ys, xe, ye: Integer): Integer;
procedure SetToleranceSpeed(nCTS: Integer);
function SimilarColors(Color1,Color2,Tolerance : Integer) : boolean;
// Possibly turn x, y into a TPoint var.
function FindColor(out x, y: Integer; Color, xs, ys, xe, ye: Integer): Boolean;
@ -86,7 +85,11 @@ type
function FindDTMRotated(DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;
function FindDTMsRotated(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray; maxToFind: Integer): Boolean;
// tol speeds
procedure SetToleranceSpeed(nCTS: Integer);
function GetToleranceSpeed: Integer;
procedure SetToleranceSpeed2Modifiers(nHue, nSat: Extended);
procedure GetToleranceSpeed2Modifiers(out hMod, sMod: Extended);
protected
Client: TObject;
Percentage : array[0..255] of Extended; //We store all the possible RGB / 255 divisions.
@ -269,6 +272,23 @@ begin
Self.CTS := nCTS;
end;
function TMFinder.GetToleranceSpeed: Integer;
begin
Result := Self.CTS;
end;
procedure TMFinder.SetToleranceSpeed2Modifiers(nHue, nSat: Extended);
begin
Self.hueMod := nHue;
Self.satMod := nSat;
end;
procedure TMFinder.GetToleranceSpeed2Modifiers(out hMod, sMod: Extended);
begin
hMod := Self.hueMod;
sMod := Self.satMod;
end;
function TMFinder.SimilarColors(Color1, Color2,Tolerance: Integer) : boolean;
var
R1,G1,B1,R2,G2,B2 : Byte;