initial commit

This commit is contained in:
ShevaIV 2025-05-12 10:07:51 +03:00
commit 00e2ad8635
923 changed files with 1507529 additions and 0 deletions

26
.gitignore vendored Normal file
View File

@ -0,0 +1,26 @@
# Delphi
__history/
*.~*
*.scc
*.dcu
*.bak
*.local
*.identcache
*.tvsconfig
*.dsk
*.cfg
*.stat
*.exe
*.dll
*.map
*.tds
*.obj
*.bpl
*.dcp
*.lib
*.so
*.o
*.~*
*.log
*.tmp
*.dproj.local

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,107 @@
library AdjustBitmap;
{ A Power Plugin DLL should simply have 3 Procedures.
1 - Init
GetVerbs will have a parameter of pointer.The application will call this
init procedure by passing its instance to it. This is a standart procedure
and should be implemeted same in all plugins.
2 - GetVerbs
GetVerbs will return a pchar including the name of the Verbs called from the
application. Note that these verb names will be taken by the application to
the menu, and each menu click will call the third exported procedure (DoVerb)
with the verb index which is in fact the index of the verb in the string list.
3 - DoVerb
DoVerb has one parameter. It stands for the index of the verb to be
called. In this procedure you will do your actions by using the procedure
and functions that are defined in the interface of the PCPlgLib unit that
you should include in the uses clause of this dll dpr.
}
uses
SysUtils,
Classes,
Windows,
Messages,
Graphics,
Controls,
Forms,
StdCtrls,
Buttons,
Grids,
Dialogs,
bmpform in 'bmpform.pas' {formBmp},
PCPlgLib in '../PCPlgLib.pas';
procedure Init(Owner: Integer); stdcall;
begin
GetAdresses(Owner);
// Plugin specific intialization code
end;
Function GetVerbs:PChar;stdcall;
var res: pchar;
Begin
res := 'Adjust Brightness';
// if you had two verbs then the second one should be
// added with a return character
// res := 'Edit Bitmap'+#13+'The Second';
result := res;
End;
Procedure HandleBmpObject(f:Integer);
var frm: TformBmp;
fName: String;
xBitmap: Tbitmap;
begin
fName := 'c:\Abplg.tmp';
pcFigureSaveBitmapToFile(f,pchar(fName));
Sleep(250);
xBitmap := Tbitmap.Create;
xBitmap.LoadFromFile(fName);
frm := TFormBmp.Create(nil);
if frm.EditBitmap(xBitmap) then
begin
xBitmap.SaveToFile(fName);
pcFigureLoadBitmapFromFile(f,pchar(fName));
end;
frm.free;
end;
Procedure EditBitmap;
var i,cnt:Integer;
cName: String;
fBmp: Integer;
fHandle: Integer;
Begin
cnt := pcGetPropSelectedCount;
for i := 0 to Cnt -1 do
begin
fHandle := pcGetSelectedHandle(i);
cName := String(pcFigureGetClass(fHandle));
if Copy(uppercase(cName) ,1,4) = 'TBMP' then
begin
HandleBmpObject(fHandle);
Exit;
end;
end;
MessageDlg('Select a Bitmap Object to adjust first',mtWarning,[mbOk],0);
End;
Procedure DoVerb(VerbIndex: integer);stdcall;
Begin
if VerbIndex = 0 then EditBitmap;
end;
exports
Init name 'Init',
GetVerbs name 'GetVerbs',
DoVerb name 'DoVerb';
begin
end.

Binary file not shown.

View File

