moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-05 00:45:14 -05:00
Code Issues Releases Wiki Activity

Revert of 336.

Browse Source 
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@337 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Wizzup? 2009-12-25 15:40:14 +00:00
parent a176b953e1
commit 8b13311539
3 changed files with 60 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Projects/SAMufasaGUI/testunit.pas
View File

@ -575,9 +575,7 @@ begin
if OldIndex > TabIndex then
PageControl1.TabIndex := OldIndex - 1
else if OldIndex < TabIndex then
PageControl1.TabIndex := OldIndex
else
PageControl1.TabIndex:= TabIndex;
PageControl1.TabIndex := OldIndex;
end;
if tabs.count <= 1 then
begin;

128
Units/MMLCore/bitmaps.pas
View File

@ -173,7 +173,6 @@ function TMBitmaps.CreateMirroredBitmap(bitmap: Integer;
var
w,h : integer;
y,x : integer;
f1, f2: Integer;
Source,Dest : PRGB32;
begin
Source := Bmp[Bitmap].FData;
@ -185,28 +184,15 @@ begin
Result := CreateBMP(w,h);
Dest := BmpArray[Result].FData;
case MirrorStyle of
MirrorWidth :
begin
f1 := w*h;
f2 := f1 + w - 1;
for y := (h-1) downto 0 do
for x := (w-1) downto 0 do
Dest[f1+x] := Source[f2-x];
end;
MirrorHeight :
begin
f1 := h - 1;
for y := f1 downto 0 do // Does SizeOf(TRGB32) Change?
Move(Source[y*w], Dest[(f1 - y) * w], w*SizeOf(TRGB32));
end;
MirrorLine :
begin
f1 := h-1;
f2 := w-1;
for y := f1 downto 0 do
for x := f2 downto 0 do
Dest[x*h+y] := Source[y*w+x];
end;
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;
@ -516,7 +502,7 @@ begin
begin;
for i := (w-1) downto 0 do
FData[i] := Rec;
for i := (h-1) downto 1 do // does SizeOf(TRGB32) Change?
for i := (h-1) downto 1 do
Move(FData[0],FData[i*w],w*SizeOf(TRGB32));
end;
end;
@ -549,12 +535,11 @@ end;
procedure TMufasaBitmap.FastReplaceColor(OldColor, NewColor: TColor);
var
OldCol,NewCol : TRGB32;
i, wh : integer;
i : integer;
begin
OldCol := RGBToBGR(OldColor);
NewCol := RGBToBGR(NewColor);
wh := w*h-1;
for i := wh downto 0 do
for i := w*h-1 downto 0 do
if LongWord(FData[i]) = LongWord(OldCol) then
FData[i] := NewCol;
end;
@ -562,7 +547,7 @@ end;
procedure TMufasaBitmap.CopyClientToBitmap(MWindow : TObject;Resize : boolean; xs, ys, xe, ye: Integer);
var
y : integer;
wi, hi, hh : integer;
wi,hi : integer;
PtrRet : TRetData;
begin
if Resize then
@ -577,8 +562,7 @@ begin
writeln('WAT y'); }
PtrRet := TMWindow(MWindow).ReturnData(xs,ys,wi,hi);
hh := hi-1;
for y := 0 to hh do
for y := 0 to (hi-1) do
Move(PtrRet.Ptr[y * (wi + PtrRet.IncPtrWith)], FData[y * self.w],wi * SizeOf(TRGB32));
TMWindow(MWindow).FreeReturnData;
end;
@ -587,7 +571,7 @@ procedure TMufasaBitmap.CopyClientToBitmap(MWindow: TObject; Resize: boolean;
x, y: integer; xs, ys, xe, ye: Integer);
var
yy : integer;
wi,hi,hh : integer;
wi,hi : integer;
PtrRet : TRetData;
begin
if Resize then
@ -596,8 +580,7 @@ begin
hi := Min(ye-ys + 1 + y,Self.h);
PtrRet := TMWindow(MWindow).ReturnData(xs,ys,wi - x,hi - y);
hh := hi-1-y;
for yy := 0 to hh do
for yy := 0 to (hi-1 - y) do
Move(PtrRet.Ptr[yy * (wi - x + PtrRet.IncPtrWith)], FData[(yy + y) * self.w + x],wi * SizeOf(TRGB32));
TMWindow(MWindow).FreeReturnData;
end;
@ -617,7 +600,7 @@ var
CosAngle,SinAngle : extended;
MinX,MinY,MaxX,MaxY : integer;
i : integer;
x,y,hm1, wm1, yy, xx : integer;
x,y : integer;
OldX,OldY : integer;
MiddlePoint : TPoint;
NewCorners : array[1..4] of TPoint; //(xs,ye);(xe,ye);(xe,ys);(xs,ys)
@ -629,11 +612,9 @@ begin
MinY := MaxInt;
MaxX := 0;
MaxY := 0;
hm1 := h-1;
wm1 := w-1;
NewCorners[1]:= RotatePointEdited(Point(0,hm1),angle,middlepoint.x,middlepoint.y);
NewCorners[2]:= RotatePointEdited(Point(wm1,hm1),angle,middlepoint.x,middlepoint.y);
NewCorners[3]:= RotatePointEdited(Point(wm1,0),angle,middlepoint.x,middlepoint.y);
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;
@ -651,15 +632,11 @@ begin
NewH := MaxY - MinY+1;
Writeln(format('New bounds: %d,%d',[NewW,NewH]));
TargetBitmap.SetSize(NewW,NewH);
hm1 := NewH-1;
wm1 := NewW-1;
xx := MinX-MiddlePoint.x;
yy := MinY-MiddlePoint.y;
for y := hm1 downto 0 do
for x := wm1 downto 0 do
for y := NewH - 1 downto 0 do
for x := NewW - 1 downto 0 do
begin;
Oldx := Round(MiddlePoint.x + CosAngle * (x + xx) - SinAngle * (y + yy));
Oldy := Round(MiddlePoint.y + SinAngle * (x + xx) + CosAngle * (y + yy));
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;
@ -667,13 +644,12 @@ end;
procedure TMufasaBitmap.Desaturate;
var
I, HH : integer;
I : integer;
He,Se,Le : extended;
Ptr : PRGB32;
begin
Ptr := FData;
HH := h*w-1;
for i := HH downto 0 do
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);
@ -683,15 +659,14 @@ end;
procedure TMufasaBitmap.Desaturate(TargetBitmap: TMufasaBitmap);
var
I,HH : integer;
I : integer;
He,Se,Le : extended;
PtrOld,PtrNew : PRGB32;
begin
TargetBitmap.SetSize(w,h);
PtrOld := Self.FData;
PtrNew := TargetBitmap.FData;
HH := w*h-1;
for i := HH downto 0 do
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);
@ -702,15 +677,14 @@ end;
procedure TMufasaBitmap.GreyScale(TargetBitmap: TMufasaBitmap);
var
I, HH : integer;
I : integer;
Lum : byte;
PtrOld,PtrNew : PRGB32;
begin
TargetBitmap.SetSize(w,h);
PtrOld := Self.FData;
PtrNew := TargetBitmap.FData;
HH := h*w-1;
for i := HH downto 0 do
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;
@ -723,13 +697,12 @@ end;
procedure TMufasaBitmap.GreyScale;
var
I, HH : integer;
I : integer;
Lum : Byte;
Ptr: PRGB32;
begin
Ptr := Self.FData;
HH := h*w-1;
for i := HH downto 0 do
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;
@ -752,12 +725,11 @@ begin;
end;
procedure TMufasaBitmap.Brightness(br: integer);
var
I, hh : integer;
I : integer;
Ptr: PRGB32;
begin
Ptr := Self.FData;
hh := h*w-1;
for i := hh downto 0 do
for i := (h*w-1) downto 0 do
begin;
Ptr^.r := BrigthnessAdjust(Ptr^.r,br);
Ptr^.g := BrigthnessAdjust(Ptr^.g,br);
@ -768,14 +740,13 @@ end;
procedure TMufasaBitmap.Brightness(TargetBitmap: TMufasaBitmap; br: integer);
var
I, hh: integer;
I : integer;
PtrOld,PtrNew : PRGB32;
begin
TargetBitmap.SetSize(w,h);
PtrOld := Self.FData;
PtrNew := TargetBitmap.FData;
hh := h*w-1;
for i := hh downto 0 do
for i := (h*w-1) downto 0 do
begin;
PtrNew^.r := BrigthnessAdjust(PtrOld^.r,br);
PtrNew^.g := BrigthnessAdjust(PtrOld^.g,br);
@ -801,12 +772,11 @@ end;
procedure TMufasaBitmap.Contrast(co: Extended);
var
I, hh: integer;
I : integer;
Ptr: PRGB32;
begin
Ptr := Self.FData;
hh := h*w-1;
for i := hh downto 0 do
for i := (h*w-1) downto 0 do
begin;
Ptr^.r := ContrastAdjust(Ptr^.r,co);
Ptr^.g := ContrastAdjust(Ptr^.g,co);
@ -817,14 +787,13 @@ end;
procedure TMufasaBitmap.Contrast(TargetBitmap: TMufasaBitmap; co: Extended);
var
I,hh: integer;
I : integer;
PtrOld,PtrNew : PRGB32;
begin
TargetBitmap.SetSize(w,h);
PtrOld := Self.FData;
PtrNew := TargetBitmap.FData;
hh := h*w-1;
for i := hh downto 0 do
for i := (h*w-1) downto 0 do
begin;
PtrNew^.r := ContrastAdjust(PtrOld^.r,co);
PtrNew^.g := ContrastAdjust(PtrOld^.g,co);
@ -836,10 +805,9 @@ end;
procedure TMufasaBitmap.Invert;
var
i, hh : integer;
i : integer;
begin
hh := h*w-1;
for i := hh downto 0 do
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;
@ -849,7 +817,7 @@ end;
procedure TMufasaBitmap.Posterize(TargetBitmap: TMufasaBitmap; Po: integer);
var
I,hh : integer;
I : integer;
PtrOld,PtrNew : PRGB32;
begin
if not InRange(Po,1,255) then
@ -857,8 +825,7 @@ begin
TargetBitmap.SetSize(w,h);
PtrOld := Self.FData;
PtrNew := TargetBitmap.FData;
hh := w*h-1;
for i := hh downto 0 do
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);
@ -870,22 +837,21 @@ end;
procedure TMufasaBitmap.Posterize(Po: integer);
var
I,hh: integer;
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;
hh := w*h-1;
for i := hh downto 0 do
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); // bit redundant math, aye?
ptr^.g := min(a,255);
a := round(ptr^.b / po);
a := a * po;
ptr^.b := min(a,255); }

