mirror of
https://github.com/moparisthebest/Simba
synced 2024-12-12 02:22:20 -05:00
9b3694f105
Touches pretty much all the functions in finder.pas, so I expect a lot of functions to break. Tests will have to be written and results will have to be compared with Simba 0.97. Still, I think it's ready for merging to simba-next. Squashed commit of the following: commitef3bfa6410
Merge:d1e3645
5b3e2a8
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Thu Aug 4 00:44:01 2011 +0200 Merge branch 'simba-next' into cts-rework commit5b3e2a864b
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Thu Aug 4 00:41:00 2011 +0200 Merge new CTS/Finder system. Touches pretty much all the functions in finder.pas, so I expect a lot of functions to break. Tests will have to be written and results will have to be compared with Simba 0.97. Still, I think it's ready for merging to simba-next. Squashed commit of the following: commitd1e3645ee5
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Aug 1 19:08:23 2011 +0200 MML/Finder: Fix all compiler hints + bug. commitf159f20bc2
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Aug 1 19:05:03 2011 +0200 MML/Finder: Fix FindDTMsRotated. commit1fc33752e4
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Aug 1 19:04:16 2011 +0200 MML/Finder: FindDTMsRotated rework. commita621a6e8da
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Aug 1 18:13:36 2011 +0200 MML/Finder: FindDTMs rework done. commit0b592eef86
Merge:56e01c6
aaafd6b
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Aug 1 16:48:09 2011 +0200 Merge branch 'master' into cts-rework Conflicts: Units/MMLCore/finder.pas commit56e01c67fa
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Aug 1 16:16:19 2011 +0200 MML/Finder: CTS: Bitmap+Color functions done. Only DTM to go. commit464b90d42b
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Aug 1 13:58:49 2011 +0200 MMLCore/finder: Small cleanup. commit2414f60c08
Merge:55b0435
a20a31a
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sun Jul 31 18:12:41 2011 +0200 Merge branch 'master' into cts-rework commit55b0435a4e
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 20:27:54 2011 +0200 Tests: Update BmpBench. commit013daccf07
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 20:09:31 2011 +0200 MML/Core: Cleanup. commit6f32e21291
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 20:08:17 2011 +0200 MML/Core: FindBitmapToleranceIn seems to work. commit3b939443e8
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 19:10:10 2011 +0200 MML/Core: FindBitmapToleranceIn is nearly finished. Speed is nice, results are not accurate yet. I probably missed something when pre-loading the data. commit0422f0eb5a
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 15:53:48 2011 +0200 MML/Core: Fixes for FindBitmapToleranceIn. commit65f4ae16ed
Merge:daff307
353d1f3
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 14:32:46 2011 +0200 Merge branch 'master' into cts-rework commitdaff307f3d
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 13:46:10 2011 +0200 Tests: Add BmpBench. commitcdb89a1802
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 13:12:21 2011 +0200 MMLCore: FindBitmapToleranceIn cts rewrite. commitd0bd81c2e9
Merge:3282636
da0de6e
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 00:15:50 2011 +0200 Merge branch 'master' into cts-rework commit3282636178
Merge:7c86003
a8cdf77
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Jul 25 16:50:43 2011 +0200 Merge branch 'master' into cts-rework commit7c8600311c
Merge:153025f
e0767cb
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sun Jul 24 00:14:53 2011 +0200 Merge branch 'master' into cts-rework Conflicts: Doc/sphinx/conf.py Doc/sphinx/libmml/intro.rst commit153025f080
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sun Jul 17 19:51:16 2011 +0200 libMML: Changed the indentation. commit8abd502580
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sun Jul 17 19:37:33 2011 +0200 Documentation: Bump version to 820. commit031654b3d1
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sun Jul 17 19:36:21 2011 +0200 Documentation: Initial libMML documentation. commitf91c9ffb0e
Merge:f5c9690
989d077
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Thu Jul 7 12:00:58 2011 +0200 Merge branch 'master' into cts-rework commitf5c9690bee
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Thu Jul 7 11:59:15 2011 +0200 Finder: More rework and cleanups. commit79021409d0
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Wed Jul 6 21:34:03 2011 +0200 Finder: CTS 2 fix. commitcda571dcb0
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Wed Jul 6 21:06:17 2011 +0200 Finder: Remote tolerance param. Cleanups. commit733a8cbf32
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Wed Jul 6 20:39:44 2011 +0200 Finder: More fixes. :-) commite6b005b61f
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Wed Jul 6 18:34:49 2011 +0200 Finder: CTS-rework fixes. commit6f896b56a2
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Wed Jul 6 18:15:33 2011 +0200 Finder: Start CTS rework. commita630399148
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Wed Jul 6 13:01:22 2011 +0200 Small TODO update. commit0e6bf83a5c
Merge:f19fd6b
f2873b1
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Wed Jul 6 12:59:09 2011 +0200 Merge branch 'master' into cts-rework commitf19fd6bf8d
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sun Jul 3 20:42:14 2011 +0200 Simba/Doc: Add Raymond to doc. commit451ab89db3
Merge:37183f5
35026bc
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 2 14:48:43 2011 +0200 Merge branch 'master' into cts-rework commit37183f5fd0
Merge:cca7b05
6873e72
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Tue Jun 28 22:10:02 2011 +0200 Merge branch 'master' into cts-rework commitcca7b05213
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Thu Jun 16 17:03:14 2011 +0200 Add CTS 3 to FindColorsTolerance. Conflicts: Units/MMLCore/finder.pas commitc837d9b960
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Thu Jun 16 16:33:25 2011 +0200 CTS 3: Fix typo. commit52db461f84
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Jun 6 16:06:17 2011 +0200 CTS 3: Now implement the formula properly. commit7a0db25416
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sun Jun 5 19:44:52 2011 +0200 Add L*a*b CTS (3). commit2e1e786d0e
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Thu Jun 16 15:11:17 2011 +0200 FindBitmapToleranceIn now works. commit58ea6021cd
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Thu Jun 16 14:26:20 2011 +0200 CTS work. CTS 2 is still broken for bitmaps. commit91d952d33a
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Thu Jun 16 12:52:10 2011 +0200 CTS cleanups. commitd9836a251c
Merge:5bf7d8b
bfc3f86
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Jun 13 20:44:08 2011 +0200 Merge branch 'master' into cts-rework commit5bf7d8beea
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Jun 13 20:38:00 2011 +0200 Completed first CTS rework. commit7a412d1670
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Jun 13 20:21:23 2011 +0200 CTS: Cleanups. commit14474a84ab
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Jun 13 18:16:59 2011 +0200 CTS rework for FindColorsTolerance. commitb87a123701
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Jun 13 17:44:04 2011 +0200 More cleanups to CTS. commit9415d08100
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Jun 13 17:41:06 2011 +0200 Finder: Trying a different CTS approach. commitd1e3645ee5
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Aug 1 19:08:23 2011 +0200 MML/Finder: Fix all compiler hints + bug. commitf159f20bc2
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Aug 1 19:05:03 2011 +0200 MML/Finder: Fix FindDTMsRotated. commit1fc33752e4
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Aug 1 19:04:16 2011 +0200 MML/Finder: FindDTMsRotated rework. commita621a6e8da
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Aug 1 18:13:36 2011 +0200 MML/Finder: FindDTMs rework done. commit0b592eef86
Merge:56e01c6
aaafd6b
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Aug 1 16:48:09 2011 +0200 Merge branch 'master' into cts-rework Conflicts: Units/MMLCore/finder.pas commit56e01c67fa
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Aug 1 16:16:19 2011 +0200 MML/Finder: CTS: Bitmap+Color functions done. Only DTM to go. commit464b90d42b
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Aug 1 13:58:49 2011 +0200 MMLCore/finder: Small cleanup. commit2414f60c08
Merge:55b0435
a20a31a
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sun Jul 31 18:12:41 2011 +0200 Merge branch 'master' into cts-rework commit55b0435a4e
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 20:27:54 2011 +0200 Tests: Update BmpBench. commit013daccf07
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 20:09:31 2011 +0200 MML/Core: Cleanup. commit6f32e21291
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 20:08:17 2011 +0200 MML/Core: FindBitmapToleranceIn seems to work. commit3b939443e8
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 19:10:10 2011 +0200 MML/Core: FindBitmapToleranceIn is nearly finished. Speed is nice, results are not accurate yet. I probably missed something when pre-loading the data. commit0422f0eb5a
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 15:53:48 2011 +0200 MML/Core: Fixes for FindBitmapToleranceIn. commit65f4ae16ed
Merge:daff307
353d1f3
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 14:32:46 2011 +0200 Merge branch 'master' into cts-rework commitdaff307f3d
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 13:46:10 2011 +0200 Tests: Add BmpBench. commitcdb89a1802
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 13:12:21 2011 +0200 MMLCore: FindBitmapToleranceIn cts rewrite. commitd0bd81c2e9
Merge:3282636
da0de6e
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 30 00:15:50 2011 +0200 Merge branch 'master' into cts-rework commit3282636178
Merge:7c86003
a8cdf77
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Jul 25 16:50:43 2011 +0200 Merge branch 'master' into cts-rework commit7c8600311c
Merge:153025f
e0767cb
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sun Jul 24 00:14:53 2011 +0200 Merge branch 'master' into cts-rework Conflicts: Doc/sphinx/conf.py Doc/sphinx/libmml/intro.rst commit153025f080
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sun Jul 17 19:51:16 2011 +0200 libMML: Changed the indentation. commit8abd502580
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sun Jul 17 19:37:33 2011 +0200 Documentation: Bump version to 820. commit031654b3d1
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sun Jul 17 19:36:21 2011 +0200 Documentation: Initial libMML documentation. commitf91c9ffb0e
Merge:f5c9690
989d077
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Thu Jul 7 12:00:58 2011 +0200 Merge branch 'master' into cts-rework commitf5c9690bee
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Thu Jul 7 11:59:15 2011 +0200 Finder: More rework and cleanups. commit79021409d0
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Wed Jul 6 21:34:03 2011 +0200 Finder: CTS 2 fix. commitcda571dcb0
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Wed Jul 6 21:06:17 2011 +0200 Finder: Remote tolerance param. Cleanups. commit733a8cbf32
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Wed Jul 6 20:39:44 2011 +0200 Finder: More fixes. :-) commite6b005b61f
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Wed Jul 6 18:34:49 2011 +0200 Finder: CTS-rework fixes. commit6f896b56a2
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Wed Jul 6 18:15:33 2011 +0200 Finder: Start CTS rework. commita630399148
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Wed Jul 6 13:01:22 2011 +0200 Small TODO update. commit0e6bf83a5c
Merge:f19fd6b
f2873b1
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Wed Jul 6 12:59:09 2011 +0200 Merge branch 'master' into cts-rework commitf19fd6bf8d
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sun Jul 3 20:42:14 2011 +0200 Simba/Doc: Add Raymond to doc. commit451ab89db3
Merge:37183f5
35026bc
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sat Jul 2 14:48:43 2011 +0200 Merge branch 'master' into cts-rework commit37183f5fd0
Merge:cca7b05
6873e72
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Tue Jun 28 22:10:02 2011 +0200 Merge branch 'master' into cts-rework commitcca7b05213
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Thu Jun 16 17:03:14 2011 +0200 Add CTS 3 to FindColorsTolerance. Conflicts: Units/MMLCore/finder.pas commitc837d9b960
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Thu Jun 16 16:33:25 2011 +0200 CTS 3: Fix typo. commit52db461f84
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Jun 6 16:06:17 2011 +0200 CTS 3: Now implement the formula properly. commit7a0db25416
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Sun Jun 5 19:44:52 2011 +0200 Add L*a*b CTS (3). commit2e1e786d0e
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Thu Jun 16 15:11:17 2011 +0200 FindBitmapToleranceIn now works. commit58ea6021cd
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Thu Jun 16 14:26:20 2011 +0200 CTS work. CTS 2 is still broken for bitmaps. commit91d952d33a
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Thu Jun 16 12:52:10 2011 +0200 CTS cleanups. commitd9836a251c
Merge:5bf7d8b
bfc3f86
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Jun 13 20:44:08 2011 +0200 Merge branch 'master' into cts-rework commit5bf7d8beea
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Jun 13 20:38:00 2011 +0200 Completed first CTS rework. commit7a412d1670
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Jun 13 20:21:23 2011 +0200 CTS: Cleanups. commit14474a84ab
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Jun 13 18:16:59 2011 +0200 CTS rework for FindColorsTolerance. commitb87a123701
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Jun 13 17:44:04 2011 +0200 More cleanups to CTS. commit9415d08100
Author: Merlijn Wajer <merlijn@wizzup.org> Date: Mon Jun 13 17:41:06 2011 +0200 Finder: Trying a different CTS approach.
1506 lines
43 KiB
ObjectPascal
1506 lines
43 KiB
ObjectPascal
{
|
|
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.
|
|
|
|
Bitmaps class for the Mufasa Macro Library
|
|
}
|
|
|
|
unit bitmaps;
|
|
|
|
{$mode objfpc}{$H+}
|
|
{$Inline on}
|
|
interface
|
|
uses
|
|
Classes, SysUtils, FPImage,IntfGraphics,graphtype,MufasaTypes,MufasaBase,graphics;
|
|
|
|
type
|
|
|
|
{ TMufasaBitmap }
|
|
TMufasaBitmap = class(TObject)
|
|
private
|
|
w,h : integer;
|
|
FTransparentColor : TRGB32;
|
|
FTransparentSet : boolean;
|
|
FIndex : integer;
|
|
FName : string;
|
|
public
|
|
OnDestroy : procedure(Bitmap : TMufasaBitmap) of object;
|
|
//FakeData : array of TRGB32;
|
|
FData : PRGB32;
|
|
property Name : string read FName write FName;
|
|
property Index : integer read FIndex write FIndex;
|
|
procedure SetSize(AWidth,AHeight : integer);
|
|
procedure StretchResize(AWidth,AHeight : integer);
|
|
property Width : Integer read w;
|
|
property Height : Integer read h;
|
|
procedure ValidatePoint(x,y : integer);
|
|
function SaveToFile(const FileName : string) :boolean;
|
|
procedure LoadFromFile(const FileName : string);
|
|
procedure Rectangle(const Box : TBox;FillCol : TColor);
|
|
procedure FloodFill(const StartPT : TPoint; const SearchCol, ReplaceCol : TColor);
|
|
procedure FastSetPixel(x,y : integer; Color : TColor);
|
|
procedure FastSetPixels(Points : TPointArray; Colors : TIntegerArray);
|
|
procedure DrawATPA(ATPA : T2DPointArray; Colors : TIntegerArray);overload;
|
|
procedure DrawATPA(ATPA : T2DPointArray);overload;
|
|
procedure DrawTPA(Points : TPointArray; Color : TColor);
|
|
procedure DrawToCanvas(x,y : integer; Canvas : TCanvas);
|
|
function CreateTPA(SearchCol : TColor) : TPointArray;
|
|
function FastGetPixel(x,y : integer) : TColor;
|
|
function FastGetPixels(Points : TPointArray) : TIntegerArray;
|
|
function GetAreaColors(xs,ys,xe,ye : integer) : T2DIntArray;
|
|
function GetHSLValues(xs, ys, xe, ye: integer): T2DHSLArray;
|
|
procedure FastDrawClear(Color : TColor);
|
|
procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap);
|
|
procedure FastReplaceColor(OldColor, NewColor: TColor);
|
|
procedure CopyClientToBitmap(MWindow : TObject;Resize : boolean; xs, ys, xe, ye: Integer);overload;
|
|
procedure CopyClientToBitmap(MWindow : TObject;Resize : boolean;x,y : integer; xs, ys, xe, ye: Integer);overload;
|
|
procedure RotateBitmap(angle: Extended;TargetBitmap : TMufasaBitmap );
|
|
procedure Desaturate(TargetBitmap : TMufasaBitmap); overload;
|
|
procedure Desaturate;overload;
|
|
procedure GreyScale(TargetBitmap : TMufasaBitmap);overload;
|
|
procedure GreyScale;
|
|
procedure Brightness(TargetBitmap : TMufasaBitmap; br : integer); overload;
|
|
procedure Brightness(br: integer);overload;
|
|
procedure Contrast(TargetBitmap : TMufasaBitmap; co : Extended);overload;
|
|
procedure Contrast(co: Extended);overload;
|
|
procedure Invert(TargetBitmap : TMufasaBitmap);overload;
|
|
procedure Invert;overload;
|
|
procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);overload;
|
|
procedure Posterize(Po : integer);overload;
|
|
procedure Convolute(TargetBitmap : TMufasaBitmap; Matrix : T2DExtendedArray);
|
|
function Copy(const xs,ys,xe,ye : integer) : TMufasaBitmap; overload;
|
|
function Copy: TMufasaBitmap;overload;
|
|
function ToTBitmap: TBitmap;
|
|
function ToString : string;
|
|
function RowPtrs : TPRGB32Array;
|
|
procedure LoadFromTBitmap(bmp: TBitmap);
|
|
procedure LoadFromRawImage(RawImage: TRawImage);
|
|
function CreateTMask : TMask;
|
|
procedure SetTransparentColor(Col : TColor);
|
|
function GetTransparentColor : TColor;
|
|
property TransparentColorSet : boolean read FTransparentSet;
|
|
procedure SetAlphaValue(const value : byte);
|
|
constructor Create;
|
|
destructor Destroy;override;
|
|
end;
|
|
PMufasaBitmap = ^TMufasaBitmap;
|
|
TMufasaBmpArray = Array of TMufasaBitmap;
|
|
{ TMBitmaps }
|
|
TMBitmaps = class(TObject)
|
|
protected
|
|
Client : TObject;
|
|
FreeSpots : Array of integer;
|
|
BmpArray : TMufasaBmpArray;
|
|
BmpsCurr,BmpsHigh,FreeSpotsHigh,FreeSpotsLen : integer;
|
|
function GetNewIndex : integer;
|
|
public
|
|
function GetBMP(Index : integer) : TMufasaBitmap;
|
|
property Bmp[Index : integer]: TMufasaBitmap read GetBMP; default;
|
|
function CreateBMP(w, h: integer): Integer;
|
|
function AddBMP(_bmp: TMufasaBitmap): Integer;
|
|
function CopyBMP( Bitmap : integer) : Integer;
|
|
function CreateMirroredBitmap(bitmap: Integer; MirrorStyle : TBmpMirrorStyle): Integer;
|
|
function CreateBMPFromFile(const Path : string) : integer;
|
|
function CreateBMPFromString(width,height : integer; Data : string) : integer;overload;
|
|
function CreateBMPFromString(BmpName : string; width,height : integer; Data : string) : integer;overload;
|
|
procedure FreeBMP( Number : integer);
|
|
constructor Create(Owner : TObject);
|
|
destructor Destroy;override;
|
|
end;
|
|
|
|
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; out RawImage: TRawImage);
|
|
function CalculatePixelShift(Bmp1,Bmp2 : TMufasaBitmap; CompareBox : TBox) : integer;
|
|
function CalculatePixelTolerance(Bmp1,Bmp2 : TMufasaBitmap; CompareBox : TBox; CTS : integer) : extended;
|
|
implementation
|
|
|
|
uses
|
|
paszlib,DCPbase64,math, client,tpa,
|
|
colour_conv,IOManager,mufasatypesutil,FileUtil;
|
|
|
|
// Needs more fixing. We need to either copy the memory ourself, or somehow
|
|
// find a TRawImage feature to skip X bytes after X bytes read. (Most likely a
|
|
// feature)
|
|
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; out RawImage: TRawImage);
|
|
Begin
|
|
RawImage.Init; { Calls raw.Description.Init as well }
|
|
|
|
RawImage.Description.PaletteColorCount:=0;
|
|
RawImage.Description.MaskBitsPerPixel:=0;
|
|
RawImage.Description.Width := Size.X;
|
|
RawImage.Description.Height:= Size.Y;
|
|
|
|
RawImage.Description.Format := ricfRGBA;
|
|
RawImage.Description.ByteOrder := riboLSBFirst;
|
|
RawImage.Description.BitOrder:= riboBitsInOrder; // should be fine
|
|
RawImage.Description.Depth:=24;
|
|
RawImage.Description.BitsPerPixel:=32;
|
|
RawImage.Description.LineOrder:=riloTopToBottom;
|
|
RawImage.Description.LineEnd := rileDWordBoundary;
|
|
|
|
RawImage.Description.RedPrec := 8;
|
|
RawImage.Description.GreenPrec:= 8;
|
|
RawImage.Description.BluePrec:= 8;
|
|
RawImage.Description.AlphaPrec:=0;
|
|
|
|
|
|
RawImage.Description.RedShift:=16;
|
|
RawImage.Description.GreenShift:=8;
|
|
RawImage.Description.BlueShift:=0;
|
|
|
|
RawImage.DataSize := RawImage.Description.Width * RawImage.Description.Height
|
|
* (RawImage.Description.bitsperpixel shr 3);
|
|
RawImage.Data := PByte(Ptr);
|
|
End;
|
|
|
|
function CalculatePixelShift(Bmp1, Bmp2: TMufasaBitmap; CompareBox: TBox): integer;
|
|
var
|
|
x,y : integer;
|
|
w1,w2 : integer;
|
|
begin
|
|
Bmp1.ValidatePoint(comparebox.x1,comparebox.y1);
|
|
Bmp1.ValidatePoint(comparebox.x2,comparebox.y2);
|
|
Bmp2.ValidatePoint(comparebox.x1,comparebox.y1);
|
|
Bmp2.ValidatePoint(comparebox.x2,comparebox.y2);
|
|
Bmp1.SetAlphaValue(0);
|
|
Bmp2.SetAlphaValue(0);
|
|
w1 := bmp1.Width;
|
|
w2 := bmp2.width;
|
|
result := 0;
|
|
for y := CompareBox.y1 to CompareBox.y2 do
|
|
for x := CompareBox.x1 to CompareBox.x2 do
|
|
if LongWord(Bmp1.FData[y * w1 + x]) <> LongWord(Bmp2.Fdata[y * w2 + x]) then
|
|
inc(result);
|
|
end;
|
|
//CTS 0 counts the average difference in R,G,B per pixel
|
|
//CTS 1 counts the average difference using SQRT(Sqr(r) + sqr(g)+sqr(b));
|
|
function CalculatePixelTolerance(Bmp1, Bmp2: TMufasaBitmap; CompareBox: TBox;
|
|
CTS: integer): extended;
|
|
var
|
|
x,y : integer;
|
|
w1,w2 : integer;
|
|
Diff : int64;
|
|
begin
|
|
Bmp1.ValidatePoint(comparebox.x1,comparebox.y1);
|
|
Bmp1.ValidatePoint(comparebox.x2,comparebox.y2);
|
|
Bmp2.ValidatePoint(comparebox.x1,comparebox.y1);
|
|
Bmp2.ValidatePoint(comparebox.x1,comparebox.y1);
|
|
Bmp1.SetAlphaValue(0);
|
|
Bmp2.SetAlphaValue(0);
|
|
w1 := bmp1.Width;
|
|
w2 := bmp2.width;
|
|
result := 0;
|
|
if not InRange(CTS,0,1) then
|
|
raise exception.CreateFmt('CTS Passed to CalculateTolerance must be in [0..1], it currently is %d',[CTS]);
|
|
case CTS of
|
|
0 : begin
|
|
Diff := 0;
|
|
for y := CompareBox.y1 to CompareBox.y2 do
|
|
for x := CompareBox.x1 to CompareBox.x2 do
|
|
begin
|
|
Diff := Diff + abs(Bmp1.FData[y * w1 + x].r-Bmp2.Fdata[y * w2 + x].r) +
|
|
abs(Bmp1.FData[y * w1 + x].g-Bmp2.Fdata[y * w2 + x].g) +
|
|
abs(Bmp1.FData[y * w1 + x].b-Bmp2.Fdata[y * w2 + x].b);
|
|
end;
|
|
Result := Diff / (3 * (CompareBox.x2 - CompareBox.x1 + 1) * (CompareBox.y2-CompareBox.y1 + 1)); //We want the value for the whole Pixel; so divide by 3 (RGB)
|
|
end;
|
|
1 : begin
|
|
for y := CompareBox.y1 to CompareBox.y2 do
|
|
for x := CompareBox.x1 to CompareBox.x2 do
|
|
Result := Result + Sqrt(Sqr(Bmp1.FData[y * w1 + x].r-Bmp2.Fdata[y * w2 + x].r) +
|
|
Sqr(Bmp1.FData[y * w1 + x].g-Bmp2.Fdata[y * w2 + x].g) +
|
|
Sqr(Bmp1.FData[y * w1 + x].b-Bmp2.Fdata[y * w2 + x].b));
|
|
Result := Result / ((CompareBox.x2 - CompareBox.x1 + 1) * (CompareBox.y2-CompareBox.y1 + 1)); //We want the value for the whole Pixel;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function Min(a,b:integer) : integer;
|
|
begin
|
|
if a < b then
|
|
result := a
|
|
else
|
|
result := b;
|
|
end;
|
|
|
|
{ TMBitmaps }
|
|
|
|
function TMBitmaps.GetNewIndex: integer;
|
|
begin
|
|
if BmpsCurr < BmpsHigh then
|
|
begin;
|
|
inc(BmpsCurr);
|
|
Result := BmpsCurr;
|
|
end else if (FreeSpotsHigh > -1) then
|
|
begin;
|
|
Result := FreeSpots[FreeSpotsHigh];
|
|
dec(FreeSpotsHigh);
|
|
end else
|
|
begin;
|
|
SetLength(BmpArray, BmpsHigh + 6);
|
|
BmpsHigh := BmpsHigh + 5;
|
|
inc(BmpsCurr);
|
|
Result := BmpsCurr;
|
|
end;
|
|
end;
|
|
|
|
function TMBitmaps.GetBMP(Index: integer): TMufasaBitmap;
|
|
begin
|
|
Result := nil;
|
|
if (Index >= 0) and (Index <= BmpsCurr) then
|
|
if BmpArray[Index] <> nil then
|
|
Result := BmpArray[Index];
|
|
if Result = nil then
|
|
raise Exception.CreateFmt('The bitmap[%d] does not exist',[Index]);
|
|
end;
|
|
|
|
function TMBitmaps.CreateBMP(w,h : integer): Integer;
|
|
begin
|
|
result := GetNewIndex;
|
|
BmpArray[Result] := TMufasaBitmap.Create;
|
|
BmpArray[Result].SetSize(w,h);
|
|
BmpArray[Result].Index:= Result;
|
|
end;
|
|
|
|
function TMBitmaps.AddBMP(_bmp: TMufasaBitmap): Integer;
|
|
begin
|
|
Result := GetNewIndex;
|
|
BmpArray[Result] := _bmp;
|
|
BmpArray[result].Index:= Result;
|
|
end;
|
|
|
|
function TMBitmaps.CopyBMP(Bitmap: integer): Integer;
|
|
var
|
|
InputBMP : TMufasaBitmap;
|
|
OutputBMP : TMUfasaBitmap;
|
|
begin
|
|
InputBMP := GetBMP(Bitmap);
|
|
Result := CreateBMP(InputBmp.w,InputBMP.h);
|
|
OutputBMP := GetBMP(Result);
|
|
Move(InputBMP.FData[0],OutPutBMP.FData[0],InputBMP.w * InputBMP.h * SizeOf(TRGB32));
|
|
end;
|
|
|
|
function TMBitmaps.CreateMirroredBitmap(bitmap: Integer;
|
|
MirrorStyle: TBmpMirrorStyle): Integer;
|
|
var
|
|
w,h : integer;
|
|
y,x : integer;
|
|
Source,Dest : PRGB32;
|
|
begin
|
|
Source := Bmp[Bitmap].FData;
|
|
w := BmpArray[Bitmap].Width;
|
|
h := BmpArray[Bitmap].Height;
|
|
if MirrorStyle = MirrorLine then
|
|
Result := CreateBMP(h,w)
|
|
else
|
|
Result := CreateBMP(w,h);
|
|
Dest := BmpArray[Result].FData;
|
|
case MirrorStyle of
|
|
MirrorWidth : for y := (h-1) downto 0 do
|
|
for x := (w-1) downto 0 do
|
|
Dest[y*w+x] := Source[y*w+w-1-x];
|
|
MirrorHeight : for y := (h-1) downto 0 do
|
|
Move(Source[y*w],Dest[(h-1 - y) * w],w*SizeOf(TRGB32));
|
|
MirrorLine : for y := (h-1) downto 0 do
|
|
for x := (w-1) downto 0 do
|
|
Dest[x*h+y] := Source[y*w+x];
|
|
|
|
end;
|
|
//Can be optmized, this is just proof of concept
|
|
end;
|
|
|
|
function TMBitmaps.CreateBMPFromFile(const Path: string): integer;
|
|
begin
|
|
Result := CreateBMP(0,0);
|
|
BmpArray[result].LoadFromFile(Path);
|
|
end;
|
|
|
|
function HexToInt(HexNum: string): LongInt;inline;
|
|
begin
|
|
Result:=StrToInt('$' + HexNum);
|
|
end;
|
|
|
|
function TMBitmaps.CreateBMPFromString(width, height: integer; Data: string): integer;
|
|
var
|
|
I,II: LongWord;
|
|
DestLen : LongWord;
|
|
Dest,Source : string;
|
|
DestPoint, Point : PByte;
|
|
MufRaw : PRGB24;
|
|
MufDest : PRGB32;
|
|
|
|
|
|
begin
|
|
Result := CreateBMP(width,height);
|
|
if (Data <> '') and (Length(Data) <> 6) then
|
|
begin;
|
|
Point := Pointer(BmpArray[Result].FData);
|
|
if (Data[1] = 'b') or (Data[1] = 'm') then
|
|
begin;
|
|
Source := Base64DecodeStr(Copy(Data,2,Length(Data) - 1));
|
|
Destlen := Width * Height * 3;
|
|
Setlength(Dest,DestLen);
|
|
if uncompress(PChar(Dest),Destlen,pchar(Source), Length(Source)) = Z_OK then
|
|
begin;
|
|
if data[1] = 'm' then //Our encrypted bitmap! Winnor.
|
|
begin
|
|
MufRaw:= @Dest[1];
|
|
MufDest:= PRGB32(Point);
|
|
for i := width * height - 1 downto 0 do
|
|
begin
|
|
MufDest[i].R:= MufRaw[i].R;
|
|
MufDest[i].G := MufRaw[i].G;
|
|
MufDest[i].B := MufRaw[i].B;
|
|
end;
|
|
end else
|
|
if Data[1] = 'b'then
|
|
begin
|
|
DestPoint := @Dest[1];
|
|
i := 0;
|
|
ii := 2;
|
|
Dec(DestLen);
|
|
if DestLen > 2 then
|
|
begin;
|
|
while (ii < DestLen) do
|
|
Begin;
|
|
Point[i]:= DestPoint[ii+2];
|
|
Point[i+1]:= DestPoint[ii+1];
|
|
Point[i+2]:= DestPoint[ii];
|
|
ii := ii + 3;
|
|
i := i + 4;
|
|
end;
|
|
Point[i] := DestPoint[1];
|
|
Point[i+1] := DestPoint[0];
|
|
Point[i+2] := DestPoint[ii];
|
|
end else if (Width = 1) and (Height =1 ) then
|
|
begin;
|
|
Point[0] := DestPoint[1];
|
|
Point[1] := DestPoint[0];
|
|
Point[2] := DestPoint[2];
|
|
end;
|
|
end;
|
|
end;
|
|
end else if Data[1] = 'z' then
|
|
begin;
|
|
Destlen := Width * Height * 3 *2;
|
|
Setlength(Dest,DestLen);
|
|
ii := (Length(Data) - 1) div 2;
|
|
SetLength(Source,ii);
|
|
for i := 1 to ii do
|
|
Source[i] := Chr(HexToInt(Data[i * 2] + Data[i * 2+1]));
|
|
if uncompress(PChar(Dest),Destlen,pchar(Source), ii) = Z_OK then
|
|
begin;
|
|
ii := 1;
|
|
i := 0;
|
|
while (II < DestLen) do
|
|
begin;
|
|
Point[i+2]:= HexToInt(Dest[ii] + Dest[ii + 1]);
|
|
Point[i+1]:= HexToInt(Dest[ii+2] + Dest[ii + 3]);
|
|
Point[i]:= HexToInt(Dest[ii+4] + Dest[ii + 5]);
|
|
ii := ii + 6;
|
|
i := i + 4;
|
|
end;
|
|
end;
|
|
end else if LongWord(Length(Data)) = LongWord((Width * Height * 3 * 2)) then
|
|
begin;
|
|
ii := 1;
|
|
i := 0;
|
|
Destlen := Width * Height * 3 * 2;
|
|
while (II < DestLen) do
|
|
begin;
|
|
Point[i+2]:= HexToInt(Data[ii] + Data[ii + 1]);
|
|
Point[i+1]:= HexToInt(Data[ii+2] + Data[ii + 3]);
|
|
Point[i]:= HexToInt(Data[ii+4] + Data[ii + 5]);
|
|
ii := ii + 6;
|
|
i := i + 4;
|
|
end;
|
|
end;
|
|
end else
|
|
begin;
|
|
if Length(data) = 6 then
|
|
BmpArray[Result].FastDrawClear(HexToInt(Data));
|
|
// else
|
|
// FastDrawClear(Result,clBlack);
|
|
end;
|
|
end;
|
|
|
|
function TMBitmaps.CreateBMPFromString(BmpName: string; width, height: integer;
|
|
Data: string): integer;
|
|
begin
|
|
Result := Self.CreateBMPFromString(width,height,data);
|
|
Bmp[Result].Name:= BmpName;
|
|
|
|
end;
|
|
|
|
procedure TMBitmaps.FreeBMP(Number: integer);
|
|
var
|
|
ToDestroy : TMufasaBitmap;
|
|
begin
|
|
ToDestroy := GetBMP(Number);
|
|
if Number = BmpsCurr then
|
|
Dec(BmpsCurr)
|
|
else
|
|
begin;
|
|
inc(FreeSpotsHigh);
|
|
if FreeSpotsHigh = FreeSpotsLen then
|
|
begin;
|
|
inc(FreeSpotsLen);
|
|
SetLength(FreeSpots, FreeSpotsLen);
|
|
end;
|
|
FreeSpots[FreeSpotsHigh] := Number;
|
|
end;
|
|
//Just for testing purposes
|
|
{$ifdef mDebug}
|
|
if ToDestroy.BmpName = '' then
|
|
mDebug(Format('BMP[%d] has been freed.',[number]))
|
|
else
|
|
mDebug(Format('BMP[%s] has been freed.',[ToDestroy.BmpName]));
|
|
{$endif}
|
|
ToDestroy.Free;
|
|
BmpArray[number] := nil;
|
|
end;
|
|
|
|
{
|
|
|
|
Implementation TMufasaBitmap
|
|
|
|
}
|
|
|
|
function TMufasaBitmap.SaveToFile(const FileName: string): boolean;
|
|
var
|
|
rawImage : TRawImage;
|
|
Bmp : TLazIntfImage;
|
|
begin
|
|
ArrDataToRawImage(FData,Point(w,h),RawImage);
|
|
result := true;
|
|
// Bmp := Graphics.TBitmap.Create;
|
|
try
|
|
Bmp := TLazIntfImage.Create(RawImage,false);
|
|
Bmp.SaveToFile(UTF8ToSys(FileName));
|
|
Bmp.Free;
|
|
except
|
|
result := false;
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.LoadFromFile(const FileName: string);
|
|
var
|
|
LazIntf : TLazIntfImage;
|
|
RawImageDesc : TRawImageDescription;
|
|
begin
|
|
if FileExistsUTF8(FileName) then
|
|
begin;
|
|
LazIntf := TLazIntfImage.Create(0,0);
|
|
RawImageDesc.Init_BPP32_B8G8R8_BIO_TTB(LazIntf.Width,LazIntf.Height);
|
|
LazIntf.DataDescription := RawImageDesc;
|
|
LazIntf.LoadFromFile(UTF8ToSys(FileName));
|
|
if Assigned(FData) then
|
|
Freemem(FData);
|
|
Self.W := LazIntf.Width;
|
|
Self.H := LazIntf.Height;
|
|
FData := GetMem(Self.W*Self.H*SizeOf(TRGB32));
|
|
Move(LazIntf.PixelData[0],FData[0],w*h*sizeOf(TRGB32));
|
|
LazIntf.Free;
|
|
end;
|
|
end;
|
|
|
|
function RGBToBGR(Color : TColor) : TRGB32; inline;
|
|
begin;
|
|
Result.R := Color and $ff;
|
|
Result.G := Color shr 8 and $ff;
|
|
Result.B := Color shr 16 and $ff;
|
|
Result.A := 0;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.Rectangle(const Box: TBox;FillCol: TColor);
|
|
var
|
|
y : integer;
|
|
Col : Longword;
|
|
Size : longword;
|
|
begin
|
|
if (Box.x1 < 0) or (Box.y1 < 0) or (Box.x2 >= self.w) or (Box.y2 >= self.h) then
|
|
raise exception.Create('The Box you passed to Rectangle exceed the bitmap''s bounds');
|
|
if (box.x1 > box.x2) or (Box.y1 > box.y2) then
|
|
raise exception.CreateFmt('The Box you passed to Rectangle doesn''t have normal bounds: (%d,%d) : (%d,%d)',
|
|
[Box.x1,box.y1,box.x2,box.y2]);
|
|
col := Longword(RGBToBGR(FillCol));
|
|
Size := Box.x2 - box.x1 + 1;
|
|
for y := Box.y1 to Box.y2 do
|
|
FillDWord(FData[y * self.w + Box.x1],size,Col);
|
|
end;
|
|
|
|
procedure TMufasaBitmap.FloodFill(const StartPT: TPoint; const SearchCol,
|
|
ReplaceCol: TColor);
|
|
var
|
|
Stack : TPointArray;
|
|
SIndex : Integer;
|
|
CurrX,CurrY : integer;
|
|
Search,Replace : LongWord;
|
|
procedure AddToStack(x,y : integer);inline;
|
|
begin
|
|
if LongWord(FData[y * w + x]) = Search then
|
|
begin
|
|
LongWord(FData[y * w + x]) := Replace;
|
|
Stack[SIndex].x := x;
|
|
Stack[SIndex].y := y;
|
|
inc(SIndex);
|
|
end;
|
|
end;
|
|
begin
|
|
ValidatePoint(StartPT.x,StartPT.y);
|
|
Search := LongWord(RGBToBGR(SearchCol));
|
|
Replace := LongWord(RGBToBGR(ReplaceCol));
|
|
SetAlphaValue(0);
|
|
if LongWord(FData[StartPT.y * w + StartPT.x]) <> Search then //Only add items to the stack that are the searchcol.
|
|
Exit;
|
|
SetLength(Stack,w * h);
|
|
SIndex := 0;
|
|
AddToStack(StartPT.x,StartPT.y);
|
|
SIndex := 0;
|
|
while (SIndex >= 0) do
|
|
begin;
|
|
CurrX := Stack[SIndex].x;
|
|
Curry := Stack[SIndex].y;
|
|
if (CurrX > 0) and (CurrY > 0) then AddToStack(CurrX - 1, CurrY - 1);
|
|
if (CurrX > 0) then AddToStack(CurrX - 1, CurrY);
|
|
if (CurrX > 0) and (CurrY + 1 < h) then AddToStack(CurrX - 1, CurrY + 1);
|
|
if (CurrY + 1 < h) then AddToStack(CurrX , CurrY + 1);
|
|
if (CurrX + 1 < w) and (CurrY + 1 < h) then AddToStack(CurrX + 1, CurrY + 1);
|
|
if (CurrX + 1 < w) then AddToStack(CurrX + 1, CurrY );
|
|
if (CurrX + 1 < w) and (CurrY > 0) then AddToStack(CurrX + 1, CurrY - 1);
|
|
if (CurrY > 0) then AddToStack(CurrX , CurrY - 1);
|
|
Dec(SIndex);
|
|
end;
|
|
end;
|
|
|
|
function TMufasaBitmap.Copy: TMufasaBitmap;
|
|
begin
|
|
Result := TMufasaBitmap.Create;
|
|
Result.SetSize(self.Width, self.Height);
|
|
Move(self.FData[0], Result.FData[0],self.w * self.h * SizeOf(TRGB32));
|
|
end;
|
|
|
|
function TMufasaBitmap.Copy(const xs, ys, xe, ye: integer): TMufasaBitmap;
|
|
var
|
|
i : integer;
|
|
begin
|
|
ValidatePoint(xs,ys);
|
|
ValidatePoint(xe,ye);
|
|
Result := TMufasaBitmap.Create;
|
|
Result.SetSize(xe-xs+1, ye-ys+1);
|
|
for i := ys to ye do
|
|
Move(self.FData[i * self.w + xs], Result.FData[(i-ys) * result.w],result.Width * SizeOf(TRGB32));
|
|
end;
|
|
|
|
function TMufasaBitmap.ToTBitmap: TBitmap;
|
|
|
|
var
|
|
tr:TRawImage;
|
|
|
|
begin
|
|
Result := TBitmap.Create;
|
|
ArrDataToRawImage(Self.Fdata, point(self.width,self.height), tr);
|
|
Result.LoadFromRawImage(tr, false);
|
|
end;
|
|
|
|
function TMufasaBitmap.ToString: string;
|
|
var
|
|
i : integer;
|
|
DestLen : longword;
|
|
DataStr : string;
|
|
CorrectData : PRGB24;
|
|
begin
|
|
SetLength(DataStr,w*h*3);
|
|
CorrectData:= PRGB24(@DataStr[1]);
|
|
for i := w*h - 1 downto 0 do
|
|
begin
|
|
CorrectData[i].R := FData[i].R;
|
|
CorrectData[i].G := FData[i].G;
|
|
CorrectData[i].B := FData[i].B;
|
|
end;
|
|
DestLen := BufferLen;
|
|
if compress(BufferString,destlen,PChar(DataStr),w*h*3) = Z_OK then
|
|
begin;
|
|
SetLength(DataStr,DestLen);
|
|
move(bufferstring[0],dataStr[1],DestLen);
|
|
result := 'm' + Base64EncodeStr(datastr);
|
|
SetLength(datastr,0);
|
|
end;
|
|
end;
|
|
|
|
function TMufasaBitmap.RowPtrs: TPRGB32Array;
|
|
var
|
|
I : integer;
|
|
begin;
|
|
setlength(result,h);
|
|
for i := 0 to h - 1 do
|
|
result[i] := FData + w * i;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.LoadFromRawImage(RawImage: TRawImage);
|
|
|
|
var
|
|
x,y: integer;
|
|
_24_old_p: PByte;
|
|
rs,gs,bs:byte;
|
|
data: PRGB32;
|
|
|
|
|
|
begin
|
|
// clear data
|
|
Self.SetSize(0,0);
|
|
|
|
if (RawImage.Description.BitsPerPixel <> 24) and (RawImage.Description.BitsPerPixel <> 32) then
|
|
raise Exception.CreateFMT('TMufasaBitmap.LoadFromRawImage - BitsPerPixel is %d', [RawImage.Description.BitsPerPixel]);
|
|
|
|
{writeln('Bits per pixel: ' + Inttostr(RawImage.Description.BitsPerPixel)); }
|
|
if RawImage.Description.LineOrder <> riloTopToBottom then
|
|
raise Exception.Create('TMufasaBitmap.LoadFromRawImage - LineOrder is not riloTopToBottom');
|
|
|
|
{ writeln(format('LineOrder: theirs: %d, ours: %d', [RawImage.Description.LineOrder, riloTopToBottom])); }
|
|
|
|
|
|
// Todo, add support for other alignments.
|
|
{ if RawImage.Description.LineEnd <> rileDWordBoundary then
|
|
raise Exception.Create('TMufasaBitmap.LoadFromRawImage - LineEnd is not rileDWordBoundary'); }
|
|
|
|
//writeln(format('LineEnd: t', [RawImage.Description.LineEnd]));
|
|
|
|
if RawImage.Description.Format<>ricfRGBA then
|
|
raise Exception.Create('TMufasaBitmap.LoadFromRawImage - Format is not ricfRGBA');
|
|
|
|
// Set w,h and alloc mem.
|
|
Self.SetSize(RawImage.Description.Width, RawImage.Description.Height);
|
|
|
|
{writeln(format('Image size: %d, %d', [w,h])); }
|
|
rs := RawImage.Description.RedShift shr 3;
|
|
gs := RawImage.Description.GreenShift shr 3;
|
|
bs := RawImage.Description.BlueShift shr 3;
|
|
{ writeln(format('Shifts(R,G,B): %d, %d, %d', [rs,gs,bs]));
|
|
writeln(format('Bits per line %d, expected: %d',
|
|
[RawImage.Description.BitsPerLine, RawImage.Description.BitsPerPixel * self.w]));
|
|
}
|
|
|
|
|
|
if RawImage.Description.BitsPerPixel = 32 then
|
|
Move(RawImage.Data[0], Self.FData[0], self.w * self.h * SizeOf(TRGB32))
|
|
else
|
|
begin
|
|
//FillChar(Self.FData[0], self.w * self.h * SizeOf(TRGB32), 0);
|
|
data := self.FData;
|
|
|
|
_24_old_p := RawImage.Data;
|
|
for y := 0 to self.h -1 do
|
|
begin
|
|
for x := 0 to self.w -1 do
|
|
begin
|
|
// b is the first byte in the record.
|
|
data^.b := _24_old_p[bs];
|
|
data^.g := _24_old_p[gs];
|
|
data^.r := _24_old_p[rs];
|
|
data^.a := 0;
|
|
|
|
inc(_24_old_p, 3);
|
|
inc(data);
|
|
end;
|
|
|
|
case RawImage.Description.LineEnd of
|
|
rileTight, rileByteBoundary: ; // do nothing
|
|
rileWordBoundary:
|
|
while (_24_old_p - RawImage.Data) mod 2 <> 0 do
|
|
inc(_24_old_p);
|
|
rileDWordBoundary:
|
|
while (_24_old_p - RawImage.Data) mod 4 <> 0 do
|
|
inc(_24_old_p);
|
|
rileQWordBoundary:
|
|
while (_24_old_p - RawImage.Data) mod 4 <> 0 do
|
|
inc(_24_old_p);
|
|
rileDQWordBoundary:
|
|
while (_24_old_p - RawImage.Data) mod 8 <> 0 do
|
|
inc(_24_old_p);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.LoadFromTBitmap(bmp: TBitmap);
|
|
|
|
begin
|
|
// bmp.BeginUpdate();
|
|
LoadFromRawImage(bmp.RawImage);
|
|
// bmp.EndUpdate();
|
|
end;
|
|
|
|
procedure TMufasaBitmap.FastSetPixel(x, y: integer; Color: TColor);
|
|
begin
|
|
ValidatePoint(x,y);
|
|
FData[y*w+x] := RGBToBGR(Color);
|
|
end;
|
|
|
|
procedure TMufasaBitmap.FastSetPixels(Points: TPointArray; Colors: TIntegerArray);
|
|
var
|
|
i,len : integer;
|
|
Box : TBox;
|
|
begin
|
|
len := High(Points);
|
|
if Len <> High(colors) then
|
|
Raise Exception.CreateFMT('TPA/Colors Length differ',[]);
|
|
Box := GetTPABounds(Points);
|
|
if (Box.x1 < 0) or (Box.y1 < 0) or (Box.x2 >= self.w) or (Box.y2 >= self.h) then
|
|
raise exception.Create('The Points you passed to FastSetPixels exceed the bitmap''s bounds')
|
|
else
|
|
for i := 0 to len do
|
|
FData[Points[i].y * w + Points[i].x] := RGBToBGR(Colors[i]);
|
|
end;
|
|
|
|
procedure TMufasaBitmap.DrawATPA(ATPA: T2DPointArray; Colors: TIntegerArray);
|
|
var
|
|
lenTPA,lenATPA : integer;
|
|
i,ii : integer;
|
|
Color : TRGB32;
|
|
Box : TBox;
|
|
begin
|
|
lenATPA := High(ATPA);
|
|
if LenATPA <> High(colors) then
|
|
Raise Exception.CreateFMT('TPA/Colors Length differ -> %d : %d',[LenATPA + 1,High(Colors) + 1]);
|
|
for i := 0 to lenATPA do
|
|
begin;
|
|
lenTPA := High(ATPA[i]);
|
|
Color := RGBToBGR(Colors[i]);
|
|
Box := GetTPABounds(ATPA[i]);
|
|
if (Box.x1 < 0) or (Box.y1 < 0) or (Box.x2 >= self.w) or (Box.y2 >= self.h) then
|
|
raise exception.Create('The Points you passed to DrawATPA exceed the bitmap''s bounds')
|
|
else
|
|
for ii := 0 to lenTPA do
|
|
FData[ATPA[i][ii].y * w + ATPA[i][ii].x] := Color;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TMufasaBitmap.DrawATPA(ATPA: T2DPointArray);
|
|
var
|
|
Colors : TIntegerArray;
|
|
i,len : integer;
|
|
begin
|
|
len := high(ATPA);
|
|
SetLength(colors,len+1);
|
|
for i := 0 to len do
|
|
Colors[i] := Random(clwhite);
|
|
DrawATPA(ATPA,Colors);
|
|
end;
|
|
|
|
procedure TMufasaBitmap.DrawTPA(Points: TPointArray; Color: TColor);
|
|
begin
|
|
DrawATPA(ConvArr([Points]),ConvArr([Color]));
|
|
end;
|
|
|
|
procedure TMufasaBitmap.DrawToCanvas(x,y : integer; Canvas: TCanvas);
|
|
var
|
|
Bitmap : Graphics.TBitmap;
|
|
begin
|
|
Bitmap := Self.ToTBitmap;
|
|
Canvas.Draw(x,y,Bitmap);
|
|
Bitmap.free;
|
|
end;
|
|
|
|
function TMufasaBitmap.CreateTPA(SearchCol: TColor): TPointArray;
|
|
var
|
|
x,y,L : Integer;
|
|
StartPtr : PRGB32;
|
|
Search : TRGB32;
|
|
begin
|
|
SetLength(Result,self.Width * Self.Height);
|
|
L := 0;
|
|
Search := RGBToBGR(SearchCol);
|
|
StartPtr := Self.FData;
|
|
For y := 0 to Self.h - 1 do
|
|
For x := 0 to self.w - 1 do
|
|
begin
|
|
StartPtr^.A := 0;
|
|
if LongWord(StartPtr^) = LongWord(Search) then
|
|
begin;
|
|
L := L + 1;
|
|
Result[L].x := x;
|
|
Result[L].y := y;
|
|
end;
|
|
end;
|
|
SetLength(Result,L + 1);
|
|
end;
|
|
|
|
|
|
|
|
|
|
function TMufasaBitmap.FastGetPixel(x, y: integer): TColor;
|
|
begin
|
|
ValidatePoint(x,y);
|
|
Result := BGRToRGB(FData[y*w+x]);
|
|
end;
|
|
|
|
function TMufasaBitmap.FastGetPixels(Points: TPointArray): TIntegerArray;
|
|
var
|
|
i,len : integer;
|
|
Box : TBox;
|
|
begin
|
|
len := high(Points);
|
|
Box := GetTPABounds(Points);
|
|
if (Box.x1 < 0) or (Box.y1 < 0) or (Box.x2 >= self.w) or (Box.y2 >= self.h) then
|
|
raise exception.Create('The Points you passed to FastGetPixels exceed the bitmap''s bounds');
|
|
SetLength(result,len+1);
|
|
for i := 0 to len do
|
|
Result[i] := BGRToRGB(FData[Points[i].y*w + Points[i].x]);
|
|
end;
|
|
|
|
function TMufasaBitmap.GetAreaColors(xs, ys, xe, ye : integer): T2DIntArray;
|
|
var
|
|
x,y : integer;
|
|
begin
|
|
ValidatePoint(xs,ys);
|
|
ValidatePoint(xe,ye);
|
|
setlength(result,xe-xs+1,ye-ys+1);
|
|
for x := xs to xe do
|
|
for y := ys to ye do
|
|
result[x-xs][y-ys] := BGRToRGB(FData[y*w+x]);
|
|
end;
|
|
|
|
function TMufasaBitmap.GetHSLValues(xs, ys, xe, ye: integer): T2DHSLArray;
|
|
var
|
|
x, y: integer;
|
|
R, G, B, C: integer;
|
|
begin
|
|
ValidatePoint(xs,ys);
|
|
ValidatePoint(xe,ye);
|
|
setlength(result,ye-ys+1,xe-xs+1);
|
|
for y := ys to ye do
|
|
for x := xs to xe do
|
|
begin { REWRITE THIS }
|
|
RGBToHSL(FData[y*w+x].R, FData[y*w+x].G, FData[y*w+x].B,
|
|
Result[y-ys][x-xs].H, Result[y-ys][x-xs].S,
|
|
Result[y-ys][x-xs].L);
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.SetTransparentColor(Col: TColor);
|
|
begin
|
|
self.FTransparentSet:= True;
|
|
self.FTransparentColor:= RGBToBGR(Col);
|
|
end;
|
|
|
|
function TMufasaBitmap.GetTransparentColor: TColor;
|
|
begin
|
|
if FTransparentSet then
|
|
Result := BGRToRGB(FTransparentColor)
|
|
else
|
|
raise Exception.CreateFmt('Transparent color for Bitmap[%d] isn''t set',[index]);
|
|
end;
|
|
|
|
procedure TMufasaBitmap.SetAlphaValue(const value: byte);
|
|
var
|
|
i : integer;
|
|
begin
|
|
for i := w * h - 1 downto 0 do
|
|
FData[i].A:= Value;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.FastDrawClear(Color: TColor);
|
|
var
|
|
i : integer;
|
|
Rec : TRGB32;
|
|
begin
|
|
Rec := RGBToBGR(Color);
|
|
if h > 0 then
|
|
begin;
|
|
for i := (w-1) downto 0 do
|
|
FData[i] := Rec;
|
|
for i := (h-1) downto 1 do
|
|
Move(FData[0],FData[i*w],w*SizeOf(TRGB32));
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.FastDrawTransparent(x, y: Integer;
|
|
TargetBitmap: TMufasaBitmap);
|
|
var
|
|
MinW,MinH,TargetW,TargetH : Integer;
|
|
loopx,loopy : integer;
|
|
begin
|
|
TargetBitmap.ValidatePoint(x,y);
|
|
TargetW := TargetBitmap.Width;
|
|
TargetH := TargetBitmap.height;
|
|
MinW := Min(w-1,TargetW-x-1);
|
|
MinH := Min(h-1,TargetH-y-1);
|
|
if FTransparentSet then
|
|
begin;
|
|
for loopy := 0 to MinH do
|
|
for loopx := 0 to MinW do
|
|
begin;
|
|
FData[loopy * w + loopx].A := 0;
|
|
if LongWord(FData[loopy * w + loopx]) <> LongWord(FTransparentColor) then
|
|
TargetBitmap.FData[(loopy + y) * TargetW + loopx + x] := FData[Loopy * w + loopx];
|
|
end;
|
|
end
|
|
else
|
|
for loopy := 0 to MinH do
|
|
Move(FData[loopy*w],TargetBitmap.FData[(loopy+y) * TargetW + x],(MinW+1) * SizeOf(TRGB32));
|
|
|
|
end;
|
|
|
|
procedure TMufasaBitmap.FastReplaceColor(OldColor, NewColor: TColor);
|
|
var
|
|
OldCol,NewCol : TRGB32;
|
|
i : integer;
|
|
begin
|
|
OldCol := RGBToBGR(OldColor);
|
|
NewCol := RGBToBGR(NewColor);
|
|
for i := w*h-1 downto 0 do
|
|
begin
|
|
FData[i].a := 0;
|
|
if LongWord(FData[i]) = LongWord(OldCol) then
|
|
FData[i] := NewCol;
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.CopyClientToBitmap(MWindow : TObject;Resize : boolean; xs, ys, xe, ye: Integer);
|
|
var
|
|
y : integer;
|
|
wi,hi : integer;
|
|
PtrRet : TRetData;
|
|
begin
|
|
if Resize then
|
|
Self.SetSize(xe-xs+1,ye-ys+1);
|
|
|
|
wi := Min(xe-xs + 1,Self.w);
|
|
hi := Min(ye-ys + 1,Self.h);
|
|
|
|
PtrRet := TIOManager_Abstract(MWindow).ReturnData(xs,ys,wi,hi);
|
|
|
|
for y := 0 to (hi-1) do
|
|
Move(PtrRet.Ptr[y * PtrRet.RowLen], FData[y * self.w],wi * SizeOf(TRGB32));
|
|
TIOManager_Abstract(MWindow).FreeReturnData;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.CopyClientToBitmap(MWindow: TObject; Resize: boolean;
|
|
x, y: integer; xs, ys, xe, ye: Integer);
|
|
var
|
|
yy : integer;
|
|
wi,hi : integer;
|
|
PtrRet : TRetData;
|
|
begin
|
|
if Resize then
|
|
Self.SetSize(xe-xs+1 + x,ye-ys+1 + y);
|
|
ValidatePoint(x,y);
|
|
wi := Min(xe-xs + 1 + x,Self.w)-x;
|
|
hi := Min(ye-ys + 1 + y,Self.h)-y;
|
|
PtrRet := TIOManager_Abstract(MWindow).ReturnData(xs,ys,wi,hi);
|
|
for yy := 0 to (hi-1) do
|
|
Move(PtrRet.Ptr[yy * (PtrRet.RowLen)], FData[(yy + y) * self.w + x],wi * SizeOf(TRGB32));
|
|
TIOManager_Abstract(MWindow).FreeReturnData;
|
|
end;
|
|
|
|
|
|
function RotatePointEdited(p: TPoint; angle, mx, my: Extended): TPoint;
|
|
|
|
begin
|
|
Result.X := Ceil(mx + cos(angle) * (p.x - mx) - sin(angle) * (p.y - my));
|
|
Result.Y := Ceil(my + sin(angle) * (p.x - mx) + cos(angle) * (p.y- my));
|
|
end;
|
|
|
|
//Scar rotates unit circle-wise.. Oh, scar doesnt update the bounds, so kinda crops ur image.
|
|
procedure TMufasaBitmap.RotateBitmap(angle: Extended;TargetBitmap : TMufasaBitmap );
|
|
var
|
|
NewW,NewH : integer;
|
|
CosAngle,SinAngle : extended;
|
|
MinX,MinY,MaxX,MaxY : integer;
|
|
i : integer;
|
|
x,y : integer;
|
|
OldX,OldY : integer;
|
|
MiddlePoint : TPoint;
|
|
NewCorners : array[1..4] of TPoint; //(xs,ye);(xe,ye);(xe,ys);(xs,ys)
|
|
begin
|
|
MiddlePoint := Point((w-1) div 2,(h-1) div 2);
|
|
CosAngle := Cos(Angle);
|
|
SinAngle := Sin(Angle);
|
|
MinX := MaxInt;
|
|
MinY := MaxInt;
|
|
MaxX := 0;
|
|
MaxY := 0;
|
|
NewCorners[1]:= RotatePointEdited(Point(0,h-1),angle,middlepoint.x,middlepoint.y);
|
|
NewCorners[2]:= RotatePointEdited(Point(w-1,h-1),angle,middlepoint.x,middlepoint.y);
|
|
NewCorners[3]:= RotatePointEdited(Point(w-1,0),angle,middlepoint.x,middlepoint.y);
|
|
NewCorners[4]:= RotatePointEdited(Point(0,0),angle,middlepoint.x,middlepoint.y);
|
|
for i := 1 to 4 do
|
|
begin;
|
|
if NewCorners[i].x > MaxX then
|
|
MaxX := NewCorners[i].x;
|
|
if NewCorners[i].Y > MaxY then
|
|
MaxY := NewCorners[i].y;
|
|
if NewCorners[i].x < MinX then
|
|
MinX := NewCorners[i].x;
|
|
if NewCorners[i].y < MinY then
|
|
MinY := NewCorners[i].y;
|
|
end;
|
|
mDebugLn(Format('Min: (%d,%d) Max : (%d,%d)',[MinX,MinY,MaxX,MaxY]));
|
|
NewW := MaxX - MinX+1;
|
|
NewH := MaxY - MinY+1;
|
|
mDebugLn(format('New bounds: %d,%d',[NewW,NewH]));
|
|
TargetBitmap.SetSize(NewW,NewH);
|
|
for y := NewH - 1 downto 0 do
|
|
for x := NewW - 1 downto 0 do
|
|
begin;
|
|
Oldx := Round(MiddlePoint.x + CosAngle * (x + MinX-MiddlePoint.x) - SinAngle * (y + MinY - MiddlePoint.y));
|
|
Oldy := Round(MiddlePoint.y + SinAngle * (x + MinX-MiddlePoint.x) + CosAngle * (y + MinY-MiddlePoint.y));
|
|
if not ((Oldx <0) or (Oldx >= w) or (Oldy < 0) or (Oldy >= h)) then
|
|
TargetBitmap.FData[ y * NewW + x] := Self.FData[OldY * W + OldX];
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.Desaturate;
|
|
var
|
|
I : integer;
|
|
He,Se,Le : extended;
|
|
Ptr : PRGB32;
|
|
begin
|
|
Ptr := FData;
|
|
for i := (h*w-1) downto 0 do
|
|
begin;
|
|
RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,He,Se,Le);
|
|
HSLtoRGB(He,0.0,Le,Ptr^.R,Ptr^.G,Ptr^.B);
|
|
inc(ptr);
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.Desaturate(TargetBitmap: TMufasaBitmap);
|
|
var
|
|
I : integer;
|
|
He,Se,Le : extended;
|
|
PtrOld,PtrNew : PRGB32;
|
|
begin
|
|
TargetBitmap.SetSize(w,h);
|
|
PtrOld := Self.FData;
|
|
PtrNew := TargetBitmap.FData;
|
|
for i := (h*w-1) downto 0 do
|
|
begin;
|
|
RGBToHSL(PtrOld^.R,PtrOld^.G,PtrOld^.B,He,Se,Le);
|
|
HSLtoRGB(He,0.0,Le,PtrNew^.R,PtrNew^.G,PtrNew^.B);
|
|
inc(ptrOld);
|
|
inc(PtrNew);
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.GreyScale(TargetBitmap: TMufasaBitmap);
|
|
var
|
|
I : integer;
|
|
Lum : byte;
|
|
PtrOld,PtrNew : PRGB32;
|
|
begin
|
|
TargetBitmap.SetSize(w,h);
|
|
PtrOld := Self.FData;
|
|
PtrNew := TargetBitmap.FData;
|
|
for i := (h*w-1) downto 0 do
|
|
begin;
|
|
Lum := Round(PtrOld^.r * 0.3 + PtrOld^.g * 0.59 + PtrOld^.b * 0.11);
|
|
PtrNew^.r := Lum;
|
|
PtrNew^.g := Lum;
|
|
PtrNew^.b := Lum;
|
|
inc(ptrOld);
|
|
inc(PtrNew);
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.GreyScale;
|
|
var
|
|
I : integer;
|
|
Lum : Byte;
|
|
Ptr: PRGB32;
|
|
begin
|
|
Ptr := Self.FData;
|
|
for i := (h*w-1) downto 0 do
|
|
begin;
|
|
Lum := Round(Ptr^.r * 0.3 + Ptr^.g * 0.59 + Ptr^.b * 0.11);
|
|
Ptr^.r := Lum;
|
|
Ptr^.g := Lum;
|
|
Ptr^.b := Lum;
|
|
inc(ptr);
|
|
end;
|
|
end;
|
|
|
|
function BrightnessAdjust(Col: byte; br : integer): byte;inline;
|
|
var
|
|
temp : integer;
|
|
begin;
|
|
Temp := Col + Br;
|
|
if temp < 0 then
|
|
temp := 0
|
|
else if temp > 255 then
|
|
temp := 255;
|
|
result := temp;
|
|
end;
|
|
procedure TMufasaBitmap.Brightness(br: integer);
|
|
var
|
|
I : integer;
|
|
Ptr: PRGB32;
|
|
begin
|
|
Ptr := Self.FData;
|
|
for i := (h*w-1) downto 0 do
|
|
begin;
|
|
Ptr^.r := BrightnessAdjust(Ptr^.r,br);
|
|
Ptr^.g := BrightnessAdjust(Ptr^.g,br);
|
|
Ptr^.b := BrightnessAdjust(Ptr^.b,br);
|
|
inc(ptr);
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.Brightness(TargetBitmap: TMufasaBitmap; br: integer);
|
|
var
|
|
I : integer;
|
|
PtrOld,PtrNew : PRGB32;
|
|
begin
|
|
TargetBitmap.SetSize(w,h);
|
|
PtrOld := Self.FData;
|
|
PtrNew := TargetBitmap.FData;
|
|
for i := (h*w-1) downto 0 do
|
|
begin;
|
|
PtrNew^.r := BrightnessAdjust(PtrOld^.r,br);
|
|
PtrNew^.g := BrightnessAdjust(PtrOld^.g,br);
|
|
PtrNew^.b := BrightnessAdjust(PtrOld^.b,br);
|
|
inc(ptrOld);
|
|
inc(PtrNew);
|
|
end;
|
|
end;
|
|
|
|
const
|
|
Grey = 128;
|
|
function ContrastAdjust(Col: byte; co : extended): byte;inline;
|
|
var
|
|
temp : integer;
|
|
begin;
|
|
Temp := floor((col - Grey) * co) + grey;
|
|
if temp < 0 then
|
|
temp := 0
|
|
else if temp > 255 then
|
|
temp := 255;
|
|
result := temp;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.Contrast(co: Extended);
|
|
var
|
|
I : integer;
|
|
Ptr: PRGB32;
|
|
begin
|
|
Ptr := Self.FData;
|
|
for i := (h*w-1) downto 0 do
|
|
begin;
|
|
Ptr^.r := ContrastAdjust(Ptr^.r,co);
|
|
Ptr^.g := ContrastAdjust(Ptr^.g,co);
|
|
Ptr^.b := ContrastAdjust(Ptr^.b,co);
|
|
inc(ptr);
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.Contrast(TargetBitmap: TMufasaBitmap; co: Extended);
|
|
var
|
|
I : integer;
|
|
PtrOld,PtrNew : PRGB32;
|
|
begin
|
|
TargetBitmap.SetSize(w,h);
|
|
PtrOld := Self.FData;
|
|
PtrNew := TargetBitmap.FData;
|
|
for i := (h*w-1) downto 0 do
|
|
begin;
|
|
PtrNew^.r := ContrastAdjust(PtrOld^.r,co);
|
|
PtrNew^.g := ContrastAdjust(PtrOld^.g,co);
|
|
PtrNew^.b := ContrastAdjust(PtrOld^.b,co);
|
|
inc(ptrOld);
|
|
inc(PtrNew);
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.Invert;
|
|
var
|
|
i : integer;
|
|
begin
|
|
for i := (h*w-1) downto 0 do
|
|
begin;
|
|
Self.FData[i].r := not Self.FData[i].r;
|
|
Self.FData[i].g := not Self.FData[i].g;
|
|
Self.Fdata[i].b := not Self.FData[i].b;
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.Invert(TargetBitmap: TMufasaBitmap);
|
|
var
|
|
I : integer;
|
|
PtrOld,PtrNew : PRGB32;
|
|
begin
|
|
TargetBitmap.SetSize(w,h);
|
|
PtrOld := Self.FData;
|
|
PtrNew := TargetBitmap.FData;
|
|
for i := (h*w-1) downto 0 do
|
|
begin;
|
|
PtrNew^.r := not PtrOld^.r;
|
|
PtrNew^.g := not PtrOld^.g;
|
|
PtrNew^.b := not PtrOld^.b;
|
|
inc(ptrOld);
|
|
inc(PtrNew);
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.Posterize(TargetBitmap: TMufasaBitmap; Po: integer);
|
|
var
|
|
I : integer;
|
|
PtrOld,PtrNew : PRGB32;
|
|
begin
|
|
if not InRange(Po,1,255) then
|
|
Raise exception.CreateFmt('Posterize Po(%d) out of range[1,255]',[Po]);
|
|
TargetBitmap.SetSize(w,h);
|
|
PtrOld := Self.FData;
|
|
PtrNew := TargetBitmap.FData;
|
|
for i := (h*w-1) downto 0 do
|
|
begin;
|
|
PtrNew^.r := min(Round(PtrOld^.r / po) * Po, 255);
|
|
PtrNew^.g := min(Round(PtrOld^.g / po) * Po, 255);
|
|
PtrNew^.b := min(Round(PtrOld^.b / po) * Po, 255);
|
|
inc(ptrOld);
|
|
inc(PtrNew);
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.Posterize(Po: integer);
|
|
var
|
|
I : integer;
|
|
Ptr: PRGB32;
|
|
{a:integer; }
|
|
begin
|
|
if not InRange(Po,1,255) then
|
|
Raise exception.CreateFmt('Posterize Po(%d) out of range[1,255]',[Po]);
|
|
Ptr := Self.FData;
|
|
for i := (h*w-1) downto 0 do
|
|
begin;
|
|
{ a := round(ptr^.r / po);
|
|
a := a * po;
|
|
ptr^.r := min(a,255);
|
|
a := round(ptr^.g / po);
|
|
a := a * po;
|
|
ptr^.g := min(a,255);
|
|
a := round(ptr^.b / po);
|
|
a := a * po;
|
|
ptr^.b := min(a,255); }
|
|
ptr^.r := min(Round(ptr^.r / po) * Po, 255);
|
|
ptr^.g := min(Round(ptr^.g / po) * Po, 255);
|
|
ptr^.b := min(Round(ptr^.b / po) * Po, 255);
|
|
inc(ptr);
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.Convolute(TargetBitmap : TMufasaBitmap; Matrix: T2DExtendedArray);
|
|
var
|
|
x,y,xx,yy : integer;
|
|
mw,mh : integer; //Matrix-Width/Matrix-height;
|
|
Row,RowT : TPRGB32Array;
|
|
R,G,B : extended;
|
|
midX,midY : integer;
|
|
xmax,ymax : integer;
|
|
begin
|
|
mw := Length(Matrix);
|
|
mh := Length(Matrix[0]);
|
|
if ((mw mod 2) = 0) or ((mh mod 2) = 0) then
|
|
exit;
|
|
TargetBitmap.SetSize(w,h);
|
|
Row := RowPtrs;
|
|
RowT := TargetBitmap.RowPtrs; //Target
|
|
midX := mw div 2;
|
|
midY := mh div 2;
|
|
xmax := w-1-midX;
|
|
ymax := h-1-midY;
|
|
dec(mw); dec(mh); //Faster in loop.
|
|
for x := midx to xmax do
|
|
for y := midy to ymax do
|
|
begin
|
|
R := 0;
|
|
G := 0;
|
|
B := 0;
|
|
for xx := mw downto 0 do // for xx := x - midx to x + midx do
|
|
for yy := mh downto 0 do
|
|
begin
|
|
r := r + Row[y+yy-midy][x+xx-midx].r * Matrix[xx][yy];
|
|
g := g + Row[y+yy-midy][x+xx-midx].g * Matrix[xx][yy];
|
|
b := b + Row[y+yy-midy][x+xx-midx].b * Matrix[xx][yy];
|
|
end;
|
|
RowT[y][x].r := round(r);
|
|
RowT[y][x].g := round(g);
|
|
RowT[y][x].b := round(b);
|
|
end;
|
|
end;
|
|
|
|
function TMufasaBitmap.CreateTMask: TMask;
|
|
var
|
|
x,y : integer;
|
|
dX,dY : integer;
|
|
begin
|
|
Result.BlackHi:= -1;
|
|
Result.WhiteHi:= -1;
|
|
Result.W := Self.Width;
|
|
Result.H := Self.Height;
|
|
SetLength(result.Black,w*h);
|
|
SetLength(result.White,w*h);
|
|
dX := w-1;
|
|
dY := h-1;
|
|
for y := 0 to dY do
|
|
for x := 0 to dX do
|
|
//Check for non-white/black pixels? Not for now atleast.
|
|
if FData[y*w+x].r = 255 then
|
|
begin;
|
|
inc(Result.WhiteHi);
|
|
Result.White[Result.WhiteHi].x := x;
|
|
Result.White[Result.WhiteHi].y := y;
|
|
end else
|
|
begin;
|
|
inc(Result.BlackHi);
|
|
Result.Black[Result.BlackHi].x := x;
|
|
Result.Black[Result.BlackHi].y := y;
|
|
end;
|
|
SetLength(result.Black,Result.BlackHi+1);
|
|
SetLength(result.White,Result.WhiteHi+1);
|
|
end;
|
|
|
|
|
|
|
|
constructor TMBitmaps.Create(Owner: TObject);
|
|
begin
|
|
inherited Create;
|
|
SetLength(BmpArray,50);
|
|
SetLength(FreeSpots, 50);
|
|
FreeSpotsLen := 50;
|
|
BmpsHigh := 49;
|
|
BmpsCurr := -1;
|
|
FreeSpotsHigh := -1;
|
|
Self.Client := Owner;
|
|
end;
|
|
|
|
destructor TMBitmaps.Destroy;
|
|
var
|
|
I : integer;
|
|
WriteStr : string;
|
|
begin
|
|
WriteStr := '[';
|
|
for i := 0 to BmpsCurr do
|
|
if BmpArray[i] <> nil then
|
|
begin;
|
|
if BmpArray[i].Name = '' then
|
|
WriteStr := WriteStr + inttostr(i) + ', '
|
|
else
|
|
WriteStr := WriteStr + bmpArray[i].Name + ', ';
|
|
FreeAndNil(BmpArray[i]);
|
|
end;
|
|
if WriteStr <> '[' then //Has unfreed bitmaps
|
|
begin
|
|
SetLength(WriteStr,length(WriteStr)-1);
|
|
WriteStr[Length(writeStr)] := ']';
|
|
TClient(Client).Writeln(Format('The following bitmaps were not freed: %s',[WriteStr]));
|
|
end;
|
|
SetLength(BmpArray,0);
|
|
SetLength(FreeSpots,0);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
|
|
{ TMufasaBitmap }
|
|
procedure TMufasaBitmap.SetSize(Awidth, Aheight: integer);
|
|
var
|
|
NewData : PRGB32;
|
|
i,minw,minh : integer;
|
|
begin
|
|
if (AWidth <> w) or (AHeight <> h) then
|
|
begin
|
|
if AWidth*AHeight <> 0 then
|
|
begin;
|
|
NewData := GetMem(AWidth * AHeight * SizeOf(TRGB32));
|
|
FillDWord(NewData[0],AWidth*AHeight,0);
|
|
end
|
|
else
|
|
NewData := nil;
|
|
if Assigned(FData) and Assigned(NewData) and (w*H <> 0) then
|
|
begin;
|
|
minw := Min(AWidth,w);
|
|
minh := Min(AHeight,h);
|
|
for i := 0 to minh - 1 do
|
|
Move(FData[i*w],Newdata[i*AWidth],minw * SizeOf(TRGB32));
|
|
end;
|
|
if Assigned(FData) then
|
|
FreeMem(FData);
|
|
FData := NewData;
|
|
w := AWidth;
|
|
h := AHeight;
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.StretchResize(AWidth, AHeight: integer);
|
|
var
|
|
NewData : PRGB32;
|
|
x,y : integer;
|
|
begin
|
|
if (AWidth <> w) or (AHeight <> h) then
|
|
begin;
|
|
if AWidth*AHeight <> 0 then
|
|
begin;
|
|
NewData := GetMem(AWidth * AHeight * SizeOf(TRGB32));
|
|
FillDWord(NewData[0],AWidth*AHeight,0);
|
|
end
|
|
else
|
|
NewData := nil;
|
|
if Assigned(FData) and Assigned(NewData) and (w*H <> 0) then
|
|
begin;
|
|
for y := 0 to AHeight - 1 do
|
|
for x := 0 to AWidth -1 do
|
|
NewData[y*AWidth + x] := FData[((y * h)div aheight) * W+ (x * W) div awidth];
|
|
end;
|
|
if Assigned(FData) then
|
|
FreeMem(FData);
|
|
FData := NewData;
|
|
w := AWidth;
|
|
h := AHeight;
|
|
end;
|
|
end;
|
|
|
|
procedure TMufasaBitmap.ValidatePoint(x, y: integer);
|
|
begin
|
|
if (x <0) or (x >= w) or (y < 0) or (y >= h) then
|
|
raise Exception.CreateFmt('You are accessing an invalid point, (%d,%d) at bitmap[%d]',[x,y,index]);
|
|
end;
|
|
|
|
constructor TMufasaBitmap.Create;
|
|
begin
|
|
inherited Create;
|
|
Name:= '';
|
|
FTransparentSet:= False;
|
|
setSize(0,0);
|
|
{FData:= nil;
|
|
w := 0;
|
|
h := 0; }
|
|
end;
|
|
|
|
destructor TMufasaBitmap.Destroy;
|
|
begin
|
|
if Assigned(OnDestroy) then
|
|
OnDestroy(Self);
|
|
if Assigned(FData) then
|
|
Freemem(FData);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
end.
|
|
|