@ -0,0 +1,142 @@
unit bmpform;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, Grids, ExtCtrls, CheckLst, ExtDlgs, Menus,
ComCtrls;
type
TformBmp = class(TForm)
Button1: TButton;
Button2: TButton;
Panel2: TPanel;
TrackBar1: TTrackBar;
pbox: TPaintBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure pboxPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
orgbmp,newbmp: Tbitmap;
Function EditBitmap(xbmp:Tbitmap): Boolean;
end;
const
MaxPixelCount = 32768;
type
pRGBArray = ^TRGBArray;
TRGBArray = ARRAY[0..MaxPixelCount-1] OF TRGBTriple;
var
formBmp: TformBmp;
implementation
{$R *.DFM}
procedure TformBmp.Button1Click(Sender: TObject);
begin
modalresult := mrOk;
end;
procedure TformBmp.Button2Click(Sender: TObject);
begin
modalresult := mrCancel;
end;
function TformBmp.EditBitmap(xbmp:Tbitmap): Boolean;
var w,h:Integer;
sx,sy,s: Double;
begin
w := xbmp.Width;
h := xbmp.Height;
orgbmp := Tbitmap.Create;
orgbmp.Width := w;
orgbmp.Height := h;
orgbmp.PixelFormat := xbmp.PixelFormat;
orgbmp.Canvas.Draw(0,0,xbmp);
NewBmp := xbmp;
sx := (panel2.Width-10) / w;
sy := (panel2.Height-10) / h;
if sx > sy then s := sy else s :=sx;
pBox.Width := round(w*s);
pBox.Height := round(h*s);
pBox.Top := (panel2.Height - pBox.Height) div 2;
pBox.Left := (panel2.Width - pBox.Width) div 2;
result := (ShowModal = mrOk);
if result then begin
xbmp.Assign(newbmp);
end;
orgbmp.free;
end;
function Min(a, b: integer): integer;
begin
if a < b then result := a
else result := b;
end;
function Max(a, b: integer): integer;
begin
if a > b then result := a
else result := b;
end;
procedure TformBmp.TrackBar1Change(Sender: TObject);
var i, j, value: integer;
OrigRow, DestRow: pRGBArray;
begin
// get brightness increment value
value := TTrackBar(Sender).Position;
// for each row of pixels
for i := 0 to orgbmp.Height - 1 do
begin
OrigRow := orgbmp.ScanLine[i];
DestRow := newBmp.ScanLine[i];
// for each pixel in row
for j := 0 to orgBmp.Width - 1 do
begin
// add brightness value to pixel's RGB values
if value > 0 then
begin
// RGB values must be less than 256
DestRow[j].rgbtRed := Min(255, OrigRow[j].rgbtRed + value);
DestRow[j].rgbtGreen := Min(255, OrigRow[j].rgbtGreen + value);
DestRow[j].rgbtBlue := Min(255, OrigRow[j].rgbtBlue + value);
end else begin
// RGB values must be greater or equal than 0
DestRow[j].rgbtRed := Max(0, OrigRow[j].rgbtRed + value);
DestRow[j].rgbtGreen := Max(0, OrigRow[j].rgbtGreen + value);
DestRow[j].rgbtBlue := Max(0, OrigRow[j].rgbtBlue + value);
end;
end;
end;
pBox.Repaint;
end;
procedure TformBmp.FormCreate(Sender: TObject);
begin
panel2.doublebuffered := true;
end;
procedure TformBmp.pboxPaint(Sender: TObject);
begin
pbox.Canvas.StretchDraw(Rect(0,0,pbox.Width,pbox.height),newBmp);
end;
end.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

Binary file not shown.

View File

