moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-08-13 16:53:59 -04:00
Code Issues Releases Wiki Activity

Please use svn:eol-style native for every new file.

Browse Source 
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@160 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Wizzup? 2009-10-27 01:03:37 +00:00
parent bf4e1e5a69
commit 4157568bde
8 changed files with 3220 additions and 3220 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

510
Units/MMLAddon/PSInc/Wrappers/bitmap.inc
View File

@ -1,255 +1,255 @@
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
Bitmap.inc for the Mufasa Macro Library
}
function CreateBitmap(w,h : integer):integer;
begin
result := CurrThread.Client.MBitmaps.CreateBMP(w,h);
end;
procedure FreeBitmap(Number : integer);
begin
CurrThread.Client.MBitmaps.FreeBMP(Number);
end;
procedure SaveBitmap(Bmp : integer; path : string);
begin;
CurrThread.Client.MBitmaps.Bmp[Bmp].SaveToFile(Path);
end;
function BitmapFromString(Width,height : integer; Data : string) : integer;
begin;
Result := CurrThread.Client.MBitmaps.CreateBMPFromString(Width,Height,Data);
end;
function LoadBitmap(Path : String) : integer;
begin;
Result := CurrThread.Client.MBitmaps.CreateBMPFromFile(Path);
end;
procedure SetBitmapSize(Bmp,NewW,NewH : integer);
begin;
if (NewW>=0) and (NewH >=0) then
CurrThread.Client.MBitmaps.Bmp[Bmp].SetSize(NewW,NewH)
else
raise exception.createfmt('Wrong Width or Height in SetBitmapSize: (%d,%d)',[NewW,NewH]);
end;
procedure StretchBitmapResize(Bmp,NewW,NewH : integer);
begin;
if (NewW>=0) and (NewH >=0) then
CurrThread.Client.MBitmaps.Bmp[Bmp].StretchResize(NewW,NewH)
else
raise exception.createfmt('Wrong Width or Height in ScretchResize: (%d,%d)',[NewW,NewH]);
end;
procedure GetBitmapSize(Bmp : integer; var BmpW,BmpH : integer);
begin;
With CurrThread.Client.MBitmaps.Bmp[bmp] do
begin;
BmpW := width;
BmpH := Height;
end;
end;
procedure SetBitmapName(Bmp : integer; name : string);
begin;
CurrThread.Client.MBitmaps.Bmp[Bmp].BmpName:= name;
end;
function CreateMirroredBitmap(Bmp : integer) : integer;
begin;
Result := CurrThread.Client.MBitmaps.CreateMirroredBitmap(Bmp, MirrorWidth);
end;
function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;
begin;
Result := CurrThread.Client.MBitmaps.CreateMirroredBitmap(Bmp,MirrorStyle);
end;
function FastGetPixel(bmp,x,y : integer) : LongWord;
begin;
Result := CurrThread.Client.MBitmaps.Bmp[Bmp].FastGetPixel(x,y);
end;
function FastGetPixels(bmp : integer; TPA : TPointArray) : TIntegerArray;
begin;
result := CurrThread.Client.MBitmaps.Bmp[Bmp].FastGetPixels(TPA);
end;
procedure FastSetPixel(Bmp,x,y : integer; Color : TColor);
begin
CurrThread.Client.MBitmaps.Bmp[bmp].FastSetPixel(x,y,color);
end;
procedure FastSetPixels(Bmp : integer; TPA : TPointArray; Colors : TIntegerArray);
begin;
CurrThread.Client.MBitmaps.Bmp[Bmp].FastSetPixels(TPA,Colors);
end;
procedure FastDrawClear(bmp : integer; Color : TColor);
begin;
CurrThread.Client.MBitmaps.Bmp[bmp].FastDrawClear(Color);
end;
procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);
begin;
CurrThread.Client.MBitmaps.Bmp[SourceBitmap].FastDrawTransparent(x,y,CurrThread.Client.MBitmaps.Bmp[TargetBitmap]);
end;
procedure SetTransparentColor(Bmp : integer; Color : TColor);
begin
CurrThread.Client.MBitmaps.Bmp[Bmp].SetTransparentColor(Color);
end;
function GetTransparentColor(Bmp : integer) : TColor;
begin;
Result := CurrThread.Client.MBitmaps.Bmp[bmp].GetTransparentColor;
end;
procedure FastReplaceColor(bmp: Integer; OldColor, NewColor: TColor);
begin
CurrThread.Client.MBitmaps.Bmp[Bmp].FastReplaceColor(OldColor,NewColor);
end;
procedure ps_CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer);
begin
CurrThread.Client.MBitmaps.GetBMP(bmp).CopyClientToBitmap(CurrThread.Client.MWindow, xs, ys, xe, ye);
end;
function FindBitmap(Bitmap: integer; var x, y: Integer): Boolean;
begin;
with CurrThread.Client do
result := MFinder.FindBitmap( MBitmaps.Bmp[bitmap],x,y);
end;
function FindBitmapIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;
begin;
with CurrThread.Client do
result := MFinder.FindBitmapIn( MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye);
end;
function FindBitmapToleranceIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean;
begin;
with CurrThread.Client do
result := MFinder.FindBitmapToleranceIn( MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye,tolerance);
end;
function FindBitmapSpiral(bitmap: Integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;
begin;
with CurrThread.Client do
result := MFinder.FindBitmapSpiral(Mbitmaps.bmp[bitmap],x,y,xs,ys,xe,ye);
end;
function FindBitmapsSpiralTolerance(bitmap: integer; x, y: Integer; var Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean;
begin;
with CurrThread.Client do
result := MFinder.FindBitmapsSpiralTolerance(MBitmaps.Bmp[bitmap],x,y,points,xs,ys,xe,ye,tolerance);
end;
function FindBitmapSpiralTolerance(bitmap: integer; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean;
begin;
with CurrThread.Client do
result := MFinder.FindBitmapSpiralTolerance(MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye,tolerance);
end;
function RotateBitmap(bitmap: Integer; angle: Extended): Integer;
begin;
with CurrThread.Client.MBitmaps do
begin;
Result := CreateBMP(0,0);
Bmp[Bitmap].RotateBitmap(angle,Bmp[result]);
end;
end;
function Desaturate(Bitmap : integer) : integer;
begin;
with CurrThread.Client.MBitmaps do
begin;
result := CreateBMP(0,0);
Bmp[Bitmap].Desaturate(Bmp[result]);
end;
end;
procedure InvertBitmap(Bitmap : integer);
begin;
CurrThread.Client.MBitmaps.Bmp[Bitmap].Invert;
end;
function CopyBitmap(Bitmap : integer) : integer;
begin;
result := Currthread.Client.MBitmaps.CopyBMP(bitmap);
end;
function GreyScaleBitmap(Bitmap : integer) : integer;
begin;
with CurrThread.Client.MBitmaps do
begin;
result := CreateBMP(0,0);
Bmp[Bitmap].GreyScale(Bmp[result]);
end;
end;
function BrightnessBitmap(Bitmap,br : integer) : integer;
begin;
with CurrThread.Client.MBitmaps do
begin;
result := CreateBMP(0,0);
Bmp[Bitmap].Brightness(Bmp[result],br);
end;
end;
function ContrastBitmap(bitmap : integer; co : extended) : integer;
begin;
with CurrThread.Client.MBitmaps do
begin;
result := CreateBMP(0,0);
Bmp[Bitmap].Contrast(Bmp[result],co);
end;
end;
function PosterizeBitmap(Bitmap : integer; po : integer) : integer;
begin;
with CurrThread.Client.MBitmaps do
begin
result := CreateBMP(0,0);
Bmp[bitmap].Posterize(Bmp[result],po);
end;
end;
function CreateBitmapMask(Bitmap : integer) : TMask;
begin;
result := CurrThread.Client.MBitmaps.Bmp[Bitmap].CreateTMask;
end;
function FindMaskTolerance(mask: TMask; var x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;
begin;
result := CurrThread.Client.MFinder.FindBitmapMaskTolerance(Mask,x,y,xs,ys,xe,ye,tolerance,contourtolerance);
end;
function FindBitmapMaskTolerance(mask: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;
begin;
Writeln('Better be using FindMaskTolerance in combination with CreateBitmapMask, more efficient.');
with CurrThread.Client do
result := MFinder.FindBitmapMaskTolerance(MBitmaps.bmp[mask].CreateTMask,x,y,xs,ys,xe,ye,tolerance,contourtolerance);
end;
function FindDeformedBitmapToleranceIn(bitmap: integer; var x,
y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer;
AllowPartialAccuracy: Boolean; var accuracy: Extended): Boolean;
begin;
result := CurrThread.Client.MFinder.FindDeformedBitmapToleranceIn(CurrThread.Client.MBitmaps.bmp[Bitmap],x,y,xs,ys,xe,ye,tolerance,range,AllowPartialAccuracy,accuracy);
end;
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
Bitmap.inc for the Mufasa Macro Library
}
function CreateBitmap(w,h : integer):integer;
begin
result := CurrThread.Client.MBitmaps.CreateBMP(w,h);
end;
procedure FreeBitmap(Number : integer);
begin
CurrThread.Client.MBitmaps.FreeBMP(Number);
end;
procedure SaveBitmap(Bmp : integer; path : string);
begin;
CurrThread.Client.MBitmaps.Bmp[Bmp].SaveToFile(Path);
end;
function BitmapFromString(Width,height : integer; Data : string) : integer;
begin;
Result := CurrThread.Client.MBitmaps.CreateBMPFromString(Width,Height,Data);
end;
function LoadBitmap(Path : String) : integer;
begin;
Result := CurrThread.Client.MBitmaps.CreateBMPFromFile(Path);
end;
procedure SetBitmapSize(Bmp,NewW,NewH : integer);
begin;
if (NewW>=0) and (NewH >=0) then
CurrThread.Client.MBitmaps.Bmp[Bmp].SetSize(NewW,NewH)
else
raise exception.createfmt('Wrong Width or Height in SetBitmapSize: (%d,%d)',[NewW,NewH]);
end;
procedure StretchBitmapResize(Bmp,NewW,NewH : integer);
begin;
if (NewW>=0) and (NewH >=0) then
CurrThread.Client.MBitmaps.Bmp[Bmp].StretchResize(NewW,NewH)
else
raise exception.createfmt('Wrong Width or Height in ScretchResize: (%d,%d)',[NewW,NewH]);
end;
procedure GetBitmapSize(Bmp : integer; var BmpW,BmpH : integer);
begin;
With CurrThread.Client.MBitmaps.Bmp[bmp] do
begin;
BmpW := width;
BmpH := Height;
end;
end;
procedure SetBitmapName(Bmp : integer; name : string);
begin;
CurrThread.Client.MBitmaps.Bmp[Bmp].BmpName:= name;
end;
function CreateMirroredBitmap(Bmp : integer) : integer;
begin;
Result := CurrThread.Client.MBitmaps.CreateMirroredBitmap(Bmp, MirrorWidth);
end;
function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;
begin;
Result := CurrThread.Client.MBitmaps.CreateMirroredBitmap(Bmp,MirrorStyle);
end;
function FastGetPixel(bmp,x,y : integer) : LongWord;
begin;
Result := CurrThread.Client.MBitmaps.Bmp[Bmp].FastGetPixel(x,y);
end;
function FastGetPixels(bmp : integer; TPA : TPointArray) : TIntegerArray;
begin;
result := CurrThread.Client.MBitmaps.Bmp[Bmp].FastGetPixels(TPA);
end;
procedure FastSetPixel(Bmp,x,y : integer; Color : TColor);
begin
CurrThread.Client.MBitmaps.Bmp[bmp].FastSetPixel(x,y,color);
end;
procedure FastSetPixels(Bmp : integer; TPA : TPointArray; Colors : TIntegerArray);
begin;
CurrThread.Client.MBitmaps.Bmp[Bmp].FastSetPixels(TPA,Colors);
end;
procedure FastDrawClear(bmp : integer; Color : TColor);
begin;
CurrThread.Client.MBitmaps.Bmp[bmp].FastDrawClear(Color);
end;
procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);
begin;
CurrThread.Client.MBitmaps.Bmp[SourceBitmap].FastDrawTransparent(x,y,CurrThread.Client.MBitmaps.Bmp[TargetBitmap]);
end;
procedure SetTransparentColor(Bmp : integer; Color : TColor);
begin
CurrThread.Client.MBitmaps.Bmp[Bmp].SetTransparentColor(Color);
end;
function GetTransparentColor(Bmp : integer) : TColor;
begin;
Result := CurrThread.Client.MBitmaps.Bmp[bmp].GetTransparentColor;
end;
procedure FastReplaceColor(bmp: Integer; OldColor, NewColor: TColor);
begin
CurrThread.Client.MBitmaps.Bmp[Bmp].FastReplaceColor(OldColor,NewColor);
end;
procedure ps_CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer);
begin
CurrThread.Client.MBitmaps.GetBMP(bmp).CopyClientToBitmap(CurrThread.Client.MWindow, xs, ys, xe, ye);
end;
function FindBitmap(Bitmap: integer; var x, y: Integer): Boolean;
begin;
with CurrThread.Client do
result := MFinder.FindBitmap( MBitmaps.Bmp[bitmap],x,y);
end;
function FindBitmapIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;
begin;
with CurrThread.Client do
result := MFinder.FindBitmapIn( MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye);
end;
function FindBitmapToleranceIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean;
begin;
with CurrThread.Client do
result := MFinder.FindBitmapToleranceIn( MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye,tolerance);
end;
function FindBitmapSpiral(bitmap: Integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;
begin;
with CurrThread.Client do
result := MFinder.FindBitmapSpiral(Mbitmaps.bmp[bitmap],x,y,xs,ys,xe,ye);
end;
function FindBitmapsSpiralTolerance(bitmap: integer; x, y: Integer; var Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean;
begin;
with CurrThread.Client do
result := MFinder.FindBitmapsSpiralTolerance(MBitmaps.Bmp[bitmap],x,y,points,xs,ys,xe,ye,tolerance);
end;
function FindBitmapSpiralTolerance(bitmap: integer; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean;
begin;
with CurrThread.Client do
result := MFinder.FindBitmapSpiralTolerance(MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye,tolerance);
end;
function RotateBitmap(bitmap: Integer; angle: Extended): Integer;
begin;
with CurrThread.Client.MBitmaps do
begin;
Result := CreateBMP(0,0);
Bmp[Bitmap].RotateBitmap(angle,Bmp[result]);
end;
end;
function Desaturate(Bitmap : integer) : integer;
begin;
with CurrThread.Client.MBitmaps do
begin;
result := CreateBMP(0,0);
Bmp[Bitmap].Desaturate(Bmp[result]);
end;
end;
procedure InvertBitmap(Bitmap : integer);
begin;
CurrThread.Client.MBitmaps.Bmp[Bitmap].Invert;
end;
function CopyBitmap(Bitmap : integer) : integer;
begin;
result := Currthread.Client.MBitmaps.CopyBMP(bitmap);
end;
function GreyScaleBitmap(Bitmap : integer) : integer;
begin;
with CurrThread.Client.MBitmaps do
begin;
result := CreateBMP(0,0);
Bmp[Bitmap].GreyScale(Bmp[result]);
end;
end;
function BrightnessBitmap(Bitmap,br : integer) : integer;
begin;
with CurrThread.Client.MBitmaps do
begin;
result := CreateBMP(0,0);
Bmp[Bitmap].Brightness(Bmp[result],br);
end;
end;
function ContrastBitmap(bitmap : integer; co : extended) : integer;
begin;
with CurrThread.Client.MBitmaps do
begin;
result := CreateBMP(0,0);
Bmp[Bitmap].Contrast(Bmp[result],co);
end;
end;
function PosterizeBitmap(Bitmap : integer; po : integer) : integer;
begin;
with CurrThread.Client.MBitmaps do
begin
result := CreateBMP(0,0);
Bmp[bitmap].Posterize(Bmp[result],po);
end;
end;
function CreateBitmapMask(Bitmap : integer) : TMask;
begin;
result := CurrThread.Client.MBitmaps.Bmp[Bitmap].CreateTMask;
end;
function FindMaskTolerance(mask: TMask; var x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;
begin;
result := CurrThread.Client.MFinder.FindBitmapMaskTolerance(Mask,x,y,xs,ys,xe,ye,tolerance,contourtolerance);
end;
function FindBitmapMaskTolerance(mask: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;
begin;
Writeln('Better be using FindMaskTolerance in combination with CreateBitmapMask, more efficient.');
with CurrThread.Client do
result := MFinder.FindBitmapMaskTolerance(MBitmaps.bmp[mask].CreateTMask,x,y,xs,ys,xe,ye,tolerance,contourtolerance);
end;
function FindDeformedBitmapToleranceIn(bitmap: integer; var x,
y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer;
AllowPartialAccuracy: Boolean; var accuracy: Extended): Boolean;
begin;
result := CurrThread.Client.MFinder.FindDeformedBitmapToleranceIn(CurrThread.Client.MBitmaps.bmp[Bitmap],x,y,xs,ys,xe,ye,tolerance,range,AllowPartialAccuracy,accuracy);
end;

112
Units/MMLAddon/PSInc/Wrappers/other.inc
View File

@ -1,56 +1,56 @@
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
Other.inc for the Mufasa Macro Library
}
procedure Wait(t: Integer);
begin
Sleep(t);
end;
procedure SaveScreenshot(FileName: string);
var
w,h : integer;
begin;
with CurrThread.Client.MWindow do
begin;
GetDimensions(w,h);
with CopyClientToBitmap(0,0,w-1,h-1) do
begin;
SaveToFile(FileName);
Free;
end;
end;
end;
function CreateForm : TForm;
begin;
result := TForm.Create(nil);
end;
function CreateButton(Owner : TComponent) : TButton;
begin;
Result := TButton.Create(Owner);
end;
function Distance(x1, y1, x2, y2: Integer): Integer;
begin;
Result := Round(Sqrt(Sqr(x2-x1) + Sqr(y2-y1)));
end;
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
Other.inc for the Mufasa Macro Library
}
procedure Wait(t: Integer);
begin
Sleep(t);
end;
procedure SaveScreenshot(FileName: string);
var
w,h : integer;
begin;
with CurrThread.Client.MWindow do
begin;
GetDimensions(w,h);
with CopyClientToBitmap(0,0,w-1,h-1) do
begin;
SaveToFile(FileName);
Free;
end;
end;
end;
function CreateForm : TForm;
begin;
result := TForm.Create(nil);
end;
function CreateButton(Owner : TComponent) : TButton;
begin;
Result := TButton.Create(Owner);
end;
function Distance(x1, y1, x2, y2: Integer): Integer;
begin;
Result := Round(Sqrt(Sqr(x2-x1) + Sqr(y2-y1)));
end;

96
Units/MMLAddon/PSInc/Wrappers/window.inc
View File

@ -1,48 +1,48 @@
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
window.inc for the Mufasa Macro Library
}
procedure SetDesktopAsClient;
begin;
CurrThread.Client.MWindow.SetDesktop;
end;
procedure SetTargetBitmap(bitmap: Integer);
begin;
With CurrThread.Client do
MWindow.SetTarget(MBitmaps.Bmp[Bitmap]);
end;
procedure GetClientDimensions(var w, h: integer);
begin
CurrThread.Client.MWindow.GetDimensions(w, h);
end;
function Freeze: boolean;
begin
result := CurrThread.Client.MWindow.Freeze();
end;
function Unfreeze: boolean;
begin
result := CurrThread.Client.MWindow.Unfreeze;
end;
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
window.inc for the Mufasa Macro Library
}
procedure SetDesktopAsClient;
begin;
CurrThread.Client.MWindow.SetDesktop;
end;
procedure SetTargetBitmap(bitmap: Integer);
begin;
With CurrThread.Client do
MWindow.SetTarget(MBitmaps.Bmp[Bitmap]);
end;
procedure GetClientDimensions(var w, h: integer);
begin
CurrThread.Client.MWindow.GetDimensions(w, h);
end;
function Freeze: boolean;
begin
result := CurrThread.Client.MWindow.Freeze();
end;
function Unfreeze: boolean;
begin
result := CurrThread.Client.MWindow.Unfreeze;
end;

272
Units/MMLAddon/PSInc/pscompile.inc
View File

@ -1,136 +1,136 @@
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
PSCompile.inc for the Mufasa Macro Library
}
Sender.Comp.AddConstantN('AppPath','string').SetString(CurrThread.AppPath);
Sender.Comp.AddConstantN('ScriptPath','string').SetString(CurrThread.ScriptPath);
Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer');
Sender.Comp.AddTypeS('TPointArray','Array of TPoint');
Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
Sender.Comp.AddTypeS('TMask','record White, Black : TPointArray; WhiteHi,BlackHi : integer; W,H : integer;end;');
Sender.Comp.AddTypes('TDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;');
Sender.Comp.AddTypes('TDTMPointDefArray', 'Array Of TDTMPointDef;');
Sender.Comp.AddTypes('TDTM','record MainPoint: TDTMPointDef; SubPoints: TDTMPointDefArray; end;');
Sender.Comp.AddTypeS('pDTM','record p: TPointArray; c, t, asz, ash: TIntegerArray; end');
Sender.Comp.AddTypeS('T2DExtendedArray', 'array of array of extended');
Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
Sender.AddFunction(@psWriteln,'procedure writeln(s : string);');
{ DTM }
Sender.AddFunction(@PrintpDTM, 'Procedure PrintpDTM(tDTM : pDTM);');
Sender.AddFunction(@ps_GetDTM ,'function GetDTM(index: Integer; var dtm: pDTM): Boolean;');
Sender.AddFunction(@pDTMToTDTM, 'Function pDTMToTDTM(Const DTM: pDTM): TDTM;');
Sender.AddFunction(@tDTMTopDTM, 'Function tDTMTopDTM(Const DTM: TDTM): pDTM;');
Sender.AddFunction(@ps_DTMFromString, 'function DTMFromString(DTMString: String): Integer;');
Sender.AddFunction(@ps_FreeDTM, 'procedure FreeDTM(DTM: Integer);');
Sender.AddFunction(@ps_FindDTM, 'function FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean;');
Sender.AddFunction(@ps_FindDTMs, 'function FindDTMs(DTM: Integer; var p: TPointArray; x1, y1, x2, y2: Integer): Boolean;');
Sender.AddFunction(@ps_FindDTMRotated, 'function FindDTMRotated(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; var aFound: Extended): Boolean;');
Sender.AddFunction(@ps_FindDTMsRotated, 'function FindDTMsRotated(DTM: Integer; var Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray) : Boolean;');
Sender.AddFunction(@ps_addDTM, 'function AddDTM(d: TDTM): Integer;');
Sender.AddFunction(@ps_addpDTM, 'function AddpDTM(d: pDTM): Integer;');
{maths}
sender.AddFunction(@power,'function pow(base,exponent : extended) : extended');
Sender.AddFunction(@max,'function Max(a, b: Integer): Integer;');
Sender.AddFunction(@min,'function Min(a, b: Integer): Integer;');
Sender.AddFunction(@pssqr,'function Sqr(e : extended) : extended;');
Sender.AddFunction(@classes.point,'function Point(x,y:integer) : TPoint;');
Sender.AddFunction(@Distance,'function Distance(x1,y1,x2,y2 : integer) : integer;');
{window}
Sender.AddFunction(@Freeze, 'function freeze:boolean;');
Sender.AddFunction(@Unfreeze, 'function unfreeze: boolean;');
Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);');
Sender.AddFunction(@SetTargetBitmap,'procedure SetTargetBitmap(Bitmap : integer);');
Sender.AddFunction(@SetDesktopAsClient,'procedure SetDesktopAsClient');
{other}
Sender.AddFunction(@SaveScreenshot,'procedure SaveScreenshot(FileName: string);');
Sender.AddFunction(@Wait, 'procedure wait(t: integer);');
Sender.AddFunction(@GetTickCount, 'function GetSystemTime: Integer;');
Sender.AddFunction(@CreateForm,'function CreateForm : TForm;');
Sender.AddFunction(@CreateButton,'function CreateButton(Owner : TComponent) : TButton');
{Color + Color Finders}
Sender.AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;');
Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
Sender.AddFunction(@FindColorTolerance, 'function findcolortolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
Sender.AddFunction(@FindColors, 'function findcolors(var TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;');
Sender.AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean');
Sender.AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;');
Sender.AddFunction(@FindColorsTolerance,'function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;');
Sender.AddFunction(@FindColorSpiral,'function FindColorSpiral(var x, y: Integer; color, xs, ys, xe, ye: Integer): Boolean;');
Sender.AddFunction(@FindColorsSpiralTolerance,'function FindColorsSpiralTolerance(x, y: Integer; var Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean;');
Sender.AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
{Mouse etc.}
Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);');
Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);');
{Bitmaps}
Sender.AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;');
Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);');
Sender.AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);');
Sender.AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;');
Sender.AddFunction(@LoadBitmap,'function LoadBitmap(Path : string) : integer;');
Sender.AddFunction(@SetBitmapSize,'procedure SetBitmapSize(Bmp,NewW,NewH : integer);');
Sender.AddFunction(@GetBitmapSize,'procedure GetBitmapSize(Bmp : integer; Var BmpW,BmpH : integer);');
Sender.AddFunction(@StretchBitmapResize,'procedure StretchBitmapResize(Bmp,NewW,NewH : integer);');
Sender.AddFunction(@CreateMirroredBitmap,'function CreateMirroredBitmap(Bmp : integer) : integer;');
Sender.AddFunction(@CreateMirroredBitmapEx,'function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;');
Sender.AddFunction(@FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : TColor);');
Sender.AddFunction(@FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);');
Sender.AddFunction(@FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;');
Sender.AddFunction(@FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;');
Sender.AddFunction(@FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor)');
Sender.AddFunction(@FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);');
Sender.AddFunction(@SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);');
Sender.AddFunction(@GetTransparentColor,'function GetTransparentColor(bmp: integer) : TColor;');
Sender.AddFunction(@FastReplaceColor,'procedure FastReplaceColor(Bmp : integer; OldColor,NewColor : TColor);');
Sender.AddFunction(@ps_CopyClientToBitmap, 'procedure CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer);');
Sender.AddFunction(@SetBitmapName, 'procedure SetBitmapName(Bmp : integer; name : string);');
Sender.AddFunction(@FindBitmap,'function FindBitmap(bitmap: integer; var x, y: Integer): Boolean;');
Sender.AddFunction(@FindBitmapIn,'function FindBitmapIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;');
sender.AddFunction(@FindBitmapToleranceIn,'function FindBitmapToleranceIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean;');
Sender.AddFunction(@FindBitmapSpiral,'function FindBitmapSpiral(bitmap: Integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;');
Sender.AddFunction(@FindBitmapsSpiralTolerance,'function FindBitmapsSpiralTolerance(bitmap: integer; x, y: Integer; var Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean;');
Sender.AddFunction(@FindBitmapSpiralTolerance,'function FindBitmapSpiralTolerance(bitmap: integer; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean;');
Sender.AddFunction(@RotateBitmap,'function RotateBitmap(bitmap: Integer; angle: Extended): Integer;');
Sender.AddFunction(@Desaturate,'function DesaturateBitmap(Bitmap : integer) : integer;');
sender.AddFunction(@InvertBitmap,'procedure InvertBitmap(Bitmap : integer);');
Sender.AddFunction(@CopyBitmap,'function CopyBitmap(Bitmap: integer) : integer)');
Sender.AddFunction(@GreyScaleBitmap,'function GreyScaleBitmap(bitmap : integer) : integer');
Sender.AddFunction(@BrightnessBitmap,'function BrightnessBitmap(Bitmap,br : integer) : integer;');
Sender.AddFunction(@ContrastBitmap,'function ContrastBitmap(bitmap : integer; co : extended) : integer;');
Sender.AddFunction(@PosterizeBitmap,'function PosterizeBitmap(Bitmap : integer; po : integer) : integer;');
Sender.AddFunction(@CreateBitmapMask,'function CreateBitmapMask(Bitmap : integer) : TMask;');
Sender.AddFunction(@FindMaskTolerance,'function FindMaskTolerance(mask: TMask; var x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
Sender.AddFunction(@FindBitmapMaskTolerance,'function FindBitmapMaskTolerance(mask: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
Sender.AddFunction(@FindDeformedBitmapToleranceIn,'function FindDeformedBitmapToleranceIn(bitmap: integer; var x,y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; var accuracy: Extended): Boolean;');
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
PSCompile.inc for the Mufasa Macro Library
}
Sender.Comp.AddConstantN('AppPath','string').SetString(CurrThread.AppPath);
Sender.Comp.AddConstantN('ScriptPath','string').SetString(CurrThread.ScriptPath);
Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer');
Sender.Comp.AddTypeS('TPointArray','Array of TPoint');
Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
Sender.Comp.AddTypeS('TMask','record White, Black : TPointArray; WhiteHi,BlackHi : integer; W,H : integer;end;');
Sender.Comp.AddTypes('TDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;');
Sender.Comp.AddTypes('TDTMPointDefArray', 'Array Of TDTMPointDef;');
Sender.Comp.AddTypes('TDTM','record MainPoint: TDTMPointDef; SubPoints: TDTMPointDefArray; end;');
Sender.Comp.AddTypeS('pDTM','record p: TPointArray; c, t, asz, ash: TIntegerArray; end');
Sender.Comp.AddTypeS('T2DExtendedArray', 'array of array of extended');
Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
Sender.AddFunction(@psWriteln,'procedure writeln(s : string);');
{ DTM }
Sender.AddFunction(@PrintpDTM, 'Procedure PrintpDTM(tDTM : pDTM);');
Sender.AddFunction(@ps_GetDTM ,'function GetDTM(index: Integer; var dtm: pDTM): Boolean;');
Sender.AddFunction(@pDTMToTDTM, 'Function pDTMToTDTM(Const DTM: pDTM): TDTM;');
Sender.AddFunction(@tDTMTopDTM, 'Function tDTMTopDTM(Const DTM: TDTM): pDTM;');
Sender.AddFunction(@ps_DTMFromString, 'function DTMFromString(DTMString: String): Integer;');
Sender.AddFunction(@ps_FreeDTM, 'procedure FreeDTM(DTM: Integer);');
Sender.AddFunction(@ps_FindDTM, 'function FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean;');
Sender.AddFunction(@ps_FindDTMs, 'function FindDTMs(DTM: Integer; var p: TPointArray; x1, y1, x2, y2: Integer): Boolean;');
Sender.AddFunction(@ps_FindDTMRotated, 'function FindDTMRotated(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; var aFound: Extended): Boolean;');
Sender.AddFunction(@ps_FindDTMsRotated, 'function FindDTMsRotated(DTM: Integer; var Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray) : Boolean;');
Sender.AddFunction(@ps_addDTM, 'function AddDTM(d: TDTM): Integer;');
Sender.AddFunction(@ps_addpDTM, 'function AddpDTM(d: pDTM): Integer;');
{maths}
sender.AddFunction(@power,'function pow(base,exponent : extended) : extended');
Sender.AddFunction(@max,'function Max(a, b: Integer): Integer;');
Sender.AddFunction(@min,'function Min(a, b: Integer): Integer;');
Sender.AddFunction(@pssqr,'function Sqr(e : extended) : extended;');
Sender.AddFunction(@classes.point,'function Point(x,y:integer) : TPoint;');
Sender.AddFunction(@Distance,'function Distance(x1,y1,x2,y2 : integer) : integer;');
{window}
Sender.AddFunction(@Freeze, 'function freeze:boolean;');
Sender.AddFunction(@Unfreeze, 'function unfreeze: boolean;');
Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);');
Sender.AddFunction(@SetTargetBitmap,'procedure SetTargetBitmap(Bitmap : integer);');
Sender.AddFunction(@SetDesktopAsClient,'procedure SetDesktopAsClient');
{other}
Sender.AddFunction(@SaveScreenshot,'procedure SaveScreenshot(FileName: string);');
Sender.AddFunction(@Wait, 'procedure wait(t: integer);');
Sender.AddFunction(@GetTickCount, 'function GetSystemTime: Integer;');
Sender.AddFunction(@CreateForm,'function CreateForm : TForm;');
Sender.AddFunction(@CreateButton,'function CreateButton(Owner : TComponent) : TButton');
{Color + Color Finders}
Sender.AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;');
Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
Sender.AddFunction(@FindColorTolerance, 'function findcolortolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
Sender.AddFunction(@FindColors, 'function findcolors(var TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;');
Sender.AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean');
Sender.AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;');
Sender.AddFunction(@FindColorsTolerance,'function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;');
Sender.AddFunction(@FindColorSpiral,'function FindColorSpiral(var x, y: Integer; color, xs, ys, xe, ye: Integer): Boolean;');
Sender.AddFunction(@FindColorsSpiralTolerance,'function FindColorsSpiralTolerance(x, y: Integer; var Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean;');
Sender.AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
{Mouse etc.}
Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);');
Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);');
{Bitmaps}
Sender.AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;');
Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);');
Sender.AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);');
Sender.AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;');
Sender.AddFunction(@LoadBitmap,'function LoadBitmap(Path : string) : integer;');
Sender.AddFunction(@SetBitmapSize,'procedure SetBitmapSize(Bmp,NewW,NewH : integer);');
Sender.AddFunction(@GetBitmapSize,'procedure GetBitmapSize(Bmp : integer; Var BmpW,BmpH : integer);');
Sender.AddFunction(@StretchBitmapResize,'procedure StretchBitmapResize(Bmp,NewW,NewH : integer);');
Sender.AddFunction(@CreateMirroredBitmap,'function CreateMirroredBitmap(Bmp : integer) : integer;');
Sender.AddFunction(@CreateMirroredBitmapEx,'function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;');
Sender.AddFunction(@FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : TColor);');
Sender.AddFunction(@FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);');
Sender.AddFunction(@FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;');
Sender.AddFunction(@FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;');
Sender.AddFunction(@FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor)');
Sender.AddFunction(@FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);');
Sender.AddFunction(@SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);');
Sender.AddFunction(@GetTransparentColor,'function GetTransparentColor(bmp: integer) : TColor;');
Sender.AddFunction(@FastReplaceColor,'procedure FastReplaceColor(Bmp : integer; OldColor,NewColor : TColor);');
Sender.AddFunction(@ps_CopyClientToBitmap, 'procedure CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer);');
Sender.AddFunction(@SetBitmapName, 'procedure SetBitmapName(Bmp : integer; name : string);');
Sender.AddFunction(@FindBitmap,'function FindBitmap(bitmap: integer; var x, y: Integer): Boolean;');
Sender.AddFunction(@FindBitmapIn,'function FindBitmapIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;');
sender.AddFunction(@FindBitmapToleranceIn,'function FindBitmapToleranceIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean;');
Sender.AddFunction(@FindBitmapSpiral,'function FindBitmapSpiral(bitmap: Integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;');
Sender.AddFunction(@FindBitmapsSpiralTolerance,'function FindBitmapsSpiralTolerance(bitmap: integer; x, y: Integer; var Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean;');
Sender.AddFunction(@FindBitmapSpiralTolerance,'function FindBitmapSpiralTolerance(bitmap: integer; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean;');
Sender.AddFunction(@RotateBitmap,'function RotateBitmap(bitmap: Integer; angle: Extended): Integer;');
Sender.AddFunction(@Desaturate,'function DesaturateBitmap(Bitmap : integer) : integer;');
sender.AddFunction(@InvertBitmap,'procedure InvertBitmap(Bitmap : integer);');
Sender.AddFunction(@CopyBitmap,'function CopyBitmap(Bitmap: integer) : integer)');
Sender.AddFunction(@GreyScaleBitmap,'function GreyScaleBitmap(bitmap : integer) : integer');
Sender.AddFunction(@BrightnessBitmap,'function BrightnessBitmap(Bitmap,br : integer) : integer;');
Sender.AddFunction(@ContrastBitmap,'function ContrastBitmap(bitmap : integer; co : extended) : integer;');
Sender.AddFunction(@PosterizeBitmap,'function PosterizeBitmap(Bitmap : integer; po : integer) : integer;');
Sender.AddFunction(@CreateBitmapMask,'function CreateBitmapMask(Bitmap : integer) : TMask;');
Sender.AddFunction(@FindMaskTolerance,'function FindMaskTolerance(mask: TMask; var x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
Sender.AddFunction(@FindBitmapMaskTolerance,'function FindBitmapMaskTolerance(mask: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
Sender.AddFunction(@FindDeformedBitmapToleranceIn,'function FindDeformedBitmapToleranceIn(bitmap: integer; var x,y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; var accuracy: Extended): Boolean;');

470
Units/MMLAddon/colourpicker.pas
View File

@ -1,235 +1,235 @@
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
Colourpicker for the Mufasa Macro Library
}
unit colourpicker;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LCLIntf,LCLType,InterfaceBase,Forms,Controls,ExtCtrls,
Graphics,
Window,MufasaTypes
{$IFNDEF PICKER_CLIENT}
{$IFDEF LINUX}
,x
{$ENDIF}
{$ENDIF}
;
type
TPickEvent = procedure (Sender: TObject; Color, X, Y: Integer);
TMColorPicker = class(TObject)
constructor Create(aWindow: TMWindow);
destructor Destroy; override;
procedure Pick(Out C, X, Y: Integer);
procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer );
procedure TimorTimer(Sender: TObject);
Procedure ColorPickDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
public
// Will give us CopyClientToBitmap
Window: TMWindow;
ColourHistory: TList; // for colour history
Form : TForm;
Image: TImage;
Timor : TTimer;
Bitmap : Graphics.TBitmap;
Note : Graphics.TBitmap;
Brush : TBrush;
Text : string;
FPickEvent : TPickEvent;
oldx, oldy, Color, colorx, colory: Integer;
TheChangedEvent,TheChangingEvent : TNotifyEvent;
NoteHandle, BitmapHandle, ImageHandle : HDC;
public
property OnPick: TPickEvent read FPickEvent write FPickEvent;
end;
implementation
constructor TMColorPicker.Create(aWindow: TMWindow);
begin
Self.Window := aWindow;
end;
destructor TMColorPicker.Destroy;
begin
end;
procedure TMColorPicker.Pick(Out C, X, Y: Integer);
var
w, h: integer;
bmp: TBitmap;
{$IFNDEF PICKER_CLIENT}
{$IFDEF LINUX}
OldWindow: TWindow;
{$ELSE}
OldWindow: HWND;
{$ENDIF}
{$ENDIF}
begin
Form := TForm.Create(Application.MainForm);
{$IFNDEF PICKER_CLIENT}
{$IFDEF LINUX}
OldWindow := Window.CurWindow;
{$ELSE}
OldWindow := Window.TargetHandle;
{$ENDIF}
Window.SetDesktop;
{$ENDIF}
w := 0;
h := 0;
Window.GetDimensions(w, h);
Form.Width := w;
Form.Height := h;
Form.Top := 0;
Form.left := 0;
Form.WindowState := wsmaximized;
Form.BorderStyle:= bsNone;
Image := TImage.Create(Form);
Image.Parent := Form;
Image.left := 0;
image.Width := 0;
Image.width := Form.Width - 1;
Image.Height := Form.Height - 1;
Image.Cursor:= crCross;
Image.OnMouseDown:= @ColorPickDown;
Image.OnMouseMove:=@ImageMouseMove;
Image.Canvas.Brush.Color := 14811135;
Bitmap := Graphics.TBitmap.create;
Bitmap.width := Form.Width;
Bitmap.Height := Form.Height;
Note := Graphics.TBitmap.create;
Note.Canvas.Brush.Color := 14811135;
Note.Width := 148;
Note.Height := 33;
Note.Canvas.Rectangle(0, 0, 147, 33);
Note.Canvas.Rectangle(89, 3, 115, 29);
Note.Canvas.Pen.Style:= psClear;
bmp := Window.CopyClientToBitmap(0, 0, w - 1, h - 1);
BitBlt(Image.Canvas.Handle, 0,0,w ,h , bmp.Canvas.Handle,0,0,SRCCOPY);
BitBlt(Bitmap.Canvas.Handle, 0,0,w ,h , bmp.Canvas.Handle,0,0,SRCCOPY);
bmp.Free;
ImageHandle:= Image.Canvas.Handle;
BitmapHandle:= Bitmap.Canvas.Handle;
NoteHandle:= Note.Canvas.Handle;
TheChangedEvent := Image.Canvas.OnChange;
TheChangingEvent := Image.Canvas.OnChanging;
Brush := Image.Canvas.Brush;
Timor := TTimer.Create(Form);
Timor.OnTimer:= @TimorTimer;
Timor.Interval:= 50;
Timor.Enabled:= False;
Form.ShowModal;
// add x to history here.
c := Color;
x := Colorx;
y := Colory;
{$IFNDEF PICKER_CLIENT}
{$IFDEF LINUX}
Window.SetTarget(OldWindow);
{$ELSE}
Window.SetTarget(OldWindow, w_Window);
{$ENDIF}
{$ENDIF}
Note.Free;
Bitmap.Free;
Timor.Free;
Image.Free;
Form.Free;
end;
procedure TMColorPicker.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Timor.Enabled:= True;
end;
procedure TMColorPicker.TimorTimer(Sender: TObject);
var
TempPoint : TPoint;
begin
// GetCursorPos(TempPoint);
TempPoint := Mouse.CursorPos;
{ If a form cannot be fully set to 0,0 }
TempPoint.X := TempPoint.X - Form.Left;
TempPoint.Y := TempPoint.Y - Form.Top;
BitBlt(ImageHandle, oldx + 5, oldy + 5,147,33,BitmapHandle,oldx + 5,oldy + 5,SRCCOPY);
Color := WidgetSet.DCGetPixel(ImageHandle, TempPoint.X, TempPoint.Y);
Rectangle(NoteHandle,1,1,85,32);
// Text:='Pos: ' + inttostr(TempPoint.x - Client.Rect.Left) + ',' + inttostr(TempPoint.y - Client.Rect.Bottom);
Text:='Pos: ' + inttostr(TempPoint.x) + ',' + inttostr(TempPoint.y);
ExtTextOut(NoteHandle, 5, 3,0,nil,pchar(text),length(text),nil);
Text := 'Color: ' + inttostr(Color);
ExtTextOut(NoteHandle, 5, 15,0,nil,pchar(text),length(text),nil);
BitBlt( ImageHandle, TempPoint.x + 5, TempPoint.y + 5,147,33,NoteHandle,0,0,SRCCOPY);
Brush.Color := Color;
Image.Canvas.Rectangle(TempPoint.x + 123, TempPoint.y + 8, tempPoint.x + 149, temppoint.y + 34);
// Rectangle(ImageHandle,TempPoint.x + 123, TempPoint.y + 8, tempPoint.x + 149, temppoint.y + 34);
TheChangingEvent(Sender);
StretchBlt(ImageHandle,TempPoint.x + 95, TempPoint.y + 9, 24,24, BitmapHandle, TempPoint.x - 1, TempPoint.y-1,3,3, SRCCOPY);
TheChangedEvent(Sender);
Oldx := TempPoint.x;
Oldy := TempPoint.y;
Timor.Enabled:= False;
end;
procedure TMColorPicker.ColorPickDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin;
Color:= WidgetSet.DCGetPixel(Image.Canvas.Handle,x,y);
Self.Colorx := x;
Self.Colory := y;
Timor.enabled := false;
if OnPick <> nil then
Onpick(Sender,Color,x,y);
Form.Close;
end;
end.
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
Colourpicker for the Mufasa Macro Library
}
unit colourpicker;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LCLIntf,LCLType,InterfaceBase,Forms,Controls,ExtCtrls,
Graphics,
Window,MufasaTypes
{$IFNDEF PICKER_CLIENT}
{$IFDEF LINUX}
,x
{$ENDIF}
{$ENDIF}
;
type
TPickEvent = procedure (Sender: TObject; Color, X, Y: Integer);
TMColorPicker = class(TObject)
constructor Create(aWindow: TMWindow);
destructor Destroy; override;
procedure Pick(Out C, X, Y: Integer);
procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer );
procedure TimorTimer(Sender: TObject);
Procedure ColorPickDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
public
// Will give us CopyClientToBitmap
Window: TMWindow;
ColourHistory: TList; // for colour history
Form : TForm;
Image: TImage;
Timor : TTimer;
Bitmap : Graphics.TBitmap;
Note : Graphics.TBitmap;
Brush : TBrush;
Text : string;
FPickEvent : TPickEvent;
oldx, oldy, Color, colorx, colory: Integer;
TheChangedEvent,TheChangingEvent : TNotifyEvent;
NoteHandle, BitmapHandle, ImageHandle : HDC;
public
property OnPick: TPickEvent read FPickEvent write FPickEvent;
end;
implementation
constructor TMColorPicker.Create(aWindow: TMWindow);
begin
Self.Window := aWindow;
end;
destructor TMColorPicker.Destroy;
begin
end;
procedure TMColorPicker.Pick(Out C, X, Y: Integer);
var
w, h: integer;
bmp: TBitmap;
{$IFNDEF PICKER_CLIENT}
{$IFDEF LINUX}
OldWindow: TWindow;
{$ELSE}
OldWindow: HWND;
{$ENDIF}
{$ENDIF}
begin
Form := TForm.Create(Application.MainForm);
{$IFNDEF PICKER_CLIENT}
{$IFDEF LINUX}
OldWindow := Window.CurWindow;
{$ELSE}
OldWindow := Window.TargetHandle;
{$ENDIF}
Window.SetDesktop;
{$ENDIF}
w := 0;
h := 0;
Window.GetDimensions(w, h);
Form.Width := w;
Form.Height := h;
Form.Top := 0;
Form.left := 0;
Form.WindowState := wsmaximized;
Form.BorderStyle:= bsNone;
Image := TImage.Create(Form);
Image.Parent := Form;
Image.left := 0;
image.Width := 0;
Image.width := Form.Width - 1;
Image.Height := Form.Height - 1;
Image.Cursor:= crCross;
Image.OnMouseDown:= @ColorPickDown;
Image.OnMouseMove:=@ImageMouseMove;
Image.Canvas.Brush.Color := 14811135;
Bitmap := Graphics.TBitmap.create;
Bitmap.width := Form.Width;
Bitmap.Height := Form.Height;
Note := Graphics.TBitmap.create;
Note.Canvas.Brush.Color := 14811135;
Note.Width := 148;
Note.Height := 33;
Note.Canvas.Rectangle(0, 0, 147, 33);
Note.Canvas.Rectangle(89, 3, 115, 29);
Note.Canvas.Pen.Style:= psClear;
bmp := Window.CopyClientToBitmap(0, 0, w - 1, h - 1);
BitBlt(Image.Canvas.Handle, 0,0,w ,h , bmp.Canvas.Handle,0,0,SRCCOPY);
BitBlt(Bitmap.Canvas.Handle, 0,0,w ,h , bmp.Canvas.Handle,0,0,SRCCOPY);
bmp.Free;
ImageHandle:= Image.Canvas.Handle;
BitmapHandle:= Bitmap.Canvas.Handle;
NoteHandle:= Note.Canvas.Handle;
TheChangedEvent := Image.Canvas.OnChange;
TheChangingEvent := Image.Canvas.OnChanging;
Brush := Image.Canvas.Brush;
Timor := TTimer.Create(Form);
Timor.OnTimer:= @TimorTimer;
Timor.Interval:= 50;
Timor.Enabled:= False;
Form.ShowModal;
// add x to history here.
c := Color;
x := Colorx;
y := Colory;
{$IFNDEF PICKER_CLIENT}
{$IFDEF LINUX}
Window.SetTarget(OldWindow);
{$ELSE}
Window.SetTarget(OldWindow, w_Window);
{$ENDIF}
{$ENDIF}
Note.Free;
Bitmap.Free;
Timor.Free;
Image.Free;
Form.Free;
end;
procedure TMColorPicker.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Timor.Enabled:= True;
end;
procedure TMColorPicker.TimorTimer(Sender: TObject);
var
TempPoint : TPoint;
begin
// GetCursorPos(TempPoint);
TempPoint := Mouse.CursorPos;
{ If a form cannot be fully set to 0,0 }
TempPoint.X := TempPoint.X - Form.Left;
TempPoint.Y := TempPoint.Y - Form.Top;
BitBlt(ImageHandle, oldx + 5, oldy + 5,147,33,BitmapHandle,oldx + 5,oldy + 5,SRCCOPY);
Color := WidgetSet.DCGetPixel(ImageHandle, TempPoint.X, TempPoint.Y);
Rectangle(NoteHandle,1,1,85,32);
// Text:='Pos: ' + inttostr(TempPoint.x - Client.Rect.Left) + ',' + inttostr(TempPoint.y - Client.Rect.Bottom);
Text:='Pos: ' + inttostr(TempPoint.x) + ',' + inttostr(TempPoint.y);
ExtTextOut(NoteHandle, 5, 3,0,nil,pchar(text),length(text),nil);
Text := 'Color: ' + inttostr(Color);
ExtTextOut(NoteHandle, 5, 15,0,nil,pchar(text),length(text),nil);
BitBlt( ImageHandle, TempPoint.x + 5, TempPoint.y + 5,147,33,NoteHandle,0,0,SRCCOPY);
Brush.Color := Color;
Image.Canvas.Rectangle(TempPoint.x + 123, TempPoint.y + 8, tempPoint.x + 149, temppoint.y + 34);
// Rectangle(ImageHandle,TempPoint.x + 123, TempPoint.y + 8, tempPoint.x + 149, temppoint.y + 34);
TheChangingEvent(Sender);
StretchBlt(ImageHandle,TempPoint.x + 95, TempPoint.y + 9, 24,24, BitmapHandle, TempPoint.x - 1, TempPoint.y-1,3,3, SRCCOPY);
TheChangedEvent(Sender);
Oldx := TempPoint.x;
Oldy := TempPoint.y;
Timor.Enabled:= False;
end;
procedure TMColorPicker.ColorPickDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin;
Color:= WidgetSet.DCGetPixel(Image.Canvas.Handle,x,y);
Self.Colorx := x;
Self.Colory := y;
Timor.enabled := false;
if OnPick <> nil then
Onpick(Sender,Color,x,y);
Form.Close;
end;
end.