30
Units/MMLCore/finder.pas
View File

@ -180,7 +180,7 @@ end;
//SkipCoords[y][x] = False/True; True means its "transparent" and therefore not needed to be checked.
procedure CalculateBitmapSkipCoords(Bitmap : TMufasaBitmap; out SkipCoords : T2DBoolArray);
var
x,y,ww, hh : integer;
x,y : integer;
R,G,B : byte;
Ptr : PRGB32;
begin;
@ -191,10 +191,8 @@ begin;
ColorToRGB(Bitmap.GetTransparentColor,r,g,b);
Ptr := Bitmap.FData;
SetLength(SkipCoords,Bitmap.Height,Bitmap.Width);
ww := Bitmap.Width - 1;
hh := Bitmap.Height - 1;
for y := 0 to hh do
for x := 0 to ww do
for y := 0 to Bitmap.Height - 1 do
for x := 0 to Bitmap.Width - 1 do
begin;
if (Ptr^.r = r) and (Ptr^.g = g) and (Ptr^.b = b) then
SkipCoords[y][x] := True
@ -206,7 +204,7 @@ end;
//Points left holds the amount of points that are "left" to be checked (Including the point itself.. So for example Pointsleft[0][0] would hold the total amount of pixels that are to be checked.
procedure CalculateBitmapSkipCoordsEx(Bitmap : TMufasaBitmap; out SkipCoords : T2DBoolArray;out TotalPoints : integer; out PointsLeft : T2DIntArray);
var
x,y,ww,hh : integer;
x,y : integer;
R,G,B : byte;
Ptr : PRGB32;
TotalC : integer;
@ -220,10 +218,8 @@ begin;
Ptr := Bitmap.FData;
SetLength(SkipCoords,Bitmap.Height,Bitmap.Width);
SetLength(PointsLeft,Bitmap.Height,Bitmap.Width);
ww := Bitmap.Width - 1;
hh := Bitmap.Height - 1;
for y := 0 to hh do
for x := 0 to ww do
for y := 0 to Bitmap.Height - 1 do
for x := 0 to Bitmap.Width - 1 do
begin;
if (Ptr^.r = r) and (Ptr^.g = g) and (Ptr^.b = b) then
SkipCoords[y][x] := True
@ -235,8 +231,8 @@ begin;
inc(ptr);
end;
TotalPoints:= TotalC;
for y := 0 to hh do
for x := 0 to ww do
for y := 0 to Bitmap.Height - 1 do
for x := 0 to Bitmap.Width - 1 do
begin;
PointsLeft[y][x] := TotalC;
if not SkipCoords[y][x] then
@ -279,14 +275,11 @@ var
H1,S1,L1,H2,S2,L2 : extended;
begin
Result := False;
if Color1 = Color2 then
begin
Result := true;
exit;
end;
ColorToRGB(Color1,R1,G1,B1);
ColorToRGB(Color2,R2,G2,B2);
if Color1 = Color2 then
Result := true
else
case CTS of
0: Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance));
1: Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance);
@ -420,6 +413,7 @@ begin
begin;
for xx := xs to xe do
begin;
// Colour comparison here. Possibly with tolerance? ;)
if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then
inc(result);
Inc(Ptr);