@ -0,0 +1,141 @@
library PowerPaint;
{ A Power Plugin DLL should simply have 3 Procedures.
1 - Init
GetVerbs will have a parameter of pointer.The application will call this
init procedure by passing its instance to it. This is a standart procedure
and should be implemeted same in all plugins.
2 - GetVerbs
GetVerbs will return a pchar including the name of the Verbs called from the
application. Note that these verb names will be taken by the application to
the menu, and each menu click will call the third exported procedure (DoVerb)
with the verb index which is in fact the index of the verb in the string list.
3 - DoVerb
DoVerb has one parameter. It stands for the index of the verb to be
called. In this procedure you will do your actions by using the procedure
and functions that are defined in the interface of the PCPlgLib unit that
you should include in the uses clause of this dll dpr.
}
uses
SysUtils,
Classes,
Windows,
Messages,
Graphics,
Controls,
Forms,
StdCtrls,
Buttons,
Grids,
Dialogs,
PCPlgLib in '../PCPlgLib.pas',
PaintForm in 'PaintForm.pas' {frmPaint};
procedure Init(Owner: Integer); stdcall;
begin
GetAdresses(Owner);
// Plugin specific intialization code
end;
Function GetVerbs:PChar;stdcall;
var res: pchar;
Begin
res := 'Open PowerPaint';
result := res;
End;
Procedure OpenPaint;
var i,f,cnt:Integer;
cName: String;
xBmp: Tbitmap;
fBmp: Integer;
frm: TFrmPaint;
fig,fHandle: Integer;
mStream: TmemoryStream;
buf:Pbyte;
xSize: Integer;
fName: String;
xByte: Byte;
Begin
xBmp := nil;
i := 0;
fig := 0;
fName := 'c:\ppbmp.bmp';
cnt := pcGetPropSelectedCount;
if cnt > 0 then begin
repeat
fHandle := pcGetSelectedHandle(i);
cName := String(pcFigureGetClass(fHandle));
if Copy(uppercase(cName) ,1,4) = 'TBMP' then
begin
fig := fHandle;
end;
inc(i);
until (fig > 0) or (i >= Cnt);
end;
buf := nil;
mStream := nil;
if fig > 0 then begin
pcFigureSaveBitmapToFile(fig,pchar(fName));
Sleep(250);
xBmp := Tbitmap.Create;
xBmp.LoadFromFile(fName);
buf := PByte(pcGetFigureCustomStream(fig,xSize));
if assigned(buf) and (xSize > 0) then begin
mStream := TMemoryStream.Create;
mStream.Write(buf^,xsize);
mStream.Position := 0;
//FreeMem(Buf,xSize);
end;
end else begin
end;
frm := TFrmPaint.Create(nil);
if frm.EditBitmap(xBmp,mStream) then
begin
xBmp.SaveToFile(fName);
if fig > 0 then begin
pcFigureLoadBitmapFromFile(fig,pchar(fName));
end else begin
fig := pcInsertBitmap(0,0,0,pchar(fName),0,1);
end;
if frm.Layers.Count > 1 then begin
mStream := TmemoryStream.Create;
frm.SaveToStream(mStream);
GetMem(buf,mStream.Size);
mStream.Position := 0;
mStream.Read(buf^,mStream.Size);
pcSetFigureCustomStream(fig,mStream.Size,buf^);
mStream.Free;
FreeMem(buf);
end else begin
buf := nil;
xByte := 0;
pcSetFigureCustomStream(fig,0,xByte);
end;
end;
frm.free;
End;
Procedure DoVerb(VerbIndex: integer);stdcall;
Begin
if VerbIndex = 0 then OpenPaint;
end;
exports
Init name 'Init',
GetVerbs name 'GetVerbs',
DoVerb name 'DoVerb';
begin
end.

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.1 KiB

View File

