mirror of
https://github.com/moparisthebest/Simba
synced 2024-08-13 16:53:59 -04:00
Please use svn:eol-style native for every new file.
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@160 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Wizzup?
parent
bf4e1e5a69
commit
4157568bde
@ -1,255 +1,255 @@
|
|||||||
{
|
{
|
||||||
This file is part of the Mufasa Macro Library (MML)
|
This file is part of the Mufasa Macro Library (MML)
|
||||||
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
|
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
|
||||||
|
|
||||||
MML is free software: you can redistribute it and/or modify
|
MML is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU General Public License as published by
|
it under the terms of the GNU General Public License as published by
|
||||||
the Free Software Foundation, either version 3 of the License, or
|
the Free Software Foundation, either version 3 of the License, or
|
||||||
(at your option) any later version.
|
(at your option) any later version.
|
||||||
|
|
||||||
MML is distributed in the hope that it will be useful,
|
MML is distributed in the hope that it will be useful,
|
||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
GNU General Public License for more details.
|
GNU General Public License for more details.
|
||||||
|
|
||||||
You should have received a copy of the GNU General Public License
|
You should have received a copy of the GNU General Public License
|
||||||
along with MML. If not, see <http://www.gnu.org/licenses/>.
|
along with MML. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
See the file COPYING, included in this distribution,
|
See the file COPYING, included in this distribution,
|
||||||
for details about the copyright.
|
for details about the copyright.
|
||||||
|
|
||||||
Bitmap.inc for the Mufasa Macro Library
|
Bitmap.inc for the Mufasa Macro Library
|
||||||
}
|
}
|
||||||
|
|
||||||
function CreateBitmap(w,h : integer):integer;
|
function CreateBitmap(w,h : integer):integer;
|
||||||
begin
|
begin
|
||||||
result := CurrThread.Client.MBitmaps.CreateBMP(w,h);
|
result := CurrThread.Client.MBitmaps.CreateBMP(w,h);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure FreeBitmap(Number : integer);
|
procedure FreeBitmap(Number : integer);
|
||||||
begin
|
begin
|
||||||
CurrThread.Client.MBitmaps.FreeBMP(Number);
|
CurrThread.Client.MBitmaps.FreeBMP(Number);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure SaveBitmap(Bmp : integer; path : string);
|
procedure SaveBitmap(Bmp : integer; path : string);
|
||||||
begin;
|
begin;
|
||||||
CurrThread.Client.MBitmaps.Bmp[Bmp].SaveToFile(Path);
|
CurrThread.Client.MBitmaps.Bmp[Bmp].SaveToFile(Path);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function BitmapFromString(Width,height : integer; Data : string) : integer;
|
function BitmapFromString(Width,height : integer; Data : string) : integer;
|
||||||
begin;
|
begin;
|
||||||
Result := CurrThread.Client.MBitmaps.CreateBMPFromString(Width,Height,Data);
|
Result := CurrThread.Client.MBitmaps.CreateBMPFromString(Width,Height,Data);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function LoadBitmap(Path : String) : integer;
|
function LoadBitmap(Path : String) : integer;
|
||||||
begin;
|
begin;
|
||||||
Result := CurrThread.Client.MBitmaps.CreateBMPFromFile(Path);
|
Result := CurrThread.Client.MBitmaps.CreateBMPFromFile(Path);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure SetBitmapSize(Bmp,NewW,NewH : integer);
|
procedure SetBitmapSize(Bmp,NewW,NewH : integer);
|
||||||
begin;
|
begin;
|
||||||
if (NewW>=0) and (NewH >=0) then
|
if (NewW>=0) and (NewH >=0) then
|
||||||
CurrThread.Client.MBitmaps.Bmp[Bmp].SetSize(NewW,NewH)
|
CurrThread.Client.MBitmaps.Bmp[Bmp].SetSize(NewW,NewH)
|
||||||
else
|
else
|
||||||
raise exception.createfmt('Wrong Width or Height in SetBitmapSize: (%d,%d)',[NewW,NewH]);
|
raise exception.createfmt('Wrong Width or Height in SetBitmapSize: (%d,%d)',[NewW,NewH]);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure StretchBitmapResize(Bmp,NewW,NewH : integer);
|
procedure StretchBitmapResize(Bmp,NewW,NewH : integer);
|
||||||
begin;
|
begin;
|
||||||
if (NewW>=0) and (NewH >=0) then
|
if (NewW>=0) and (NewH >=0) then
|
||||||
CurrThread.Client.MBitmaps.Bmp[Bmp].StretchResize(NewW,NewH)
|
CurrThread.Client.MBitmaps.Bmp[Bmp].StretchResize(NewW,NewH)
|
||||||
else
|
else
|
||||||
raise exception.createfmt('Wrong Width or Height in ScretchResize: (%d,%d)',[NewW,NewH]);
|
raise exception.createfmt('Wrong Width or Height in ScretchResize: (%d,%d)',[NewW,NewH]);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure GetBitmapSize(Bmp : integer; var BmpW,BmpH : integer);
|
procedure GetBitmapSize(Bmp : integer; var BmpW,BmpH : integer);
|
||||||
begin;
|
begin;
|
||||||
With CurrThread.Client.MBitmaps.Bmp[bmp] do
|
With CurrThread.Client.MBitmaps.Bmp[bmp] do
|
||||||
begin;
|
begin;
|
||||||
BmpW := width;
|
BmpW := width;
|
||||||
BmpH := Height;
|
BmpH := Height;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure SetBitmapName(Bmp : integer; name : string);
|
procedure SetBitmapName(Bmp : integer; name : string);
|
||||||
begin;
|
begin;
|
||||||
CurrThread.Client.MBitmaps.Bmp[Bmp].BmpName:= name;
|
CurrThread.Client.MBitmaps.Bmp[Bmp].BmpName:= name;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function CreateMirroredBitmap(Bmp : integer) : integer;
|
function CreateMirroredBitmap(Bmp : integer) : integer;
|
||||||
begin;
|
begin;
|
||||||
Result := CurrThread.Client.MBitmaps.CreateMirroredBitmap(Bmp, MirrorWidth);
|
Result := CurrThread.Client.MBitmaps.CreateMirroredBitmap(Bmp, MirrorWidth);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;
|
function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;
|
||||||
begin;
|
begin;
|
||||||
Result := CurrThread.Client.MBitmaps.CreateMirroredBitmap(Bmp,MirrorStyle);
|
Result := CurrThread.Client.MBitmaps.CreateMirroredBitmap(Bmp,MirrorStyle);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function FastGetPixel(bmp,x,y : integer) : LongWord;
|
function FastGetPixel(bmp,x,y : integer) : LongWord;
|
||||||
begin;
|
begin;
|
||||||
Result := CurrThread.Client.MBitmaps.Bmp[Bmp].FastGetPixel(x,y);
|
Result := CurrThread.Client.MBitmaps.Bmp[Bmp].FastGetPixel(x,y);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function FastGetPixels(bmp : integer; TPA : TPointArray) : TIntegerArray;
|
function FastGetPixels(bmp : integer; TPA : TPointArray) : TIntegerArray;
|
||||||
begin;
|
begin;
|
||||||
result := CurrThread.Client.MBitmaps.Bmp[Bmp].FastGetPixels(TPA);
|
result := CurrThread.Client.MBitmaps.Bmp[Bmp].FastGetPixels(TPA);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure FastSetPixel(Bmp,x,y : integer; Color : TColor);
|
procedure FastSetPixel(Bmp,x,y : integer; Color : TColor);
|
||||||
begin
|
begin
|
||||||
CurrThread.Client.MBitmaps.Bmp[bmp].FastSetPixel(x,y,color);
|
CurrThread.Client.MBitmaps.Bmp[bmp].FastSetPixel(x,y,color);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure FastSetPixels(Bmp : integer; TPA : TPointArray; Colors : TIntegerArray);
|
procedure FastSetPixels(Bmp : integer; TPA : TPointArray; Colors : TIntegerArray);
|
||||||
begin;
|
begin;
|
||||||
CurrThread.Client.MBitmaps.Bmp[Bmp].FastSetPixels(TPA,Colors);
|
CurrThread.Client.MBitmaps.Bmp[Bmp].FastSetPixels(TPA,Colors);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure FastDrawClear(bmp : integer; Color : TColor);
|
procedure FastDrawClear(bmp : integer; Color : TColor);
|
||||||
begin;
|
begin;
|
||||||
CurrThread.Client.MBitmaps.Bmp[bmp].FastDrawClear(Color);
|
CurrThread.Client.MBitmaps.Bmp[bmp].FastDrawClear(Color);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);
|
procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);
|
||||||
begin;
|
begin;
|
||||||
CurrThread.Client.MBitmaps.Bmp[SourceBitmap].FastDrawTransparent(x,y,CurrThread.Client.MBitmaps.Bmp[TargetBitmap]);
|
CurrThread.Client.MBitmaps.Bmp[SourceBitmap].FastDrawTransparent(x,y,CurrThread.Client.MBitmaps.Bmp[TargetBitmap]);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure SetTransparentColor(Bmp : integer; Color : TColor);
|
procedure SetTransparentColor(Bmp : integer; Color : TColor);
|
||||||
begin
|
begin
|
||||||
CurrThread.Client.MBitmaps.Bmp[Bmp].SetTransparentColor(Color);
|
CurrThread.Client.MBitmaps.Bmp[Bmp].SetTransparentColor(Color);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function GetTransparentColor(Bmp : integer) : TColor;
|
function GetTransparentColor(Bmp : integer) : TColor;
|
||||||
begin;
|
begin;
|
||||||
Result := CurrThread.Client.MBitmaps.Bmp[bmp].GetTransparentColor;
|
Result := CurrThread.Client.MBitmaps.Bmp[bmp].GetTransparentColor;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure FastReplaceColor(bmp: Integer; OldColor, NewColor: TColor);
|
procedure FastReplaceColor(bmp: Integer; OldColor, NewColor: TColor);
|
||||||
begin
|
begin
|
||||||
CurrThread.Client.MBitmaps.Bmp[Bmp].FastReplaceColor(OldColor,NewColor);
|
CurrThread.Client.MBitmaps.Bmp[Bmp].FastReplaceColor(OldColor,NewColor);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure ps_CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer);
|
procedure ps_CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer);
|
||||||
begin
|
begin
|
||||||
CurrThread.Client.MBitmaps.GetBMP(bmp).CopyClientToBitmap(CurrThread.Client.MWindow, xs, ys, xe, ye);
|
CurrThread.Client.MBitmaps.GetBMP(bmp).CopyClientToBitmap(CurrThread.Client.MWindow, xs, ys, xe, ye);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function FindBitmap(Bitmap: integer; var x, y: Integer): Boolean;
|
function FindBitmap(Bitmap: integer; var x, y: Integer): Boolean;
|
||||||
begin;
|
begin;
|
||||||
with CurrThread.Client do
|
with CurrThread.Client do
|
||||||
result := MFinder.FindBitmap( MBitmaps.Bmp[bitmap],x,y);
|
result := MFinder.FindBitmap( MBitmaps.Bmp[bitmap],x,y);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function FindBitmapIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;
|
function FindBitmapIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;
|
||||||
begin;
|
begin;
|
||||||
with CurrThread.Client do
|
with CurrThread.Client do
|
||||||
result := MFinder.FindBitmapIn( MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye);
|
result := MFinder.FindBitmapIn( MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function FindBitmapToleranceIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean;
|
function FindBitmapToleranceIn(bitmap: integer; var x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer): Boolean;
|
||||||
begin;
|
begin;
|
||||||
with CurrThread.Client do
|
with CurrThread.Client do
|
||||||
result := MFinder.FindBitmapToleranceIn( MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye,tolerance);
|
result := MFinder.FindBitmapToleranceIn( MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye,tolerance);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function FindBitmapSpiral(bitmap: Integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;
|
function FindBitmapSpiral(bitmap: Integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean;
|
||||||
begin;
|
begin;
|
||||||
with CurrThread.Client do
|
with CurrThread.Client do
|
||||||
result := MFinder.FindBitmapSpiral(Mbitmaps.bmp[bitmap],x,y,xs,ys,xe,ye);
|
result := MFinder.FindBitmapSpiral(Mbitmaps.bmp[bitmap],x,y,xs,ys,xe,ye);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function FindBitmapsSpiralTolerance(bitmap: integer; x, y: Integer; var Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean;
|
function FindBitmapsSpiralTolerance(bitmap: integer; x, y: Integer; var Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean;
|
||||||
begin;
|
begin;
|
||||||
with CurrThread.Client do
|
with CurrThread.Client do
|
||||||
result := MFinder.FindBitmapsSpiralTolerance(MBitmaps.Bmp[bitmap],x,y,points,xs,ys,xe,ye,tolerance);
|
result := MFinder.FindBitmapsSpiralTolerance(MBitmaps.Bmp[bitmap],x,y,points,xs,ys,xe,ye,tolerance);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function FindBitmapSpiralTolerance(bitmap: integer; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean;
|
function FindBitmapSpiralTolerance(bitmap: integer; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean;
|
||||||
begin;
|
begin;
|
||||||
with CurrThread.Client do
|
with CurrThread.Client do
|
||||||
result := MFinder.FindBitmapSpiralTolerance(MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye,tolerance);
|
result := MFinder.FindBitmapSpiralTolerance(MBitmaps.Bmp[bitmap],x,y,xs,ys,xe,ye,tolerance);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function RotateBitmap(bitmap: Integer; angle: Extended): Integer;
|
function RotateBitmap(bitmap: Integer; angle: Extended): Integer;
|
||||||
begin;
|
begin;
|
||||||
with CurrThread.Client.MBitmaps do
|
with CurrThread.Client.MBitmaps do
|
||||||
begin;
|
begin;
|
||||||
Result := CreateBMP(0,0);
|
Result := CreateBMP(0,0);
|
||||||
Bmp[Bitmap].RotateBitmap(angle,Bmp[result]);
|
Bmp[Bitmap].RotateBitmap(angle,Bmp[result]);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function Desaturate(Bitmap : integer) : integer;
|
function Desaturate(Bitmap : integer) : integer;
|
||||||
begin;
|
begin;
|
||||||
with CurrThread.Client.MBitmaps do
|
with CurrThread.Client.MBitmaps do
|
||||||
begin;
|
begin;
|
||||||
result := CreateBMP(0,0);
|
result := CreateBMP(0,0);
|
||||||
Bmp[Bitmap].Desaturate(Bmp[result]);
|
Bmp[Bitmap].Desaturate(Bmp[result]);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
procedure InvertBitmap(Bitmap : integer);
|
procedure InvertBitmap(Bitmap : integer);
|
||||||
begin;
|
begin;
|
||||||
CurrThread.Client.MBitmaps.Bmp[Bitmap].Invert;
|
CurrThread.Client.MBitmaps.Bmp[Bitmap].Invert;
|
||||||
end;
|
end;
|
||||||
function CopyBitmap(Bitmap : integer) : integer;
|
function CopyBitmap(Bitmap : integer) : integer;
|
||||||
begin;
|
begin;
|
||||||
result := Currthread.Client.MBitmaps.CopyBMP(bitmap);
|
result := Currthread.Client.MBitmaps.CopyBMP(bitmap);
|
||||||
end;
|
end;
|
||||||
function GreyScaleBitmap(Bitmap : integer) : integer;
|
function GreyScaleBitmap(Bitmap : integer) : integer;
|
||||||
begin;
|
begin;
|
||||||
with CurrThread.Client.MBitmaps do
|
with CurrThread.Client.MBitmaps do
|
||||||
begin;
|
begin;
|
||||||
result := CreateBMP(0,0);
|
result := CreateBMP(0,0);
|
||||||
Bmp[Bitmap].GreyScale(Bmp[result]);
|
Bmp[Bitmap].GreyScale(Bmp[result]);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
function BrightnessBitmap(Bitmap,br : integer) : integer;
|
function BrightnessBitmap(Bitmap,br : integer) : integer;
|
||||||
begin;
|
begin;
|
||||||
with CurrThread.Client.MBitmaps do
|
with CurrThread.Client.MBitmaps do
|
||||||
begin;
|
begin;
|
||||||
result := CreateBMP(0,0);
|
result := CreateBMP(0,0);
|
||||||
Bmp[Bitmap].Brightness(Bmp[result],br);
|
Bmp[Bitmap].Brightness(Bmp[result],br);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
function ContrastBitmap(bitmap : integer; co : extended) : integer;
|
function ContrastBitmap(bitmap : integer; co : extended) : integer;
|
||||||
begin;
|
begin;
|
||||||
with CurrThread.Client.MBitmaps do
|
with CurrThread.Client.MBitmaps do
|
||||||
begin;
|
begin;
|
||||||
result := CreateBMP(0,0);
|
result := CreateBMP(0,0);
|
||||||
Bmp[Bitmap].Contrast(Bmp[result],co);
|
Bmp[Bitmap].Contrast(Bmp[result],co);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function PosterizeBitmap(Bitmap : integer; po : integer) : integer;
|
function PosterizeBitmap(Bitmap : integer; po : integer) : integer;
|
||||||
begin;
|
begin;
|
||||||
with CurrThread.Client.MBitmaps do
|
with CurrThread.Client.MBitmaps do
|
||||||
begin
|
begin
|
||||||
result := CreateBMP(0,0);
|
result := CreateBMP(0,0);
|
||||||
Bmp[bitmap].Posterize(Bmp[result],po);
|
Bmp[bitmap].Posterize(Bmp[result],po);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
function CreateBitmapMask(Bitmap : integer) : TMask;
|
function CreateBitmapMask(Bitmap : integer) : TMask;
|
||||||
begin;
|
begin;
|
||||||
result := CurrThread.Client.MBitmaps.Bmp[Bitmap].CreateTMask;
|
result := CurrThread.Client.MBitmaps.Bmp[Bitmap].CreateTMask;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function FindMaskTolerance(mask: TMask; var x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;
|
function FindMaskTolerance(mask: TMask; var x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;
|
||||||
begin;
|
begin;
|
||||||
result := CurrThread.Client.MFinder.FindBitmapMaskTolerance(Mask,x,y,xs,ys,xe,ye,tolerance,contourtolerance);
|
result := CurrThread.Client.MFinder.FindBitmapMaskTolerance(Mask,x,y,xs,ys,xe,ye,tolerance,contourtolerance);
|
||||||
end;
|
end;
|
||||||
function FindBitmapMaskTolerance(mask: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;
|
function FindBitmapMaskTolerance(mask: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;
|
||||||
begin;
|
begin;
|
||||||
Writeln('Better be using FindMaskTolerance in combination with CreateBitmapMask, more efficient.');
|
Writeln('Better be using FindMaskTolerance in combination with CreateBitmapMask, more efficient.');
|
||||||
with CurrThread.Client do
|
with CurrThread.Client do
|
||||||
result := MFinder.FindBitmapMaskTolerance(MBitmaps.bmp[mask].CreateTMask,x,y,xs,ys,xe,ye,tolerance,contourtolerance);
|
result := MFinder.FindBitmapMaskTolerance(MBitmaps.bmp[mask].CreateTMask,x,y,xs,ys,xe,ye,tolerance,contourtolerance);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function FindDeformedBitmapToleranceIn(bitmap: integer; var x,
|
function FindDeformedBitmapToleranceIn(bitmap: integer; var x,
|
||||||
y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer;
|
y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer;
|
||||||
AllowPartialAccuracy: Boolean; var accuracy: Extended): Boolean;
|
AllowPartialAccuracy: Boolean; var accuracy: Extended): Boolean;
|
||||||
begin;
|
begin;
|
||||||
result := CurrThread.Client.MFinder.FindDeformedBitmapToleranceIn(CurrThread.Client.MBitmaps.bmp[Bitmap],x,y,xs,ys,xe,ye,tolerance,range,AllowPartialAccuracy,accuracy);
|
result := CurrThread.Client.MFinder.FindDeformedBitmapToleranceIn(CurrThread.Client.MBitmaps.bmp[Bitmap],x,y,xs,ys,xe,ye,tolerance,range,AllowPartialAccuracy,accuracy);
|
||||||
end;
|
end;
|
||||||
|
|||||||
@ -1,56 +1,56 @@
|
|||||||
{
|
{
|
||||||
This file is part of the Mufasa Macro Library (MML)
|
This file is part of the Mufasa Macro Library (MML)
|
||||||
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
|
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
|
||||||
|
|
||||||
MML is free software: you can redistribute it and/or modify
|
MML is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU General Public License as published by
|
it under the terms of the GNU General Public License as published by
|
||||||
the Free Software Foundation, either version 3 of the License, or
|
the Free Software Foundation, either version 3 of the License, or
|
||||||
(at your option) any later version.
|
(at your option) any later version.
|
||||||
|
|
||||||
MML is distributed in the hope that it will be useful,
|
MML is distributed in the hope that it will be useful,
|
||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
GNU General Public License for more details.
|
GNU General Public License for more details.
|
||||||
|
|
||||||
You should have received a copy of the GNU General Public License
|
You should have received a copy of the GNU General Public License
|
||||||
along with MML. If not, see <http://www.gnu.org/licenses/>.
|
along with MML. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
See the file COPYING, included in this distribution,
|
See the file COPYING, included in this distribution,
|
||||||
for details about the copyright.
|
for details about the copyright.
|
||||||
|
|
||||||
Other.inc for the Mufasa Macro Library
|
Other.inc for the Mufasa Macro Library
|
||||||
}
|
}
|
||||||
|
|
||||||
procedure Wait(t: Integer);
|
procedure Wait(t: Integer);
|
||||||
begin
|
begin
|
||||||
Sleep(t);
|
Sleep(t);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure SaveScreenshot(FileName: string);
|
procedure SaveScreenshot(FileName: string);
|
||||||
var
|
var
|
||||||
w,h : integer;
|
w,h : integer;
|
||||||
begin;
|
begin;
|
||||||
with CurrThread.Client.MWindow do
|
with CurrThread.Client.MWindow do
|
||||||
begin;
|
begin;
|
||||||
GetDimensions(w,h);
|
GetDimensions(w,h);
|
||||||
with CopyClientToBitmap(0,0,w-1,h-1) do
|
with CopyClientToBitmap(0,0,w-1,h-1) do
|
||||||
begin;
|
begin;
|
||||||
SaveToFile(FileName);
|
SaveToFile(FileName);
|
||||||
Free;
|
Free;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function CreateForm : TForm;
|
function CreateForm : TForm;
|
||||||
begin;
|
begin;
|
||||||
result := TForm.Create(nil);
|
result := TForm.Create(nil);
|
||||||
end;
|
end;
|
||||||
function CreateButton(Owner : TComponent) : TButton;
|
function CreateButton(Owner : TComponent) : TButton;
|
||||||
begin;
|
begin;
|
||||||
Result := TButton.Create(Owner);
|
Result := TButton.Create(Owner);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function Distance(x1, y1, x2, y2: Integer): Integer;
|
function Distance(x1, y1, x2, y2: Integer): Integer;
|
||||||
begin;
|
begin;
|
||||||
Result := Round(Sqrt(Sqr(x2-x1) + Sqr(y2-y1)));
|
Result := Round(Sqrt(Sqr(x2-x1) + Sqr(y2-y1)));
|
||||||
end;
|
end;
|
||||||
|
|||||||
@ -1,48 +1,48 @@
|
|||||||
{
|
{
|
||||||
This file is part of the Mufasa Macro Library (MML)
|
This file is part of the Mufasa Macro Library (MML)
|
||||||
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
|
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
|
||||||
|
|
||||||
MML is free software: you can redistribute it and/or modify
|
MML is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU General Public License as published by
|
it under the terms of the GNU General Public License as published by
|
||||||
the Free Software Foundation, either version 3 of the License, or
|
the Free Software Foundation, either version 3 of the License, or
|
||||||
(at your option) any later version.
|
(at your option) any later version.
|
||||||
|
|
||||||
MML is distributed in the hope that it will be useful,
|
MML is distributed in the hope that it will be useful,
|
||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
GNU General Public License for more details.
|
GNU General Public License for more details.
|
||||||
|
|
||||||
You should have received a copy of the GNU General Public License
|
You should have received a copy of the GNU General Public License
|
||||||
along with MML. If not, see <http://www.gnu.org/licenses/>.
|
along with MML. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
See the file COPYING, included in this distribution,
|
See the file COPYING, included in this distribution,
|
||||||
for details about the copyright.
|
for details about the copyright.
|
||||||
|
|
||||||
window.inc for the Mufasa Macro Library
|
window.inc for the Mufasa Macro Library
|
||||||
}
|
}
|
||||||
|
|
||||||
procedure SetDesktopAsClient;
|
procedure SetDesktopAsClient;
|
||||||
begin;
|
begin;
|
||||||
CurrThread.Client.MWindow.SetDesktop;
|
CurrThread.Client.MWindow.SetDesktop;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure SetTargetBitmap(bitmap: Integer);
|
procedure SetTargetBitmap(bitmap: Integer);
|
||||||
begin;
|
begin;
|
||||||
With CurrThread.Client do
|
With CurrThread.Client do
|
||||||
MWindow.SetTarget(MBitmaps.Bmp[Bitmap]);
|
MWindow.SetTarget(MBitmaps.Bmp[Bitmap]);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure GetClientDimensions(var w, h: integer);
|
procedure GetClientDimensions(var w, h: integer);
|
||||||
begin
|
begin
|
||||||
CurrThread.Client.MWindow.GetDimensions(w, h);
|
CurrThread.Client.MWindow.GetDimensions(w, h);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function Freeze: boolean;
|
function Freeze: boolean;
|
||||||
begin
|
begin
|
||||||
result := CurrThread.Client.MWindow.Freeze();
|
result := CurrThread.Client.MWindow.Freeze();
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function Unfreeze: boolean;
|
function Unfreeze: boolean;
|
||||||
begin
|
begin
|
||||||
result := CurrThread.Client.MWindow.Unfreeze;
|
result := CurrThread.Client.MWindow.Unfreeze;
|
||||||
end;
|
end;
|
||||||
|
|||||||
@ -1,136 +1,136 @@
|
|||||||
{
|
{
|
||||||
This file is part of the Mufasa Macro Library (MML)
|
This file is part of the Mufasa Macro Library (MML)
|
||||||
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
|
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
|
||||||
|
|
||||||
MML is free software: you can redistribute it and/or modify
|
MML is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU General Public License as published by
|
it under the terms of the GNU General Public License as published by
|
||||||
the Free Software Foundation, either version 3 of the License, or
|
the Free Software Foundation, either version 3 of the License, or
|
||||||
(at your option) any later version.
|
(at your option) any later version.
|
||||||
|
|
||||||
MML is distributed in the hope that it will be useful,
|
MML is distributed in the hope that it will be useful,
|
||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
GNU General Public License for more details.
|
GNU General Public License for more details.
|
||||||
|
|
||||||
You should have received a copy of the GNU General Public License
|
You should have received a copy of the GNU General Public License
|
||||||
along with MML. If not, see <http://www.gnu.org/licenses/>.
|
along with MML. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
See the file COPYING, included in this distribution,
|
See the file COPYING, included in this distribution,
|
||||||
for details about the copyright.
|
for details about the copyright.
|
||||||
|
|
||||||
PSCompile.inc for the Mufasa Macro Library
|
PSCompile.inc for the Mufasa Macro Library
|
||||||
}
|
}
|
||||||
|
|
||||||
Sender.Comp.AddConstantN('AppPath','string').SetString(CurrThread.AppPath);
|
Sender.Comp.AddConstantN('AppPath','string').SetString(CurrThread.AppPath);
|
||||||
Sender.Comp.AddConstantN('ScriptPath','string').SetString(CurrThread.ScriptPath);
|
Sender.Comp.AddConstantN('ScriptPath','string').SetString(CurrThread.ScriptPath);
|
||||||
Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer');
|
Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer');
|
||||||
Sender.Comp.AddTypeS('TPointArray','Array of TPoint');
|
Sender.Comp.AddTypeS('TPointArray','Array of TPoint');
|
||||||
Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
|
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('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('TDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;');
|
||||||
Sender.Comp.AddTypes('TDTMPointDefArray', 'Array Of TDTMPointDef;');
|
Sender.Comp.AddTypes('TDTMPointDefArray', 'Array Of TDTMPointDef;');
|
||||||
Sender.Comp.AddTypes('TDTM','record MainPoint: TDTMPointDef; SubPoints: TDTMPointDefArray; end;');
|
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('pDTM','record p: TPointArray; c, t, asz, ash: TIntegerArray; end');
|
||||||
Sender.Comp.AddTypeS('T2DExtendedArray', 'array of array of extended');
|
Sender.Comp.AddTypeS('T2DExtendedArray', 'array of array of extended');
|
||||||
|
|
||||||
Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
|
Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
|
||||||
Sender.AddFunction(@psWriteln,'procedure writeln(s : string);');
|
Sender.AddFunction(@psWriteln,'procedure writeln(s : string);');
|
||||||
|
|
||||||
{ DTM }
|
{ DTM }
|
||||||
|
|
||||||
Sender.AddFunction(@PrintpDTM, 'Procedure PrintpDTM(tDTM : pDTM);');
|
Sender.AddFunction(@PrintpDTM, 'Procedure PrintpDTM(tDTM : pDTM);');
|
||||||
Sender.AddFunction(@ps_GetDTM ,'function GetDTM(index: Integer; var dtm: pDTM): Boolean;');
|
Sender.AddFunction(@ps_GetDTM ,'function GetDTM(index: Integer; var dtm: pDTM): Boolean;');
|
||||||
Sender.AddFunction(@pDTMToTDTM, 'Function pDTMToTDTM(Const DTM: pDTM): TDTM;');
|
Sender.AddFunction(@pDTMToTDTM, 'Function pDTMToTDTM(Const DTM: pDTM): TDTM;');
|
||||||
Sender.AddFunction(@tDTMTopDTM, 'Function tDTMTopDTM(Const DTM: TDTM): pDTM;');
|
Sender.AddFunction(@tDTMTopDTM, 'Function tDTMTopDTM(Const DTM: TDTM): pDTM;');
|
||||||
Sender.AddFunction(@ps_DTMFromString, 'function DTMFromString(DTMString: String): Integer;');
|
Sender.AddFunction(@ps_DTMFromString, 'function DTMFromString(DTMString: String): Integer;');
|
||||||
Sender.AddFunction(@ps_FreeDTM, 'procedure FreeDTM(DTM: 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_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_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_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_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_addDTM, 'function AddDTM(d: TDTM): Integer;');
|
||||||
Sender.AddFunction(@ps_addpDTM, 'function AddpDTM(d: pDTM): Integer;');
|
Sender.AddFunction(@ps_addpDTM, 'function AddpDTM(d: pDTM): Integer;');
|
||||||
|
|
||||||
{maths}
|
{maths}
|
||||||
sender.AddFunction(@power,'function pow(base,exponent : extended) : extended');
|
sender.AddFunction(@power,'function pow(base,exponent : extended) : extended');
|
||||||
Sender.AddFunction(@max,'function Max(a, b: Integer): Integer;');
|
Sender.AddFunction(@max,'function Max(a, b: Integer): Integer;');
|
||||||
Sender.AddFunction(@min,'function Min(a, b: Integer): Integer;');
|
Sender.AddFunction(@min,'function Min(a, b: Integer): Integer;');
|
||||||
Sender.AddFunction(@pssqr,'function Sqr(e : extended) : extended;');
|
Sender.AddFunction(@pssqr,'function Sqr(e : extended) : extended;');
|
||||||
Sender.AddFunction(@classes.point,'function Point(x,y:integer) : TPoint;');
|
Sender.AddFunction(@classes.point,'function Point(x,y:integer) : TPoint;');
|
||||||
Sender.AddFunction(@Distance,'function Distance(x1,y1,x2,y2 : integer) : integer;');
|
Sender.AddFunction(@Distance,'function Distance(x1,y1,x2,y2 : integer) : integer;');
|
||||||
|
|
||||||
{window}
|
{window}
|
||||||
Sender.AddFunction(@Freeze, 'function freeze:boolean;');
|
Sender.AddFunction(@Freeze, 'function freeze:boolean;');
|
||||||
Sender.AddFunction(@Unfreeze, 'function unfreeze: boolean;');
|
Sender.AddFunction(@Unfreeze, 'function unfreeze: boolean;');
|
||||||
Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);');
|
Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);');
|
||||||
Sender.AddFunction(@SetTargetBitmap,'procedure SetTargetBitmap(Bitmap : integer);');
|
Sender.AddFunction(@SetTargetBitmap,'procedure SetTargetBitmap(Bitmap : integer);');
|
||||||
Sender.AddFunction(@SetDesktopAsClient,'procedure SetDesktopAsClient');
|
Sender.AddFunction(@SetDesktopAsClient,'procedure SetDesktopAsClient');
|
||||||
|
|
||||||
|
|
||||||
{other}
|
{other}
|
||||||
Sender.AddFunction(@SaveScreenshot,'procedure SaveScreenshot(FileName: string);');
|
Sender.AddFunction(@SaveScreenshot,'procedure SaveScreenshot(FileName: string);');
|
||||||
Sender.AddFunction(@Wait, 'procedure wait(t: integer);');
|
Sender.AddFunction(@Wait, 'procedure wait(t: integer);');
|
||||||
Sender.AddFunction(@GetTickCount, 'function GetSystemTime: Integer;');
|
Sender.AddFunction(@GetTickCount, 'function GetSystemTime: Integer;');
|
||||||
Sender.AddFunction(@CreateForm,'function CreateForm : TForm;');
|
Sender.AddFunction(@CreateForm,'function CreateForm : TForm;');
|
||||||
Sender.AddFunction(@CreateButton,'function CreateButton(Owner : TComponent) : TButton');
|
Sender.AddFunction(@CreateButton,'function CreateButton(Owner : TComponent) : TButton');
|
||||||
|
|
||||||
|
|
||||||
{Color + Color Finders}
|
{Color + Color Finders}
|
||||||
Sender.AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;');
|
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(@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(@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(@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(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean');
|
||||||
Sender.AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;');
|
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(@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(@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(@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);');
|
Sender.AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
|
||||||
|
|
||||||
{Mouse etc.}
|
{Mouse etc.}
|
||||||
Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);');
|
Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);');
|
||||||
Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);');
|
Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);');
|
||||||
|
|
||||||
|
|
||||||
{Bitmaps}
|
{Bitmaps}
|
||||||
Sender.AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;');
|
Sender.AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;');
|
||||||
Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);');
|
Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);');
|
||||||
Sender.AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);');
|
Sender.AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);');
|
||||||
Sender.AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;');
|
Sender.AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;');
|
||||||
Sender.AddFunction(@LoadBitmap,'function LoadBitmap(Path : string) : integer;');
|
Sender.AddFunction(@LoadBitmap,'function LoadBitmap(Path : string) : integer;');
|
||||||
Sender.AddFunction(@SetBitmapSize,'procedure SetBitmapSize(Bmp,NewW,NewH : integer);');
|
Sender.AddFunction(@SetBitmapSize,'procedure SetBitmapSize(Bmp,NewW,NewH : integer);');
|
||||||
Sender.AddFunction(@GetBitmapSize,'procedure GetBitmapSize(Bmp : integer; Var BmpW,BmpH : integer);');
|
Sender.AddFunction(@GetBitmapSize,'procedure GetBitmapSize(Bmp : integer; Var BmpW,BmpH : integer);');
|
||||||
Sender.AddFunction(@StretchBitmapResize,'procedure StretchBitmapResize(Bmp,NewW,NewH : integer);');
|
Sender.AddFunction(@StretchBitmapResize,'procedure StretchBitmapResize(Bmp,NewW,NewH : integer);');
|
||||||
Sender.AddFunction(@CreateMirroredBitmap,'function CreateMirroredBitmap(Bmp : integer) : integer;');
|
Sender.AddFunction(@CreateMirroredBitmap,'function CreateMirroredBitmap(Bmp : integer) : integer;');
|
||||||
Sender.AddFunction(@CreateMirroredBitmapEx,'function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;');
|
Sender.AddFunction(@CreateMirroredBitmapEx,'function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;');
|
||||||
Sender.AddFunction(@FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : TColor);');
|
Sender.AddFunction(@FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : TColor);');
|
||||||
Sender.AddFunction(@FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);');
|
Sender.AddFunction(@FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);');
|
||||||
Sender.AddFunction(@FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;');
|
Sender.AddFunction(@FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;');
|
||||||
Sender.AddFunction(@FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;');
|
Sender.AddFunction(@FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;');
|
||||||
Sender.AddFunction(@FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor)');
|
Sender.AddFunction(@FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor)');
|
||||||
Sender.AddFunction(@FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);');
|
Sender.AddFunction(@FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);');
|
||||||
Sender.AddFunction(@SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);');
|
Sender.AddFunction(@SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);');
|
||||||
Sender.AddFunction(@GetTransparentColor,'function GetTransparentColor(bmp: integer) : TColor;');
|
Sender.AddFunction(@GetTransparentColor,'function GetTransparentColor(bmp: integer) : TColor;');
|
||||||
Sender.AddFunction(@FastReplaceColor,'procedure FastReplaceColor(Bmp : integer; OldColor,NewColor : 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(@ps_CopyClientToBitmap, 'procedure CopyClientToBitmap(bmp, xs, ys, xe, ye: Integer);');
|
||||||
Sender.AddFunction(@SetBitmapName, 'procedure SetBitmapName(Bmp : integer; name : string);');
|
Sender.AddFunction(@SetBitmapName, 'procedure SetBitmapName(Bmp : integer; name : string);');
|
||||||
Sender.AddFunction(@FindBitmap,'function FindBitmap(bitmap: integer; var x, y: Integer): Boolean;');
|
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(@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(@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(@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(@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(@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(@RotateBitmap,'function RotateBitmap(bitmap: Integer; angle: Extended): Integer;');
|
||||||
Sender.AddFunction(@Desaturate,'function DesaturateBitmap(Bitmap : integer) : integer;');
|
Sender.AddFunction(@Desaturate,'function DesaturateBitmap(Bitmap : integer) : integer;');
|
||||||
sender.AddFunction(@InvertBitmap,'procedure InvertBitmap(Bitmap : integer);');
|
sender.AddFunction(@InvertBitmap,'procedure InvertBitmap(Bitmap : integer);');
|
||||||
Sender.AddFunction(@CopyBitmap,'function CopyBitmap(Bitmap: integer) : integer)');
|
Sender.AddFunction(@CopyBitmap,'function CopyBitmap(Bitmap: integer) : integer)');
|
||||||
Sender.AddFunction(@GreyScaleBitmap,'function GreyScaleBitmap(bitmap : integer) : integer');
|
Sender.AddFunction(@GreyScaleBitmap,'function GreyScaleBitmap(bitmap : integer) : integer');
|
||||||
Sender.AddFunction(@BrightnessBitmap,'function BrightnessBitmap(Bitmap,br : integer) : integer;');
|
Sender.AddFunction(@BrightnessBitmap,'function BrightnessBitmap(Bitmap,br : integer) : integer;');
|
||||||
Sender.AddFunction(@ContrastBitmap,'function ContrastBitmap(bitmap : integer; co : extended) : integer;');
|
Sender.AddFunction(@ContrastBitmap,'function ContrastBitmap(bitmap : integer; co : extended) : integer;');
|
||||||
Sender.AddFunction(@PosterizeBitmap,'function PosterizeBitmap(Bitmap : integer; po : integer) : integer;');
|
Sender.AddFunction(@PosterizeBitmap,'function PosterizeBitmap(Bitmap : integer; po : integer) : integer;');
|
||||||
Sender.AddFunction(@CreateBitmapMask,'function CreateBitmapMask(Bitmap : integer) : TMask;');
|
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(@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(@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;');
|
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;');
|
||||||
|
|||||||
@ -1,235 +1,235 @@
|
|||||||
{
|
{
|
||||||
This file is part of the Mufasa Macro Library (MML)
|
This file is part of the Mufasa Macro Library (MML)
|
||||||
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
|
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
|
||||||
|
|
||||||
MML is free software: you can redistribute it and/or modify
|
MML is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU General Public License as published by
|
it under the terms of the GNU General Public License as published by
|
||||||
the Free Software Foundation, either version 3 of the License, or
|
the Free Software Foundation, either version 3 of the License, or
|
||||||
(at your option) any later version.
|
(at your option) any later version.
|
||||||
|
|
||||||
MML is distributed in the hope that it will be useful,
|
MML is distributed in the hope that it will be useful,
|
||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
GNU General Public License for more details.
|
GNU General Public License for more details.
|
||||||
|
|
||||||
You should have received a copy of the GNU General Public License
|
You should have received a copy of the GNU General Public License
|
||||||
along with MML. If not, see <http://www.gnu.org/licenses/>.
|
along with MML. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
See the file COPYING, included in this distribution,
|
See the file COPYING, included in this distribution,
|
||||||
for details about the copyright.
|
for details about the copyright.
|
||||||
|
|
||||||
Colourpicker for the Mufasa Macro Library
|
Colourpicker for the Mufasa Macro Library
|
||||||
}
|
}
|
||||||
|
|
||||||
unit colourpicker;
|
unit colourpicker;
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, LCLIntf,LCLType,InterfaceBase,Forms,Controls,ExtCtrls,
|
Classes, SysUtils, LCLIntf,LCLType,InterfaceBase,Forms,Controls,ExtCtrls,
|
||||||
Graphics,
|
Graphics,
|
||||||
Window,MufasaTypes
|
Window,MufasaTypes
|
||||||
|
|
||||||
{$IFNDEF PICKER_CLIENT}
|
{$IFNDEF PICKER_CLIENT}
|
||||||
{$IFDEF LINUX}
|
{$IFDEF LINUX}
|
||||||
,x
|
,x
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
;
|
;
|
||||||
|
|
||||||
type
|
type
|
||||||
TPickEvent = procedure (Sender: TObject; Color, X, Y: Integer);
|
TPickEvent = procedure (Sender: TObject; Color, X, Y: Integer);
|
||||||
|
|
||||||
TMColorPicker = class(TObject)
|
TMColorPicker = class(TObject)
|
||||||
constructor Create(aWindow: TMWindow);
|
constructor Create(aWindow: TMWindow);
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
|
|
||||||
procedure Pick(Out C, X, Y: Integer);
|
procedure Pick(Out C, X, Y: Integer);
|
||||||
|
|
||||||
procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer );
|
procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer );
|
||||||
procedure TimorTimer(Sender: TObject);
|
procedure TimorTimer(Sender: TObject);
|
||||||
Procedure ColorPickDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
|
Procedure ColorPickDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
|
||||||
public
|
public
|
||||||
// Will give us CopyClientToBitmap
|
// Will give us CopyClientToBitmap
|
||||||
Window: TMWindow;
|
Window: TMWindow;
|
||||||
ColourHistory: TList; // for colour history
|
ColourHistory: TList; // for colour history
|
||||||
|
|
||||||
Form : TForm;
|
Form : TForm;
|
||||||
Image: TImage;
|
Image: TImage;
|
||||||
Timor : TTimer;
|
Timor : TTimer;
|
||||||
Bitmap : Graphics.TBitmap;
|
Bitmap : Graphics.TBitmap;
|
||||||
Note : Graphics.TBitmap;
|
Note : Graphics.TBitmap;
|
||||||
Brush : TBrush;
|
Brush : TBrush;
|
||||||
Text : string;
|
Text : string;
|
||||||
FPickEvent : TPickEvent;
|
FPickEvent : TPickEvent;
|
||||||
|
|
||||||
oldx, oldy, Color, colorx, colory: Integer;
|
oldx, oldy, Color, colorx, colory: Integer;
|
||||||
|
|
||||||
TheChangedEvent,TheChangingEvent : TNotifyEvent;
|
TheChangedEvent,TheChangingEvent : TNotifyEvent;
|
||||||
NoteHandle, BitmapHandle, ImageHandle : HDC;
|
NoteHandle, BitmapHandle, ImageHandle : HDC;
|
||||||
public
|
public
|
||||||
property OnPick: TPickEvent read FPickEvent write FPickEvent;
|
property OnPick: TPickEvent read FPickEvent write FPickEvent;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
constructor TMColorPicker.Create(aWindow: TMWindow);
|
constructor TMColorPicker.Create(aWindow: TMWindow);
|
||||||
begin
|
begin
|
||||||
Self.Window := aWindow;
|
Self.Window := aWindow;
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TMColorPicker.Destroy;
|
destructor TMColorPicker.Destroy;
|
||||||
begin
|
begin
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMColorPicker.Pick(Out C, X, Y: Integer);
|
procedure TMColorPicker.Pick(Out C, X, Y: Integer);
|
||||||
var
|
var
|
||||||
w, h: integer;
|
w, h: integer;
|
||||||
bmp: TBitmap;
|
bmp: TBitmap;
|
||||||
|
|
||||||
{$IFNDEF PICKER_CLIENT}
|
{$IFNDEF PICKER_CLIENT}
|
||||||
{$IFDEF LINUX}
|
{$IFDEF LINUX}
|
||||||
OldWindow: TWindow;
|
OldWindow: TWindow;
|
||||||
{$ELSE}
|
{$ELSE}
|
||||||
OldWindow: HWND;
|
OldWindow: HWND;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Form := TForm.Create(Application.MainForm);
|
Form := TForm.Create(Application.MainForm);
|
||||||
{$IFNDEF PICKER_CLIENT}
|
{$IFNDEF PICKER_CLIENT}
|
||||||
{$IFDEF LINUX}
|
{$IFDEF LINUX}
|
||||||
OldWindow := Window.CurWindow;
|
OldWindow := Window.CurWindow;
|
||||||
{$ELSE}
|
{$ELSE}
|
||||||
OldWindow := Window.TargetHandle;
|
OldWindow := Window.TargetHandle;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
Window.SetDesktop;
|
Window.SetDesktop;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
w := 0;
|
w := 0;
|
||||||
h := 0;
|
h := 0;
|
||||||
Window.GetDimensions(w, h);
|
Window.GetDimensions(w, h);
|
||||||
|
|
||||||
Form.Width := w;
|
Form.Width := w;
|
||||||
Form.Height := h;
|
Form.Height := h;
|
||||||
Form.Top := 0;
|
Form.Top := 0;
|
||||||
Form.left := 0;
|
Form.left := 0;
|
||||||
Form.WindowState := wsmaximized;
|
Form.WindowState := wsmaximized;
|
||||||
Form.BorderStyle:= bsNone;
|
Form.BorderStyle:= bsNone;
|
||||||
|
|
||||||
Image := TImage.Create(Form);
|
Image := TImage.Create(Form);
|
||||||
Image.Parent := Form;
|
Image.Parent := Form;
|
||||||
Image.left := 0;
|
Image.left := 0;
|
||||||
image.Width := 0;
|
image.Width := 0;
|
||||||
Image.width := Form.Width - 1;
|
Image.width := Form.Width - 1;
|
||||||
Image.Height := Form.Height - 1;
|
Image.Height := Form.Height - 1;
|
||||||
Image.Cursor:= crCross;
|
Image.Cursor:= crCross;
|
||||||
Image.OnMouseDown:= @ColorPickDown;
|
Image.OnMouseDown:= @ColorPickDown;
|
||||||
Image.OnMouseMove:=@ImageMouseMove;
|
Image.OnMouseMove:=@ImageMouseMove;
|
||||||
Image.Canvas.Brush.Color := 14811135;
|
Image.Canvas.Brush.Color := 14811135;
|
||||||
Bitmap := Graphics.TBitmap.create;
|
Bitmap := Graphics.TBitmap.create;
|
||||||
Bitmap.width := Form.Width;
|
Bitmap.width := Form.Width;
|
||||||
Bitmap.Height := Form.Height;
|
Bitmap.Height := Form.Height;
|
||||||
Note := Graphics.TBitmap.create;
|
Note := Graphics.TBitmap.create;
|
||||||
Note.Canvas.Brush.Color := 14811135;
|
Note.Canvas.Brush.Color := 14811135;
|
||||||
Note.Width := 148;
|
Note.Width := 148;
|
||||||
Note.Height := 33;
|
Note.Height := 33;
|
||||||
Note.Canvas.Rectangle(0, 0, 147, 33);
|
Note.Canvas.Rectangle(0, 0, 147, 33);
|
||||||
Note.Canvas.Rectangle(89, 3, 115, 29);
|
Note.Canvas.Rectangle(89, 3, 115, 29);
|
||||||
Note.Canvas.Pen.Style:= psClear;
|
Note.Canvas.Pen.Style:= psClear;
|
||||||
|
|
||||||
bmp := Window.CopyClientToBitmap(0, 0, w - 1, h - 1);
|
bmp := Window.CopyClientToBitmap(0, 0, w - 1, h - 1);
|
||||||
BitBlt(Image.Canvas.Handle, 0,0,w ,h , bmp.Canvas.Handle,0,0,SRCCOPY);
|
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);
|
BitBlt(Bitmap.Canvas.Handle, 0,0,w ,h , bmp.Canvas.Handle,0,0,SRCCOPY);
|
||||||
bmp.Free;
|
bmp.Free;
|
||||||
|
|
||||||
ImageHandle:= Image.Canvas.Handle;
|
ImageHandle:= Image.Canvas.Handle;
|
||||||
BitmapHandle:= Bitmap.Canvas.Handle;
|
BitmapHandle:= Bitmap.Canvas.Handle;
|
||||||
NoteHandle:= Note.Canvas.Handle;
|
NoteHandle:= Note.Canvas.Handle;
|
||||||
TheChangedEvent := Image.Canvas.OnChange;
|
TheChangedEvent := Image.Canvas.OnChange;
|
||||||
TheChangingEvent := Image.Canvas.OnChanging;
|
TheChangingEvent := Image.Canvas.OnChanging;
|
||||||
|
|
||||||
Brush := Image.Canvas.Brush;
|
Brush := Image.Canvas.Brush;
|
||||||
Timor := TTimer.Create(Form);
|
Timor := TTimer.Create(Form);
|
||||||
|
|
||||||
Timor.OnTimer:= @TimorTimer;
|
Timor.OnTimer:= @TimorTimer;
|
||||||
Timor.Interval:= 50;
|
Timor.Interval:= 50;
|
||||||
Timor.Enabled:= False;
|
Timor.Enabled:= False;
|
||||||
|
|
||||||
Form.ShowModal;
|
Form.ShowModal;
|
||||||
|
|
||||||
// add x to history here.
|
// add x to history here.
|
||||||
c := Color;
|
c := Color;
|
||||||
x := Colorx;
|
x := Colorx;
|
||||||
y := Colory;
|
y := Colory;
|
||||||
|
|
||||||
{$IFNDEF PICKER_CLIENT}
|
{$IFNDEF PICKER_CLIENT}
|
||||||
{$IFDEF LINUX}
|
{$IFDEF LINUX}
|
||||||
Window.SetTarget(OldWindow);
|
Window.SetTarget(OldWindow);
|
||||||
{$ELSE}
|
{$ELSE}
|
||||||
Window.SetTarget(OldWindow, w_Window);
|
Window.SetTarget(OldWindow, w_Window);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
Note.Free;
|
Note.Free;
|
||||||
Bitmap.Free;
|
Bitmap.Free;
|
||||||
Timor.Free;
|
Timor.Free;
|
||||||
Image.Free;
|
Image.Free;
|
||||||
Form.Free;
|
Form.Free;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMColorPicker.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
|
procedure TMColorPicker.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
|
||||||
Y: Integer);
|
Y: Integer);
|
||||||
begin
|
begin
|
||||||
Timor.Enabled:= True;
|
Timor.Enabled:= True;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMColorPicker.TimorTimer(Sender: TObject);
|
procedure TMColorPicker.TimorTimer(Sender: TObject);
|
||||||
var
|
var
|
||||||
TempPoint : TPoint;
|
TempPoint : TPoint;
|
||||||
begin
|
begin
|
||||||
// GetCursorPos(TempPoint);
|
// GetCursorPos(TempPoint);
|
||||||
TempPoint := Mouse.CursorPos;
|
TempPoint := Mouse.CursorPos;
|
||||||
|
|
||||||
{ If a form cannot be fully set to 0,0 }
|
{ If a form cannot be fully set to 0,0 }
|
||||||
TempPoint.X := TempPoint.X - Form.Left;
|
TempPoint.X := TempPoint.X - Form.Left;
|
||||||
TempPoint.Y := TempPoint.Y - Form.Top;
|
TempPoint.Y := TempPoint.Y - Form.Top;
|
||||||
|
|
||||||
BitBlt(ImageHandle, oldx + 5, oldy + 5,147,33,BitmapHandle,oldx + 5,oldy + 5,SRCCOPY);
|
BitBlt(ImageHandle, oldx + 5, oldy + 5,147,33,BitmapHandle,oldx + 5,oldy + 5,SRCCOPY);
|
||||||
Color := WidgetSet.DCGetPixel(ImageHandle, TempPoint.X, TempPoint.Y);
|
Color := WidgetSet.DCGetPixel(ImageHandle, TempPoint.X, TempPoint.Y);
|
||||||
Rectangle(NoteHandle,1,1,85,32);
|
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 - Client.Rect.Left) + ',' + inttostr(TempPoint.y - Client.Rect.Bottom);
|
||||||
Text:='Pos: ' + inttostr(TempPoint.x) + ',' + inttostr(TempPoint.y);
|
Text:='Pos: ' + inttostr(TempPoint.x) + ',' + inttostr(TempPoint.y);
|
||||||
ExtTextOut(NoteHandle, 5, 3,0,nil,pchar(text),length(text),nil);
|
ExtTextOut(NoteHandle, 5, 3,0,nil,pchar(text),length(text),nil);
|
||||||
Text := 'Color: ' + inttostr(Color);
|
Text := 'Color: ' + inttostr(Color);
|
||||||
ExtTextOut(NoteHandle, 5, 15,0,nil,pchar(text),length(text),nil);
|
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);
|
BitBlt( ImageHandle, TempPoint.x + 5, TempPoint.y + 5,147,33,NoteHandle,0,0,SRCCOPY);
|
||||||
Brush.Color := Color;
|
Brush.Color := Color;
|
||||||
Image.Canvas.Rectangle(TempPoint.x + 123, TempPoint.y + 8, tempPoint.x + 149, temppoint.y + 34);
|
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);
|
// Rectangle(ImageHandle,TempPoint.x + 123, TempPoint.y + 8, tempPoint.x + 149, temppoint.y + 34);
|
||||||
TheChangingEvent(Sender);
|
TheChangingEvent(Sender);
|
||||||
StretchBlt(ImageHandle,TempPoint.x + 95, TempPoint.y + 9, 24,24, BitmapHandle, TempPoint.x - 1, TempPoint.y-1,3,3, SRCCOPY);
|
StretchBlt(ImageHandle,TempPoint.x + 95, TempPoint.y + 9, 24,24, BitmapHandle, TempPoint.x - 1, TempPoint.y-1,3,3, SRCCOPY);
|
||||||
TheChangedEvent(Sender);
|
TheChangedEvent(Sender);
|
||||||
Oldx := TempPoint.x;
|
Oldx := TempPoint.x;
|
||||||
Oldy := TempPoint.y;
|
Oldy := TempPoint.y;
|
||||||
Timor.Enabled:= False;
|
Timor.Enabled:= False;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMColorPicker.ColorPickDown(Sender: TObject; Button: TMouseButton;
|
procedure TMColorPicker.ColorPickDown(Sender: TObject; Button: TMouseButton;
|
||||||
Shift: TShiftState; X, Y: Integer);
|
Shift: TShiftState; X, Y: Integer);
|
||||||
begin;
|
begin;
|
||||||
Color:= WidgetSet.DCGetPixel(Image.Canvas.Handle,x,y);
|
Color:= WidgetSet.DCGetPixel(Image.Canvas.Handle,x,y);
|
||||||
Self.Colorx := x;
|
Self.Colorx := x;
|
||||||
Self.Colory := y;
|
Self.Colory := y;
|
||||||
Timor.enabled := false;
|
Timor.enabled := false;
|
||||||
if OnPick <> nil then
|
if OnPick <> nil then
|
||||||
Onpick(Sender,Color,x,y);
|
Onpick(Sender,Color,x,y);
|
||||||
Form.Close;
|
Form.Close;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
@ -1,304 +1,304 @@
|
|||||||
{
|
{
|
||||||
This file is part of the Mufasa Macro Library (MML)
|
This file is part of the Mufasa Macro Library (MML)
|
||||||
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
|
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
|
||||||
|
|
||||||
MML is free software: you can redistribute it and/or modify
|
MML is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU General Public License as published by
|
it under the terms of the GNU General Public License as published by
|
||||||
the Free Software Foundation, either version 3 of the License, or
|
the Free Software Foundation, either version 3 of the License, or
|
||||||
(at your option) any later version.
|
(at your option) any later version.
|
||||||
|
|
||||||
MML is distributed in the hope that it will be useful,
|
MML is distributed in the hope that it will be useful,
|
||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
GNU General Public License for more details.
|
GNU General Public License for more details.
|
||||||
|
|
||||||
You should have received a copy of the GNU General Public License
|
You should have received a copy of the GNU General Public License
|
||||||
along with MML. If not, see <http://www.gnu.org/licenses/>.
|
along with MML. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
See the file COPYING, included in this distribution,
|
See the file COPYING, included in this distribution,
|
||||||
for details about the copyright.
|
for details about the copyright.
|
||||||
|
|
||||||
Colour Conversion Utilities for the Mufasa Macro Library
|
Colour Conversion Utilities for the Mufasa Macro Library
|
||||||
}
|
}
|
||||||
|
|
||||||
unit colour_conv;
|
unit colour_conv;
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils,
|
Classes, SysUtils,
|
||||||
Graphics,
|
Graphics,
|
||||||
Math;
|
Math;
|
||||||
|
|
||||||
|
|
||||||
Function RGBtoColor(r,g,b : byte) : TColor; overload; inline;
|
Function RGBtoColor(r,g,b : byte) : TColor; overload; inline;
|
||||||
Function RGBtoColor(r,g,b : integer) : 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 : byte); overload; inline;
|
||||||
Procedure ColorToRGB(Color : integer;var r,g,b : integer); 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 RGBToXYZ(R,G,B : integer;var x,y,z : Extended); inline;
|
||||||
Procedure XYZToRGB(X,Y,Z : Extended;var R,G,B: integer); 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 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 : Byte); inline;overload;
|
||||||
Procedure HSLtoRGB(H,S,L : extended;var R,G,B : Integer); 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;
|
Procedure ColorToHSL(Col: Integer; var h, s, l: Extended); inline;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
Const
|
Const
|
||||||
OneDivThree = 1/3.0;
|
OneDivThree = 1/3.0;
|
||||||
TwoDivThree = 2 / 3.0;
|
TwoDivThree = 2 / 3.0;
|
||||||
OneDivTwoPointFour = 1 / 2.4;
|
OneDivTwoPointFour = 1 / 2.4;
|
||||||
|
|
||||||
Function RGBtoColor(r,g,b : byte): TColor; overload; inline;
|
Function RGBtoColor(r,g,b : byte): TColor; overload; inline;
|
||||||
begin;
|
begin;
|
||||||
Result := R or g shl 8 or b shl 16;
|
Result := R or g shl 8 or b shl 16;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{/\
|
{/\
|
||||||
Translates the given Red (R), Green (G) and Blue (B) components to a TColor.
|
Translates the given Red (R), Green (G) and Blue (B) components to a TColor.
|
||||||
R, G and B are integers.
|
R, G and B are integers.
|
||||||
/\}
|
/\}
|
||||||
|
|
||||||
Function RGBtoColor(r,g,b : integer): TColor; overload; inline;
|
Function RGBtoColor(r,g,b : integer): TColor; overload; inline;
|
||||||
begin;
|
begin;
|
||||||
Result := R or g shl 8 or b shl 16;
|
Result := R or g shl 8 or b shl 16;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{/\
|
{/\
|
||||||
Translates the given win-32 color in the Red (R), Green (G) and Blue (B)
|
Translates the given win-32 color in the Red (R), Green (G) and Blue (B)
|
||||||
components. R, G and B are bytes.
|
components. R, G and B are bytes.
|
||||||
/\}
|
/\}
|
||||||
|
|
||||||
Procedure ColorToRGB(Color : integer;var r,g,b : byte); overload; inline;
|
Procedure ColorToRGB(Color : integer;var r,g,b : byte); overload; inline;
|
||||||
begin
|
begin
|
||||||
R := Color and $ff;
|
R := Color and $ff;
|
||||||
G := Color shr 8 and $ff;
|
G := Color shr 8 and $ff;
|
||||||
B := Color shr 16 and $ff;
|
B := Color shr 16 and $ff;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{/\
|
{/\
|
||||||
Translates the given win-32 color in the Red (R), Green (G) and Blue (B)
|
Translates the given win-32 color in the Red (R), Green (G) and Blue (B)
|
||||||
components. R, G and B are integers.
|
components. R, G and B are integers.
|
||||||
/\}
|
/\}
|
||||||
|
|
||||||
Procedure ColorToRGB(Color : integer;var r,g,b : integer); overload; inline;
|
Procedure ColorToRGB(Color : integer;var r,g,b : integer); overload; inline;
|
||||||
begin
|
begin
|
||||||
R := Color and $ff;
|
R := Color and $ff;
|
||||||
G := Color shr 8 and $ff;
|
G := Color shr 8 and $ff;
|
||||||
B := Color shr 16 and $ff;
|
B := Color shr 16 and $ff;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{/\
|
{/\
|
||||||
Translates the given Red (R), Green (G) and Blue (B) components to
|
Translates the given Red (R), Green (G) and Blue (B) components to
|
||||||
X, Y and Z components.
|
X, Y and Z components.
|
||||||
/\}
|
/\}
|
||||||
|
|
||||||
Procedure RGBToXYZ(R,G,B : integer;var x,y,z : Extended); inline;
|
Procedure RGBToXYZ(R,G,B : integer;var x,y,z : Extended); inline;
|
||||||
var
|
var
|
||||||
Red,Green,Blue : Extended;
|
Red,Green,Blue : Extended;
|
||||||
begin;
|
begin;
|
||||||
Red := R / 255;
|
Red := R / 255;
|
||||||
Green := G / 255;
|
Green := G / 255;
|
||||||
Blue := B / 255;
|
Blue := B / 255;
|
||||||
if Red > 0.04045 then
|
if Red > 0.04045 then
|
||||||
Red := Power( ( Red + 0.055 ) / 1.055 , 2.4) * 100
|
Red := Power( ( Red + 0.055 ) / 1.055 , 2.4) * 100
|
||||||
else
|
else
|
||||||
Red := Red / 7.73994;
|
Red := Red / 7.73994;
|
||||||
if Green > 0.04045 then
|
if Green > 0.04045 then
|
||||||
Green := Power( ( Green + 0.055 ) / 1.055 , 2.4) * 100
|
Green := Power( ( Green + 0.055 ) / 1.055 , 2.4) * 100
|
||||||
else
|
else
|
||||||
Green := Green / 7.73994;
|
Green := Green / 7.73994;
|
||||||
if Blue > 0.04045 then
|
if Blue > 0.04045 then
|
||||||
Blue := Power( ( Blue + 0.055 ) / 1.055 , 2.4) * 100
|
Blue := Power( ( Blue + 0.055 ) / 1.055 , 2.4) * 100
|
||||||
else
|
else
|
||||||
Blue := Blue / 7.73994;
|
Blue := Blue / 7.73994;
|
||||||
X := Red * 0.4124 + Green * 0.3576 + Blue * 0.1805;
|
X := Red * 0.4124 + Green * 0.3576 + Blue * 0.1805;
|
||||||
Y := Red * 0.2126 + Green * 0.7152 + Blue * 0.0722;
|
Y := Red * 0.2126 + Green * 0.7152 + Blue * 0.0722;
|
||||||
Z := Red * 0.0193 + Green * 0.1192 + Blue * 0.9505;
|
Z := Red * 0.0193 + Green * 0.1192 + Blue * 0.9505;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{/\
|
{/\
|
||||||
Translates the given X, Y and Z components to
|
Translates the given X, Y and Z components to
|
||||||
Red (R), Green (G) and Blue (B) components.
|
Red (R), Green (G) and Blue (B) components.
|
||||||
/\}
|
/\}
|
||||||
|
|
||||||
Procedure XYZToRGB(X,Y,Z : Extended;var R,G,B: integer); inline;
|
Procedure XYZToRGB(X,Y,Z : Extended;var R,G,B: integer); inline;
|
||||||
var
|
var
|
||||||
TempR,TempG,TempB,Tempx,tempy,tempz : Extended;
|
TempR,TempG,TempB,Tempx,tempy,tempz : Extended;
|
||||||
begin;
|
begin;
|
||||||
Tempx := X / 100;
|
Tempx := X / 100;
|
||||||
tempy := Y / 100;
|
tempy := Y / 100;
|
||||||
tempz := Z / 100;
|
tempz := Z / 100;
|
||||||
TempR := Tempx * 3.2406 + tempy * -1.5372 + tempz * -0.4986;
|
TempR := Tempx * 3.2406 + tempy * -1.5372 + tempz * -0.4986;
|
||||||
TempG := Tempx * -0.9689 + tempy * 1.8758 + tempz * 0.0415;
|
TempG := Tempx * -0.9689 + tempy * 1.8758 + tempz * 0.0415;
|
||||||
TempB := Tempx * 0.0557 + tempy * -0.2040 + tempz * 1.0570;
|
TempB := Tempx * 0.0557 + tempy * -0.2040 + tempz * 1.0570;
|
||||||
if TempR > 0.0031308 then
|
if TempR > 0.0031308 then
|
||||||
TempR := 1.055 * ( Power(TempR, (OneDivTwoPointFour)) ) - 0.055
|
TempR := 1.055 * ( Power(TempR, (OneDivTwoPointFour)) ) - 0.055
|
||||||
else
|
else
|
||||||
TempR := 12.92 * TempR;
|
TempR := 12.92 * TempR;
|
||||||
if TempG > 0.0031308 then
|
if TempG > 0.0031308 then
|
||||||
TempG := 1.055 * ( Power(TempG, ( OneDivTwoPointFour)) ) - 0.055
|
TempG := 1.055 * ( Power(TempG, ( OneDivTwoPointFour)) ) - 0.055
|
||||||
else
|
else
|
||||||
TempG := 12.92 * TempG;
|
TempG := 12.92 * TempG;
|
||||||
if TempB > 0.0031308 then
|
if TempB > 0.0031308 then
|
||||||
TempB := 1.055 * ( Power(TempB , ( OneDivTwoPointFour )) ) - 0.055
|
TempB := 1.055 * ( Power(TempB , ( OneDivTwoPointFour )) ) - 0.055
|
||||||
else
|
else
|
||||||
TempB := 12.92 * TempB;
|
TempB := 12.92 * TempB;
|
||||||
R := Round(TempR * 255);
|
R := Round(TempR * 255);
|
||||||
G := Round(TempG * 255);
|
G := Round(TempG * 255);
|
||||||
B := Round(TempB * 255);
|
B := Round(TempB * 255);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{/\
|
{/\
|
||||||
Translates the given Red (R), Green (G) and Blue (B) components to
|
Translates the given Red (R), Green (G) and Blue (B) components to
|
||||||
H (Hue), S (Saturation) and L (Luminance) components.
|
H (Hue), S (Saturation) and L (Luminance) components.
|
||||||
/\}
|
/\}
|
||||||
|
|
||||||
Procedure RGBToHSL(RR,GG,BB : integer;var H,S,L : Extended); inline;
|
Procedure RGBToHSL(RR,GG,BB : integer;var H,S,L : Extended); inline;
|
||||||
var
|
var
|
||||||
R, G, B, D, Cmax, Cmin: Extended;
|
R, G, B, D, Cmax, Cmin: Extended;
|
||||||
begin
|
begin
|
||||||
R := RR / 255;
|
R := RR / 255;
|
||||||
G := GG / 255;
|
G := GG / 255;
|
||||||
B := BB / 255;
|
B := BB / 255;
|
||||||
CMin := R;
|
CMin := R;
|
||||||
if G < Cmin then Cmin := G;
|
if G < Cmin then Cmin := G;
|
||||||
if B < Cmin then Cmin := B;
|
if B < Cmin then Cmin := B;
|
||||||
CMax := R;
|
CMax := R;
|
||||||
if G > Cmax then Cmax := G;
|
if G > Cmax then Cmax := G;
|
||||||
if B > Cmax then Cmax := B;
|
if B > Cmax then Cmax := B;
|
||||||
L := 0.5 * (Cmax + Cmin);
|
L := 0.5 * (Cmax + Cmin);
|
||||||
if Cmax = Cmin then
|
if Cmax = Cmin then
|
||||||
begin
|
begin
|
||||||
H := 0;
|
H := 0;
|
||||||
S := 0;
|
S := 0;
|
||||||
end else
|
end else
|
||||||
begin;
|
begin;
|
||||||
D := Cmax - Cmin;
|
D := Cmax - Cmin;
|
||||||
if L < 0.5 then
|
if L < 0.5 then
|
||||||
S := D / (Cmax + Cmin)
|
S := D / (Cmax + Cmin)
|
||||||
else
|
else
|
||||||
S := D / (2 - Cmax - Cmin);
|
S := D / (2 - Cmax - Cmin);
|
||||||
if R = Cmax then
|
if R = Cmax then
|
||||||
H := (G - B) / D
|
H := (G - B) / D
|
||||||
else
|
else
|
||||||
if G = Cmax then
|
if G = Cmax then
|
||||||
H := 2 + (B - R) / D
|
H := 2 + (B - R) / D
|
||||||
else
|
else
|
||||||
H := 4 + (R - G) / D;
|
H := 4 + (R - G) / D;
|
||||||
H := H / 6;
|
H := H / 6;
|
||||||
if H < 0 then
|
if H < 0 then
|
||||||
H := H + 1;
|
H := H + 1;
|
||||||
end;
|
end;
|
||||||
H := H * 100;
|
H := H * 100;
|
||||||
S := S * 100;
|
S := S * 100;
|
||||||
L := L * 100;
|
L := L * 100;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{/\
|
{/\
|
||||||
Translates the given H (Hue), S (Saturation) and L (Luminance) components to
|
Translates the given H (Hue), S (Saturation) and L (Luminance) components to
|
||||||
Red (R), Green (G) and Blue (B) components.
|
Red (R), Green (G) and Blue (B) components.
|
||||||
/\}
|
/\}
|
||||||
|
|
||||||
procedure HSLtoRGB(H, S, L: extended; var R, G, B: Byte); inline; overload;
|
procedure HSLtoRGB(H, S, L: extended; var R, G, B: Byte); inline; overload;
|
||||||
var
|
var
|
||||||
Temp,Temp2 : Extended;
|
Temp,Temp2 : Extended;
|
||||||
//begin
|
//begin
|
||||||
|
|
||||||
Function Hue2RGB(TempHue : Extended) : integer;
|
Function Hue2RGB(TempHue : Extended) : integer;
|
||||||
begin;
|
begin;
|
||||||
if TempHue < 0 then
|
if TempHue < 0 then
|
||||||
TempHue := TempHue + 1
|
TempHue := TempHue + 1
|
||||||
else if TempHue > 1 then
|
else if TempHue > 1 then
|
||||||
TempHue := TempHue - 1;
|
TempHue := TempHue - 1;
|
||||||
if ( ( 6 * TempHue ) < 1 ) then
|
if ( ( 6 * TempHue ) < 1 ) then
|
||||||
Result :=Round(255 * (( Temp + ( Temp2 - Temp ) * 6 * TempHue )))
|
Result :=Round(255 * (( Temp + ( Temp2 - Temp ) * 6 * TempHue )))
|
||||||
else if ( ( 2 * TempHue ) < 1 ) then
|
else if ( ( 2 * TempHue ) < 1 ) then
|
||||||
Result :=Round(255 * Temp2)
|
Result :=Round(255 * Temp2)
|
||||||
else if ( ( 3 * TempHue ) < 2 ) then
|
else if ( ( 3 * TempHue ) < 2 ) then
|
||||||
Result :=Round(255 * (Temp + ( Temp2 - Temp ) * ( ( TwoDivThree ) - TempHue ) * 6))
|
Result :=Round(255 * (Temp + ( Temp2 - Temp ) * ( ( TwoDivThree ) - TempHue ) * 6))
|
||||||
else
|
else
|
||||||
Result :=Round(255 * Temp);
|
Result :=Round(255 * Temp);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
begin;
|
begin;
|
||||||
H := H / 100;
|
H := H / 100;
|
||||||
S := S / 100;
|
S := S / 100;
|
||||||
L := L / 100;
|
L := L / 100;
|
||||||
if s = 0 then
|
if s = 0 then
|
||||||
begin;
|
begin;
|
||||||
R := Byte(Round(L * 255));
|
R := Byte(Round(L * 255));
|
||||||
G := R;
|
G := R;
|
||||||
B := R;
|
B := R;
|
||||||
end else
|
end else
|
||||||
begin;
|
begin;
|
||||||
if (L < 0.5) then
|
if (L < 0.5) then
|
||||||
Temp2 := L * ( 1 + S )
|
Temp2 := L * ( 1 + S )
|
||||||
else
|
else
|
||||||
Temp2 := (L + S) - ( S * L);
|
Temp2 := (L + S) - ( S * L);
|
||||||
Temp := 2 * L - Temp2;
|
Temp := 2 * L - Temp2;
|
||||||
R := Hue2RGB( H + ( OneDivThree ) );
|
R := Hue2RGB( H + ( OneDivThree ) );
|
||||||
G := Hue2RGB( H );
|
G := Hue2RGB( H );
|
||||||
B := Hue2RGB( H - ( OneDivThree ) );
|
B := Hue2RGB( H - ( OneDivThree ) );
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Procedure HSLtoRGB(H,S,L : extended;var R,G,B : Integer); inline;
|
Procedure HSLtoRGB(H,S,L : extended;var R,G,B : Integer); inline;
|
||||||
var
|
var
|
||||||
Temp,Temp2 : Extended;
|
Temp,Temp2 : Extended;
|
||||||
//begin
|
//begin
|
||||||
|
|
||||||
Function Hue2RGB(TempHue : Extended) : integer;
|
Function Hue2RGB(TempHue : Extended) : integer;
|
||||||
begin;
|
begin;
|
||||||
if TempHue < 0 then
|
if TempHue < 0 then
|
||||||
TempHue := TempHue + 1
|
TempHue := TempHue + 1
|
||||||
else if TempHue > 1 then
|
else if TempHue > 1 then
|
||||||
TempHue := TempHue - 1;
|
TempHue := TempHue - 1;
|
||||||
if ( ( 6 * TempHue ) < 1 ) then
|
if ( ( 6 * TempHue ) < 1 ) then
|
||||||
Result :=Round(255 * (( Temp + ( Temp2 - Temp ) * 6 * TempHue )))
|
Result :=Round(255 * (( Temp + ( Temp2 - Temp ) * 6 * TempHue )))
|
||||||
else if ( ( 2 * TempHue ) < 1 ) then
|
else if ( ( 2 * TempHue ) < 1 ) then
|
||||||
Result :=Round(255 * Temp2)
|
Result :=Round(255 * Temp2)
|
||||||
else if ( ( 3 * TempHue ) < 2 ) then
|
else if ( ( 3 * TempHue ) < 2 ) then
|
||||||
Result :=Round(255 * (Temp + ( Temp2 - Temp ) * ( ( TwoDivThree ) - TempHue ) * 6))
|
Result :=Round(255 * (Temp + ( Temp2 - Temp ) * ( ( TwoDivThree ) - TempHue ) * 6))
|
||||||
else
|
else
|
||||||
Result :=Round(255 * Temp);
|
Result :=Round(255 * Temp);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
begin;
|
begin;
|
||||||
H := H / 100;
|
H := H / 100;
|
||||||
S := S / 100;
|
S := S / 100;
|
||||||
L := L / 100;
|
L := L / 100;
|
||||||
if s = 0 then
|
if s = 0 then
|
||||||
begin;
|
begin;
|
||||||
R := Round(L * 255);
|
R := Round(L * 255);
|
||||||
G := R;
|
G := R;
|
||||||
B := R;
|
B := R;
|
||||||
end else
|
end else
|
||||||
begin;
|
begin;
|
||||||
if (L < 0.5) then
|
if (L < 0.5) then
|
||||||
Temp2 := L * ( 1 + S )
|
Temp2 := L * ( 1 + S )
|
||||||
else
|
else
|
||||||
Temp2 := (L + S) - ( S * L);
|
Temp2 := (L + S) - ( S * L);
|
||||||
Temp := 2 * L - Temp2;
|
Temp := 2 * L - Temp2;
|
||||||
R := Hue2RGB( H + ( OneDivThree ) );
|
R := Hue2RGB( H + ( OneDivThree ) );
|
||||||
G := Hue2RGB( H );
|
G := Hue2RGB( H );
|
||||||
B := Hue2RGB( H - ( OneDivThree ) );
|
B := Hue2RGB( H - ( OneDivThree ) );
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{/\
|
{/\
|
||||||
Split the Given Color col in H, S, L components.
|
Split the Given Color col in H, S, L components.
|
||||||
/\}
|
/\}
|
||||||
|
|
||||||
Procedure ColorToHSL(Col: Integer; var h, s, l: Extended); inline;
|
Procedure ColorToHSL(Col: Integer; var h, s, l: Extended); inline;
|
||||||
Var
|
Var
|
||||||
R, G, B: Integer;
|
R, G, B: Integer;
|
||||||
Begin
|
Begin
|
||||||
ColorToRGB(Col, R, G, B);
|
ColorToRGB(Col, R, G, B);
|
||||||
RGBToHSL(R, G, B, H, S, L);
|
RGBToHSL(R, G, B, H, S, L);
|
||||||
End;
|
End;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user