1814
Units/MMLCore/bitmaps.pas
View File

File diff suppressed because it is too large Load Diff

608
Units/MMLCore/colour_conv.pas
View File

@ -1,304 +1,304 @@
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
Colour Conversion Utilities for the Mufasa Macro Library
}
unit colour_conv;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
Graphics,
Math;
Function RGBtoColor(r,g,b : byte) : TColor; overload; inline;
Function RGBtoColor(r,g,b : integer) : TColor; overload; inline;
Procedure ColorToRGB(Color : integer;var r,g,b : byte); overload; inline;
Procedure ColorToRGB(Color : integer;var r,g,b : integer); overload; inline;
Procedure RGBToXYZ(R,G,B : integer;var x,y,z : Extended); inline;
Procedure XYZToRGB(X,Y,Z : Extended;var R,G,B: integer); inline;
Procedure RGBToHSL(RR,GG,BB : integer;var H,S,L : Extended); inline;
Procedure HSLtoRGB(H,S,L : extended;var R,G,B : Byte); inline;overload;
Procedure HSLtoRGB(H,S,L : extended;var R,G,B : Integer); inline;overload;
Procedure ColorToHSL(Col: Integer; var h, s, l: Extended); inline;
implementation
Const
OneDivThree = 1/3.0;
TwoDivThree = 2 / 3.0;
OneDivTwoPointFour = 1 / 2.4;
Function RGBtoColor(r,g,b : byte): TColor; overload; inline;
begin;
Result := R or g shl 8 or b shl 16;
end;
{/\
Translates the given Red (R), Green (G) and Blue (B) components to a TColor.
R, G and B are integers.
/\}
Function RGBtoColor(r,g,b : integer): TColor; overload; inline;
begin;
Result := R or g shl 8 or b shl 16;
end;
{/\
Translates the given win-32 color in the Red (R), Green (G) and Blue (B)
components. R, G and B are bytes.
/\}
Procedure ColorToRGB(Color : integer;var r,g,b : byte); overload; inline;
begin
R := Color and $ff;
G := Color shr 8 and $ff;
B := Color shr 16 and $ff;
end;
{/\
Translates the given win-32 color in the Red (R), Green (G) and Blue (B)
components. R, G and B are integers.
/\}
Procedure ColorToRGB(Color : integer;var r,g,b : integer); overload; inline;
begin
R := Color and $ff;
G := Color shr 8 and $ff;
B := Color shr 16 and $ff;
end;
{/\
Translates the given Red (R), Green (G) and Blue (B) components to
X, Y and Z components.
/\}
Procedure RGBToXYZ(R,G,B : integer;var x,y,z : Extended); inline;
var
Red,Green,Blue : Extended;
begin;
Red := R / 255;
Green := G / 255;
Blue := B / 255;
if Red > 0.04045 then
Red := Power( ( Red + 0.055 ) / 1.055 , 2.4) * 100
else
Red := Red / 7.73994;
if Green > 0.04045 then
Green := Power( ( Green + 0.055 ) / 1.055 , 2.4) * 100
else
Green := Green / 7.73994;
if Blue > 0.04045 then
Blue := Power( ( Blue + 0.055 ) / 1.055 , 2.4) * 100
else
Blue := Blue / 7.73994;
X := Red * 0.4124 + Green * 0.3576 + Blue * 0.1805;
Y := Red * 0.2126 + Green * 0.7152 + Blue * 0.0722;
Z := Red * 0.0193 + Green * 0.1192 + Blue * 0.9505;
end;
{/\
Translates the given X, Y and Z components to
Red (R), Green (G) and Blue (B) components.
/\}
Procedure XYZToRGB(X,Y,Z : Extended;var R,G,B: integer); inline;
var
TempR,TempG,TempB,Tempx,tempy,tempz : Extended;
begin;
Tempx := X / 100;
tempy := Y / 100;
tempz := Z / 100;
TempR := Tempx * 3.2406 + tempy * -1.5372 + tempz * -0.4986;
TempG := Tempx * -0.9689 + tempy * 1.8758 + tempz * 0.0415;
TempB := Tempx * 0.0557 + tempy * -0.2040 + tempz * 1.0570;
if TempR > 0.0031308 then
TempR := 1.055 * ( Power(TempR, (OneDivTwoPointFour)) ) - 0.055
else
TempR := 12.92 * TempR;
if TempG > 0.0031308 then
TempG := 1.055 * ( Power(TempG, ( OneDivTwoPointFour)) ) - 0.055
else
TempG := 12.92 * TempG;
if TempB > 0.0031308 then
TempB := 1.055 * ( Power(TempB , ( OneDivTwoPointFour )) ) - 0.055
else
TempB := 12.92 * TempB;
R := Round(TempR * 255);
G := Round(TempG * 255);
B := Round(TempB * 255);
end;
{/\
Translates the given Red (R), Green (G) and Blue (B) components to
H (Hue), S (Saturation) and L (Luminance) components.
/\}
Procedure RGBToHSL(RR,GG,BB : integer;var H,S,L : Extended); inline;
var
R, G, B, D, Cmax, Cmin: Extended;
begin
R := RR / 255;
G := GG / 255;
B := BB / 255;
CMin := R;
if G < Cmin then Cmin := G;
if B < Cmin then Cmin := B;
CMax := R;
if G > Cmax then Cmax := G;
if B > Cmax then Cmax := B;
L := 0.5 * (Cmax + Cmin);
if Cmax = Cmin then
begin
H := 0;
S := 0;
end else
begin;
D := Cmax - Cmin;
if L < 0.5 then
S := D / (Cmax + Cmin)
else
S := D / (2 - Cmax - Cmin);
if R = Cmax then
H := (G - B) / D
else
if G = Cmax then
H := 2 + (B - R) / D
else
H := 4 + (R - G) / D;
H := H / 6;
if H < 0 then
H := H + 1;
end;
H := H * 100;
S := S * 100;
L := L * 100;
end;
{/\
Translates the given H (Hue), S (Saturation) and L (Luminance) components to
Red (R), Green (G) and Blue (B) components.
/\}
procedure HSLtoRGB(H, S, L: extended; var R, G, B: Byte); inline; overload;
var
Temp,Temp2 : Extended;
//begin
Function Hue2RGB(TempHue : Extended) : integer;
begin;
if TempHue < 0 then
TempHue := TempHue + 1
else if TempHue > 1 then
TempHue := TempHue - 1;
if ( ( 6 * TempHue ) < 1 ) then
Result :=Round(255 * (( Temp + ( Temp2 - Temp ) * 6 * TempHue )))
else if ( ( 2 * TempHue ) < 1 ) then
Result :=Round(255 * Temp2)
else if ( ( 3 * TempHue ) < 2 ) then
Result :=Round(255 * (Temp + ( Temp2 - Temp ) * ( ( TwoDivThree ) - TempHue ) * 6))
else
Result :=Round(255 * Temp);
end;
begin;
H := H / 100;
S := S / 100;
L := L / 100;
if s = 0 then
begin;
R := Byte(Round(L * 255));
G := R;
B := R;
end else
begin;
if (L < 0.5) then
Temp2 := L * ( 1 + S )
else
Temp2 := (L + S) - ( S * L);
Temp := 2 * L - Temp2;
R := Hue2RGB( H + ( OneDivThree ) );
G := Hue2RGB( H );
B := Hue2RGB( H - ( OneDivThree ) );
end;
end;
Procedure HSLtoRGB(H,S,L : extended;var R,G,B : Integer); inline;
var
Temp,Temp2 : Extended;
//begin
Function Hue2RGB(TempHue : Extended) : integer;
begin;
if TempHue < 0 then
TempHue := TempHue + 1
else if TempHue > 1 then
TempHue := TempHue - 1;
if ( ( 6 * TempHue ) < 1 ) then
Result :=Round(255 * (( Temp + ( Temp2 - Temp ) * 6 * TempHue )))
else if ( ( 2 * TempHue ) < 1 ) then
Result :=Round(255 * Temp2)
else if ( ( 3 * TempHue ) < 2 ) then
Result :=Round(255 * (Temp + ( Temp2 - Temp ) * ( ( TwoDivThree ) - TempHue ) * 6))
else
Result :=Round(255 * Temp);
end;
begin;
H := H / 100;
S := S / 100;
L := L / 100;
if s = 0 then
begin;
R := Round(L * 255);
G := R;
B := R;
end else
begin;
if (L < 0.5) then
Temp2 := L * ( 1 + S )
else
Temp2 := (L + S) - ( S * L);
Temp := 2 * L - Temp2;
R := Hue2RGB( H + ( OneDivThree ) );
G := Hue2RGB( H );
B := Hue2RGB( H - ( OneDivThree ) );
end;
end;
{/\
Split the Given Color col in H, S, L components.
/\}
Procedure ColorToHSL(Col: Integer; var h, s, l: Extended); inline;
Var
R, G, B: Integer;
Begin
ColorToRGB(Col, R, G, B);
RGBToHSL(R, G, B, H, S, L);
End;
end.
{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
Colour Conversion Utilities for the Mufasa Macro Library
}
unit colour_conv;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
Graphics,
Math;
Function RGBtoColor(r,g,b : byte) : TColor; overload; inline;
Function RGBtoColor(r,g,b : integer) : TColor; overload; inline;
Procedure ColorToRGB(Color : integer;var r,g,b : byte); overload; inline;
Procedure ColorToRGB(Color : integer;var r,g,b : integer); overload; inline;
Procedure RGBToXYZ(R,G,B : integer;var x,y,z : Extended); inline;
Procedure XYZToRGB(X,Y,Z : Extended;var R,G,B: integer); inline;
Procedure RGBToHSL(RR,GG,BB : integer;var H,S,L : Extended); inline;
Procedure HSLtoRGB(H,S,L : extended;var R,G,B : Byte); inline;overload;
Procedure HSLtoRGB(H,S,L : extended;var R,G,B : Integer); inline;overload;
Procedure ColorToHSL(Col: Integer; var h, s, l: Extended); inline;
implementation
Const
OneDivThree = 1/3.0;
TwoDivThree = 2 / 3.0;
OneDivTwoPointFour = 1 / 2.4;
Function RGBtoColor(r,g,b : byte): TColor; overload; inline;
begin;
Result := R or g shl 8 or b shl 16;
end;
{/\
Translates the given Red (R), Green (G) and Blue (B) components to a TColor.
R, G and B are integers.
/\}
Function RGBtoColor(r,g,b : integer): TColor; overload; inline;
begin;
Result := R or g shl 8 or b shl 16;
end;
{/\
Translates the given win-32 color in the Red (R), Green (G) and Blue (B)
components. R, G and B are bytes.
/\}
Procedure ColorToRGB(Color : integer;var r,g,b : byte); overload; inline;
begin
R := Color and $ff;
G := Color shr 8 and $ff;
B := Color shr 16 and $ff;
end;
{/\
Translates the given win-32 color in the Red (R), Green (G) and Blue (B)
components. R, G and B are integers.
/\}
Procedure ColorToRGB(Color : integer;var r,g,b : integer); overload; inline;
begin
R := Color and $ff;
G := Color shr 8 and $ff;
B := Color shr 16 and $ff;
end;
{/\
Translates the given Red (R), Green (G) and Blue (B) components to
X, Y and Z components.
/\}
Procedure RGBToXYZ(R,G,B : integer;var x,y,z : Extended); inline;
var
Red,Green,Blue : Extended;
begin;
Red := R / 255;
Green := G / 255;
Blue := B / 255;
if Red > 0.04045 then
Red := Power( ( Red + 0.055 ) / 1.055 , 2.4) * 100
else
Red := Red / 7.73994;
if Green > 0.04045 then
Green := Power( ( Green + 0.055 ) / 1.055 , 2.4) * 100
else
Green := Green / 7.73994;
if Blue > 0.04045 then
Blue := Power( ( Blue + 0.055 ) / 1.055 , 2.4) * 100
else
Blue := Blue / 7.73994;
X := Red * 0.4124 + Green * 0.3576 + Blue * 0.1805;
Y := Red * 0.2126 + Green * 0.7152 + Blue * 0.0722;
Z := Red * 0.0193 + Green * 0.1192 + Blue * 0.9505;
end;
{/\
Translates the given X, Y and Z components to
Red (R), Green (G) and Blue (B) components.
/\}
Procedure XYZToRGB(X,Y,Z : Extended;var R,G,B: integer); inline;
var
TempR,TempG,TempB,Tempx,tempy,tempz : Extended;
begin;
Tempx := X / 100;
tempy := Y / 100;
tempz := Z / 100;
TempR := Tempx * 3.2406 + tempy * -1.5372 + tempz * -0.4986;
TempG := Tempx * -0.9689 + tempy * 1.8758 + tempz * 0.0415;
TempB := Tempx * 0.0557 + tempy * -0.2040 + tempz * 1.0570;
if TempR > 0.0031308 then
TempR := 1.055 * ( Power(TempR, (OneDivTwoPointFour)) ) - 0.055
else
TempR := 12.92 * TempR;
if TempG > 0.0031308 then
TempG := 1.055 * ( Power(TempG, ( OneDivTwoPointFour)) ) - 0.055
else
TempG := 12.92 * TempG;
if TempB > 0.0031308 then
TempB := 1.055 * ( Power(TempB , ( OneDivTwoPointFour )) ) - 0.055
else
TempB := 12.92 * TempB;
R := Round(TempR * 255);
G := Round(TempG * 255);
B := Round(TempB * 255);
end;
{/\
Translates the given Red (R), Green (G) and Blue (B) components to
H (Hue), S (Saturation) and L (Luminance) components.
/\}
Procedure RGBToHSL(RR,GG,BB : integer;var H,S,L : Extended); inline;
var
R, G, B, D, Cmax, Cmin: Extended;
begin
R := RR / 255;
G := GG / 255;
B := BB / 255;
CMin := R;
if G < Cmin then Cmin := G;
if B < Cmin then Cmin := B;
CMax := R;
if G > Cmax then Cmax := G;
if B > Cmax then Cmax := B;
L := 0.5 * (Cmax + Cmin);
if Cmax = Cmin then
begin
H := 0;
S := 0;
end else
begin;
D := Cmax - Cmin;
if L < 0.5 then
S := D / (Cmax + Cmin)
else
S := D / (2 - Cmax - Cmin);
if R = Cmax then
H := (G - B) / D
else
if G = Cmax then
H := 2 + (B - R) / D
else
H := 4 + (R - G) / D;
H := H / 6;
if H < 0 then
H := H + 1;
end;
H := H * 100;
S := S * 100;
L := L * 100;
end;
{/\
Translates the given H (Hue), S (Saturation) and L (Luminance) components to
Red (R), Green (G) and Blue (B) components.
/\}
procedure HSLtoRGB(H, S, L: extended; var R, G, B: Byte); inline; overload;
var
Temp,Temp2 : Extended;
//begin
Function Hue2RGB(TempHue : Extended) : integer;
begin;
if TempHue < 0 then
TempHue := TempHue + 1
else if TempHue > 1 then
TempHue := TempHue - 1;
if ( ( 6 * TempHue ) < 1 ) then
Result :=Round(255 * (( Temp + ( Temp2 - Temp ) * 6 * TempHue )))
else if ( ( 2 * TempHue ) < 1 ) then
Result :=Round(255 * Temp2)
else if ( ( 3 * TempHue ) < 2 ) then
Result :=Round(255 * (Temp + ( Temp2 - Temp ) * ( ( TwoDivThree ) - TempHue ) * 6))
else
Result :=Round(255 * Temp);
end;
begin;
H := H / 100;
S := S / 100;
L := L / 100;
if s = 0 then
begin;
R := Byte(Round(L * 255));
G := R;
B := R;
end else
begin;
if (L < 0.5) then
Temp2 := L * ( 1 + S )
else
Temp2 := (L + S) - ( S * L);
Temp := 2 * L - Temp2;
R := Hue2RGB( H + ( OneDivThree ) );
G := Hue2RGB( H );
B := Hue2RGB( H - ( OneDivThree ) );
end;
end;
Procedure HSLtoRGB(H,S,L : extended;var R,G,B : Integer); inline;
var
Temp,Temp2 : Extended;
//begin
Function Hue2RGB(TempHue : Extended) : integer;
begin;
if TempHue < 0 then
TempHue := TempHue + 1
else if TempHue > 1 then
TempHue := TempHue - 1;
if ( ( 6 * TempHue ) < 1 ) then
Result :=Round(255 * (( Temp + ( Temp2 - Temp ) * 6 * TempHue )))
else if ( ( 2 * TempHue ) < 1 ) then
Result :=Round(255 * Temp2)
else if ( ( 3 * TempHue ) < 2 ) then
Result :=Round(255 * (Temp + ( Temp2 - Temp ) * ( ( TwoDivThree ) - TempHue ) * 6))
else
Result :=Round(255 * Temp);
end;
begin;
H := H / 100;
S := S / 100;
L := L / 100;
if s = 0 then
begin;
R := Round(L * 255);
G := R;
B := R;
end else
begin;
if (L < 0.5) then
Temp2 := L * ( 1 + S )
else
Temp2 := (L + S) - ( S * L);
Temp := 2 * L - Temp2;
R := Hue2RGB( H + ( OneDivThree ) );
G := Hue2RGB( H );
B := Hue2RGB( H - ( OneDivThree ) );
end;
end;
{/\
Split the Given Color col in H, S, L components.
/\}
Procedure ColorToHSL(Col: Integer; var h, s, l: Extended); inline;
Var
R, G, B: Integer;
Begin
ColorToRGB(Col, R, G, B);
RGBToHSL(R, G, B, H, S, L);
End;
end.

2558
Units/MMLCore/finder.pas
View File

File diff suppressed because it is too large Load Diff