@ -0,0 +1,598 @@
unit imgFx;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls,Math;
procedure PicInvert(src: tbitmap; isTrans:Boolean);
procedure AddColorNoise(var clip: tbitmap; Amount: Integer;isTrans:Boolean);
procedure AntiAliasRect(clip: tbitmap; XOrigin, YOrigin,XFinal, YFinal: Integer;isTrans:Boolean);
procedure AntiAlias(clip: tbitmap;isTrans:Boolean);
procedure Contrast(var clip: tbitmap; Amount: Integer;isTrans:Boolean);
procedure Saturation(var clip: tbitmap; Amount: Integer;isTrans:Boolean);
procedure Lightness(var clip: tbitmap; Amount: Integer;isTrans:Boolean);
procedure Darkness(var src: tbitmap; Amount: integer;isTrans:Boolean);
procedure GrayScale(var clip: tbitmap;isTrans:Boolean);
procedure SmoothResize(var Src, Dst: TBitmap);
procedure SmoothRotate(var Src, Dst: TBitmap; cx, cy: Integer;Angle: Extended);
procedure SplitBlur(var clip: tbitmap; Amount: integer;isTrans:Boolean);
procedure GaussianBlur(var clip: tbitmap; Amount: integer;isTrans:Boolean);
procedure Mosaic(var Bm:TBitmap;size:Integer;isTrans:Boolean);
procedure Emboss(var Bmp:TBitmap;isTrans:Boolean);
procedure Solorize(src, dst: tbitmap; amount: integer;isTrans:Boolean);
procedure Posterize(src, dst: tbitmap; amount: integer;isTrans:Boolean);
implementation
type
pRGBArray = ^TRGBArray; // Use SysUtils.pByteArray for 8-bit color
TRGBArray = ARRAY[0..32767] OF TRGBTriple;
var
tC:trgbtriple;
pa:pRGBArray;
function eRgb(t:trgbtriple;p:pbytearray;index:Integer):Boolean;
begin
result := (t.rgbtBlue = p[index]) and (t.rgbtGreen = p[index+1]) and (t.rgbtRed = p[index+2]);
end;
procedure PicInvert(src: tbitmap;isTrans:Boolean);
var w,h,x,y:integer;
p:pbytearray;
begin
w:=src.width;
h:=src.height;
src.PixelFormat :=pf24bit;
pa := src.scanline[h-1];
tc := pa[0];
for y:=0 to h-1 do begin
p:=src.scanline[y];
for x:=0 to w-1 do begin
if (not isTrans) or (not eRGB(tc,p,x*3)) then
begin
p[x*3]:= not p[x*3];
p[x*3+1]:= not p[x*3+1];
p[x*3+2]:= not p[x*3+2];
end;
end;
end;
end;
function IntToByte(i:Integer):Byte;
begin
if i>255 then Result:=255
else if i<0 then Result:=0
else Result:=i;
end;
procedure AddColorNoise(var clip: tbitmap; Amount: Integer;isTrans:Boolean);
var
p0:pbytearray;
x,y,r,g,b: Integer;
begin
pa := clip.scanline[clip.Height-1];
tc := pa[0];
for y:=0 to clip.Height-1 do
begin
p0:=clip.ScanLine [y];
for x:=0 to clip.Width-1 do
begin
if (not isTrans) or (not eRGB(tc,p0,x*3)) then
begin
r:=p0[x*3]+(Random(Amount)-(Amount shr 1));
g:=p0[x*3+1]+(Random(Amount)-(Amount shr 1));
b:=p0[x*3+2]+(Random(Amount)-(Amount shr 1));
p0[x*3]:=IntToByte(r);
p0[x*3+1]:=IntToByte(g);
p0[x*3+2]:=IntToByte(b);
end;
end;
end;
end;
procedure AntiAliasRect(clip: tbitmap; XOrigin, YOrigin,
XFinal, YFinal: Integer;isTrans:Boolean);
var Memo,x,y: Integer; (* Composantes primaires des points environnants *)
p0,p1,p2:pbytearray;
begin
pa := clip.scanline[clip.Height-1];
tc := pa[0];
if XFinal<XOrigin then begin Memo:=XOrigin; XOrigin:=XFinal; XFinal:=Memo; end; (* Inversion des valeurs *)
if YFinal<YOrigin then begin Memo:=YOrigin; YOrigin:=YFinal; YFinal:=Memo; end; (* si diffrence ngative*)
XOrigin:=max(1,XOrigin);
YOrigin:=max(1,YOrigin);
XFinal:=min(clip.width-2,XFinal);
YFinal:=min(clip.height-2,YFinal);
clip.PixelFormat :=pf24bit;
for y:=YOrigin to YFinal do begin
p0:=clip.ScanLine [y-1];
p1:=clip.scanline [y];
p2:=clip.ScanLine [y+1];
for x:=XOrigin to XFinal do begin
if (not isTrans) or (not eRGB(tc,p1,x*3)) then
begin
p1[x*3]:=(p0[x*3]+p2[x*3]+p1[(x-1)*3]+p1[(x+1)*3])div 4;
p1[x*3+1]:=(p0[x*3+1]+p2[x*3+1]+p1[(x-1)*3+1]+p1[(x+1)*3+1])div 4;
p1[x*3+2]:=(p0[x*3+2]+p2[x*3+2]+p1[(x-1)*3+2]+p1[(x+1)*3+2])div 4;
end;
end;
end;
end;
procedure AntiAlias(clip: tbitmap;isTrans:Boolean);
begin
AntiAliasRect(clip,0,0,clip.width,clip.height,isTrans);
end;
procedure Contrast(var clip: tbitmap; Amount: Integer;isTrans:Boolean);
var
p0:pbytearray;
rg,gg,bg,r,g,b,x,y: Integer;
begin
pa := clip.scanline[clip.Height-1];
tc := pa[0];
for y:=0 to clip.Height-1 do
begin
p0:=clip.scanline[y];
for x:=0 to clip.Width-1 do
begin
if (not isTrans) or (not eRGB(tc,p0,x*3)) then
begin
r:=p0[x*3];
g:=p0[x*3+1];
b:=p0[x*3+2];
rg:=(Abs(127-r)*Amount)div 255;
gg:=(Abs(127-g)*Amount)div 255;
bg:=(Abs(127-b)*Amount)div 255;
if r>127 then r:=r+rg else r:=r-rg;
if g>127 then g:=g+gg else g:=g-gg;
if b>127 then b:=b+bg else b:=b-bg;
p0[x*3]:=IntToByte(r);
p0[x*3+1]:=IntToByte(g);
p0[x*3+2]:=IntToByte(b);
end;
end;
end;
end;
procedure GrayScale(var clip: tbitmap;isTrans:Boolean);
var
p0:pbytearray;
Gray,x,y: Integer;
begin
pa := clip.scanline[clip.Height-1];
tc := pa[0];
for y:=0 to clip.Height-1 do
begin
p0:=clip.scanline[y];
for x:=0 to clip.Width-1 do
begin
if (not isTrans) or (not eRGB(tc,p0,x*3)) then
begin
Gray:=Round(p0[x*3]*0.3+p0[x*3+1]*0.59+p0[x*3+2]*0.11);
p0[x*3]:=Gray;
p0[x*3+1]:=Gray;
p0[x*3+2]:=Gray;
end;
end;
end;
end;
procedure Lightness(var clip: tbitmap; Amount: Integer;isTrans:Boolean);
var
p0:pbytearray;
r,g,b,x,y: Integer;
begin
pa := clip.scanline[clip.Height-1];
tc := pa[0];
for y:=0 to clip.Height-1 do begin
p0:=clip.scanline[y];
for x:=0 to clip.Width-1 do
begin
if (not isTrans) or (not eRGB(tc,p0,x*3)) then
begin
r:=p0[x*3];
g:=p0[x*3+1];
b:=p0[x*3+2];
p0[x*3]:=IntToByte(r+((255-r)*Amount)div 255);
p0[x*3+1]:=IntToByte(g+((255-g)*Amount)div 255);
p0[x*3+2]:=IntToByte(b+((255-b)*Amount)div 255);
end;
end;
end;
end;
procedure Darkness(var src: tbitmap; Amount: integer;isTrans:Boolean);
var
p0:pbytearray;
r,g,b,x,y: Integer;
begin
src.pixelformat:=pf24bit;
pa := src.scanline[src.Height-1];
tc := pa[0];
for y:=0 to src.Height-1 do begin
p0:=src.scanline[y];
for x:=0 to src.Width-1 do
begin
if (not isTrans) or (not eRGB(tc,p0,x*3)) then
begin
r:=p0[x*3];
g:=p0[x*3+1];
b:=p0[x*3+2];
p0[x*3]:=IntToByte(r-((r)*Amount)div 255);
p0[x*3+1]:=IntToByte(g-((g)*Amount)div 255);
p0[x*3+2]:=IntToByte(b-((b)*Amount)div 255);
end;
end;
end;
end;
procedure Saturation(var clip: tbitmap; Amount: Integer;isTrans:Boolean);
var
p0:pbytearray;
Gray,r,g,b,x,y: Integer;
begin
pa := clip.scanline[clip.Height-1];
tc := pa[0];
for y:=0 to clip.Height-1 do begin
p0:=clip.scanline[y];
for x:=0 to clip.Width-1 do
begin
if (not isTrans) or (not eRGB(tc,p0,x*3)) then
begin
r:=p0[x*3];
g:=p0[x*3+1];
b:=p0[x*3+2];
Gray:=(r+g+b)div 3;
p0[x*3]:=IntToByte(Gray+(((r-Gray)*Amount)div 255));
p0[x*3+1]:=IntToByte(Gray+(((g-Gray)*Amount)div 255));
p0[x*3+2]:=IntToByte(Gray+(((b-Gray)*Amount)div 255));
end;
end;
end;
end;
procedure SmoothResize(var Src, Dst: TBitmap);
var
x,y,xP,yP,
yP2,xP2: Integer;
Read,Read2: PByteArray;
t,z,z2,iz2: Integer;
pc:PBytearray;
w1,w2,w3,w4: Integer;
Col1r,col1g,col1b,Col2r,col2g,col2b: byte;
begin
xP2:=((src.Width-1)shl 15)div Dst.Width;
yP2:=((src.Height-1)shl 15)div Dst.Height;
yP:=0;
for y:=0 to Dst.Height-1 do
begin
xP:=0;
Read:=src.ScanLine[yP shr 15];
if yP shr 16<src.Height-1 then
Read2:=src.ScanLine [yP shr 15+1]
else
Read2:=src.ScanLine [yP shr 15];
pc:=Dst.scanline[y];
z2:=yP and $7FFF;
iz2:=$8000-z2;
for x:=0 to Dst.Width-1 do
begin
t:=xP shr 15;
Col1r:=Read[t*3];
Col1g:=Read[t*3+1];
Col1b:=Read[t*3+2];
Col2r:=Read2[t*3];
Col2g:=Read2[t*3+1];
Col2b:=Read2[t*3+2];
z:=xP and $7FFF;
w2:=(z*iz2)shr 15;
w1:=iz2-w2;
w4:=(z*z2)shr 15;
w3:=z2-w4;
pc[x*3+2]:=
(Col1b*w1+Read[(t+1)*3+2]*w2+
Col2b*w3+Read2[(t+1)*3+2]*w4)shr 15;
pc[x*3+1]:=
(Col1g*w1+Read[(t+1)*3+1]*w2+
Col2g*w3+Read2[(t+1)*3+1]*w4)shr 15;
pc[x*3]:=
(Col1r*w1+Read2[(t+1)*3]*w2+
Col2r*w3+Read2[(t+1)*3]*w4)shr 15;
Inc(xP,xP2);
end;
Inc(yP,yP2);
end;
end;
function TrimInt(i, Min, Max: Integer): Integer;
begin
if i>Max then Result:=Max
else if i<Min then Result:=Min
else Result:=i;
end;
procedure SmoothRotate(var Src, Dst: TBitmap; cx, cy: Integer;
Angle: Extended);
type
TFColor = record b,g,r:Byte end;
var
Top,
Bottom,
Left,
Right,
eww,nsw,
fx,fy,
wx,wy: Extended;
cAngle,
sAngle: Double;
xDiff,
yDiff,
ifx,ify,
px,py,
ix,iy,
x,y: Integer;
nw,ne,
sw,se: TFColor;
P1,P2,P3:Pbytearray;
begin
Angle:=angle;
Angle:=-Angle*Pi/180;
sAngle:=Sin(Angle);
cAngle:=Cos(Angle);
xDiff:=(Dst.Width-Src.Width)div 2;
yDiff:=(Dst.Height-Src.Height)div 2;
for y:=0 to Dst.Height-1 do
begin
P3:=Dst.scanline[y];
py:=2*(y-cy)+1;
for x:=0 to Dst.Width-1 do
begin
px:=2*(x-cx)+1;
fx:=(((px*cAngle-py*sAngle)-1)/ 2+cx)-xDiff;
fy:=(((px*sAngle+py*cAngle)-1)/ 2+cy)-yDiff;
ifx:=Round(fx);
ify:=Round(fy);
if(ifx>-1)and(ifx<Src.Width)and(ify>-1)and(ify<Src.Height)then
begin
eww:=fx-ifx;
nsw:=fy-ify;
iy:=TrimInt(ify+1,0,Src.Height-1);
ix:=TrimInt(ifx+1,0,Src.Width-1);
P1:=Src.scanline[ify];
P2:=Src.scanline[iy];
nw.r:=P1[ifx*3];
nw.g:=P1[ifx*3+1];
nw.b:=P1[ifx*3+2];
ne.r:=P1[ix*3];
ne.g:=P1[ix*3+1];
ne.b:=P1[ix*3+2];
sw.r:=P2[ifx*3];
sw.g:=P2[ifx*3+1];
sw.b:=P2[ifx*3+2];
se.r:=P2[ix*3];
se.g:=P2[ix*3+1];
se.b:=P2[ix*3+2];
Top:=nw.b+eww*(ne.b-nw.b);
Bottom:=sw.b+eww*(se.b-sw.b);
P3[x*3+2]:=IntToByte(Round(Top+nsw*(Bottom-Top)));
Top:=nw.g+eww*(ne.g-nw.g);
Bottom:=sw.g+eww*(se.g-sw.g);
P3[x*3+1]:=IntToByte(Round(Top+nsw*(Bottom-Top)));
Top:=nw.r+eww*(ne.r-nw.r);
Bottom:=sw.r+eww*(se.r-sw.r);
P3[x*3]:=IntToByte(Round(Top+nsw*(Bottom-Top)));
end;
end;
end;
end;
procedure SplitBlur(var clip: tbitmap; Amount: integer;isTrans:Boolean);
var
p0,p1,p2:pbytearray;
cx,x,y: Integer;
Buf: array[0..3,0..2]of byte;
begin
if Amount=0 then Exit;
pa := clip.scanline[clip.Height-1];
tc := pa[0];
for y:=0 to clip.Height-1 do
begin
p0:=clip.scanline[y];
if y-Amount<0 then p1:=clip.scanline[y]
else {y-Amount>0} p1:=clip.ScanLine[y-Amount];
if y+Amount<clip.Height then p2:=clip.ScanLine[y+Amount]
else {y+Amount>=Height} p2:=clip.ScanLine[clip.Height-y];
for x:=0 to clip.Width-1 do
begin
if (not isTrans) or (not eRGB(tc,p0,x*3)) then
begin
if x-Amount<0 then cx:=x
else {x-Amount>0} cx:=x-Amount;
Buf[0,0]:=p1[cx*3];
Buf[0,1]:=p1[cx*3+1];
Buf[0,2]:=p1[cx*3+2];
Buf[1,0]:=p2[cx*3];
Buf[1,1]:=p2[cx*3+1];
Buf[1,2]:=p2[cx*3+2];
if x+Amount<clip.Width then cx:=x+Amount
else {x+Amount>=Width} cx:=clip.Width-x;
Buf[2,0]:=p1[cx*3];
Buf[2,1]:=p1[cx*3+1];
Buf[2,2]:=p1[cx*3+2];
Buf[3,0]:=p2[cx*3];
Buf[3,1]:=p2[cx*3+1];
Buf[3,2]:=p2[cx*3+2];
p0[x*3]:=(Buf[0,0]+Buf[1,0]+Buf[2,0]+Buf[3,0])shr 2;
p0[x*3+1]:=(Buf[0,1]+Buf[1,1]+Buf[2,1]+Buf[3,1])shr 2;
p0[x*3+2]:=(Buf[0,2]+Buf[1,2]+Buf[2,2]+Buf[3,2])shr 2;
end;
end;
end;
end;
procedure GaussianBlur(var clip: tbitmap; Amount: integer;isTrans:Boolean);
var
i: Integer;
clp: Tbitmap;
begin
clp := TBitmap.Create;
clp.Width := Clip.Width +1;
clp.Height := Clip.Height+1;
clp.PixelFormat := pf24bit;
clp.Canvas.StretchDraw(Rect(0,0,clp.Width,clp.Height),clip);
for i:=Amount downto 0 do
SplitBlur(clp,1,isTrans);
clip.Canvas.Draw(0,0,clp);
end;
procedure Mosaic(var Bm:TBitmap;size:Integer;isTrans:Boolean);
var
x,y,i,j:integer;
p1,p2:pbytearray;
r,g,b:byte;
begin
y:=0;
repeat
p1:=bm.scanline[y];
x:=0;
repeat
j:=1;
repeat
p2:=bm.scanline[y];
x:=0;
repeat
r:=p1[x*3];
g:=p1[x*3+1];
b:=p1[x*3+2];
i:=1;
repeat
p2[x*3]:=r;
p2[x*3+1]:=g;
p2[x*3+2]:=b;
inc(x);
inc(i);
until (x>=bm.width) or (i>size);
until x>=bm.width;
inc(j);
inc(y);
until (y>=bm.height) or (j>size);
until (y>=bm.height) or (x>=bm.width);
until y>=bm.height;
end;
procedure Emboss(var Bmp:TBitmap;isTrans:Boolean);
var
x,y: Integer;
p1,p2: Pbytearray;
begin
pa := Bmp.scanline[Bmp.Height-1];
tc := pa[0];
for y:=0 to Bmp.Height-2 do
begin
p1:=bmp.scanline[y];
p2:=bmp.scanline[y+1];
for x:=0 to Bmp.Width-4 do
begin
if (not isTrans) or (not eRGB(tc,p1,x*3)) then
begin
p1[x*3]:=(p1[x*3]+(p2[(x+3)*3] xor $FF))shr 1;
p1[x*3+1]:=(p1[x*3+1]+(p2[(x+3)*3+1] xor $FF))shr 1;
p1[x*3+2]:=(p1[x*3+2]+(p2[(x+3)*3+2] xor $FF))shr 1;
end;
end;
end;
end;
procedure Solorize(src, dst: tbitmap; amount: integer;isTrans:Boolean);
var w,h,x,y:integer;
ps,pd:pbytearray;
c:integer;
begin
pa := src.scanline[src.Height-1];
tc := pa[0];
w:=src.width;
h:=src.height;
src.PixelFormat :=pf24bit;
dst.PixelFormat :=pf24bit;
for y:=0 to h-1 do begin
ps:=src.scanline[y];
pd:=dst.scanline[y];
for x:=0 to w-1 do begin
c:=(ps[x*3]+ps[x*3+1]+ps[x*3+2]) div 3;
if ((not isTrans) or (not eRGB(tc,ps,x*3))) and (c>amount) then
begin
pd[x*3]:= 255-ps[x*3];
pd[x*3+1]:=255-ps[x*3+1];
pd[x*3+2]:=255-ps[x*3+2];
end
else begin
pd[x*3]:=ps[x*3];
pd[x*3+1]:=ps[x*3+1];
pd[x*3+2]:=ps[x*3+2];
end;
end;
end;
end;
procedure Posterize(src, dst: tbitmap; amount: integer;isTrans:Boolean);
var w,h,x,y:integer;
ps,pd:pbytearray;
c:integer;
begin
pa := src.scanline[src.Height-1];
tc := pa[0];
w:=src.width;
h:=src.height;
src.PixelFormat :=pf24bit;
dst.PixelFormat :=pf24bit;
for y:=0 to h-1 do begin
ps:=src.scanline[y];
pd:=dst.scanline[y];
for x:=0 to w-1 do begin
if ((not isTrans) or (not eRGB(tc,ps,x*3))) then
begin
pd[x*3]:= round(ps[x*3]/amount)*amount;
pd[x*3+1]:=round(ps[x*3+1]/amount)*amount;
pd[x*3+2]:=round(ps[x*3+2]/amount)*amount;
end else begin
pd[x*3]:= ps[x*3];
pd[x*3+1]:=ps[x*3+1];
pd[x*3+2]:=ps[x*3+1];
end;
end;
end;
end;
end.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,9 @@
door1
door2
door3
door4
door5
door6
door7
door8
extinguisher

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,8 @@
Cow
Donkey
Dove
Lion
PartyRabbit
Rabbit
Tiger
Turtle

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Some files were not shown because too many files have changed in this diff Show More