重复问题~~~~图象处理~~~~~~注意~~~~~~不用控件(300分)

  • 主题发起人 主题发起人 asdio
  • 开始时间 开始时间
A

asdio

Unregistered / Unconfirmed
GUEST, unregistred user!
我想实现 放大 缩小 调整色度 旋转
如果用控件 该是很容易的 但我想 通过这个 更好的了解delphi
我看了以前的贴子 大部分是用控件完成的
诸位大哥 麻烦点吧 当然 如果有说明更好
^_^
 
unit EffBmp;

{$P+,S-,W-,R-}
{$C PRELOAD}
{$I epver.inc}

interface

uses Graphics, Windows, GrUtils;

type

TFColor = record
b,g,r: Byte;
end;
PFColor=^TFColor;

TLine = array[0..0]of TFColor;
PLine = ^TLine;
TFilterProc = function(Value :Single) :Single;

type
TGradKind = (gdRight, gdLeft, gdTop, gdBottom, gdVCenter, gdHCenter);

TEffectBmp = class(TObject)
private
procedure SetPixel(x,y:Integer;Clr:Integer);
function GetPixel(x,y:Integer):Integer;
procedure SetLine(y:Integer;Line:Pointer);
function GetLine(y:Integer):Pointer;
public
Handle, Width, Height, Size: Integer;
Bits: Pointer;
BmpHeader: TBITMAPINFOHEADER;
BmpInfo: TBITMAPINFO;
constructor Create(cx,cy:Integer);
constructor CreateFromhWnd(hBmp:Integer);
constructor CreateCopy(hBmp:TEffectBmp);
destructor Destroy; override;
property Pixels[x,y:Integer]:Integer read GetPixel write SetPixel;
property ScanLines[y:Integer]:Pointer read GetLine write SetLine;
procedure GetScanLine(y:Integer;Line:Pointer);
procedure Flip; //Horizontal
procedure Flop; //Vertical
procedure Resize(Dst:TEffectBmp);
procedure Tile(Dst:TEffectBmp);
procedure Draw(hDC,x,y:Integer);
procedure Stretch(hDC,x,y,cx,cy:Integer);
procedure DrawRect(hDC,hx,hy,x,y,cx,cy:Integer);
procedure TileDraw(hDC,x,y,cx,cy:Integer);
procedure SplitBlur(Amount:Integer);
procedure Wave(XDIV,YDIV,RatioVal:Integer);
procedure AddColorNoise(Amount:Integer);
procedure AddMiddleColor(Color: TColor);
procedure AddMiddleColorInRect(Color: TColor; Rct: TRect);
procedure Blur(Amount: integer);
procedure MaskSplitBlur(Msk: TEffectBmp; Amount: Integer);
procedure MiddleBMP(EB:TEffectBmp);
procedure AddGradColor(Color: TColor; Kind: TGradKind);
procedure AddGradBMP(BMP: TEffectBMP; Kind: TGradKind);
procedure Morph(BMP: TEffectBMP; Kf: Double);
procedure MorphRect(BMP: TEffectBMP; Kf: Double; Rct: TRect;
StartX, StartY: Integer);
procedure CopyRect(BMP: TEffectBMP; Rct:TRect; StartX, StartY: Integer);
end;

PEfBmp = ^TEffectBmp;

implementation

uses Forms;

procedure TEffectBmp.SetPixel(x,y:Integer;Clr:Integer);
begin
CopyMemory(
Pointer(Integer(Bits)+(y*(Width mod 4))+(((y*Width)+x)*3)), @Clr,3);
end;

function TEffectBmp.GetPixel(x,y:Integer):Integer;
begin
CopyMemory(
@Result,
Pointer(Integer(Bits)+(y*(Width mod 4))+(((y*Width)+x)*3)), 3);
end;

procedure TEffectBmp.SetLine(y:Integer;Line:Pointer);
begin
CopyMemory(
Pointer(Integer(Bits)+(y*(Width mod 4))+((y*Width)*3)), Line, Width*3);
end;

function TEffectBmp.GetLine(y:Integer):Pointer;
begin
Result := Pointer(Integer(Bits)+(y*(Width mod 4))+((y*Width)*3));
end;

procedure TEffectBmp.GetScanLine(y:Integer;Line:Pointer);
begin
CopyMemory(
Line,
Pointer(Integer(Bits)+(y*(Width mod 4))+((y*Width)*3)), Width*3);
end;


constructor TEffectBmp.Create(cx,cy:Integer);
begin
Width := cx;
Height := cy;
Size := ((Width*3)+(Width mod 4))*Height;
with BmpHeader do
begin
biSize := SizeOf(BmpHeader);
biWidth := Width;
biHeight := -Height;
biPlanes := 1;
biBitCount := 24;
biCompression := BI_RGB;
end;
BmpInfo.bmiHeader := BmpHeader;
{$IFDEF VER90}
Handle := CreateDIBSection(0,
BmpInfo,
DIB_RGB_COLORS,
Bits,
nil,
0);
{$ELSE}
{$IFDEF VER93}
Handle := CreateDIBSection(0,
BmpInfo,
DIB_RGB_COLORS,
Bits,
nil,
0);
{$ELSE}
Handle := CreateDIBSection(0,
BmpInfo,
DIB_RGB_COLORS,
Bits,
0,
0);
{$ENDIF}
{$ENDIF}
end;

constructor TEffectBmp.CreateFromhWnd(hBmp:Integer);
var
Bmp: TBITMAP;
hDC: Integer;
begin
hDC := CreateDC('DISPLAY',nil,nil,nil);
SelectObject(hDC,hBmp);
GetObject(hBmp,SizeOf(Bmp),@Bmp);
Width := Bmp.bmWidth;
Height := Bmp.bmHeight;
Size := ((Width*3)+(Width mod 4))*Height;

with BmpHeader do
begin
biSize := SizeOf(BmpHeader);
biWidth := Width;
biHeight := -Height;
biPlanes := 1;
biBitCount := 24;
biCompression := BI_RGB;
end;
BmpInfo.bmiHeader := BmpHeader;
{$IFDEF VER90}
Handle := CreateDIBSection(0,
BmpInfo,
DIB_RGB_COLORS,
Bits,
nil,
0);
{$ELSE}
{$IFDEF VER93}
Handle := CreateDIBSection(0,
BmpInfo,
DIB_RGB_COLORS,
Bits,
nil,
0);
{$ELSE}
Handle := CreateDIBSection(0,
BmpInfo,
DIB_RGB_COLORS,
Bits,
0,
0);
{$ENDIF}
{$ENDIF}
GetDIBits(hDC,hBmp,0,Height,Bits,BmpInfo,DIB_RGB_COLORS);
DeleteDC(hDC);
end;

constructor TEffectBmp.CreateCopy(hBmp:TEffectBmp);
begin
BmpHeader := hBmp.BmpHeader;
BmpInfo := hBmp.BmpInfo;
Width := hBmp.Width;
Height := hBmp.Height;
Size := ((Width*3)+(Width mod 4))*Height;

{$IFDEF VER90}
Handle := CreateDIBSection(0,
BmpInfo,
DIB_RGB_COLORS,
Bits,
nil,
0);
{$ELSE}
{$IFDEF VER93}
Handle := CreateDIBSection(0,
BmpInfo,
DIB_RGB_COLORS,
Bits,
nil,
0);
{$ELSE}
Handle := CreateDIBSection(0,
BmpInfo,
DIB_RGB_COLORS,
Bits,
0,
0);
{$ENDIF}
{$ENDIF}
CopyMemory(Bits,hBmp.Bits,Size);
end;


procedure TEffectBmp.Stretch(hDC,x,y,cx,cy:Integer);
begin
StretchDiBits(hDC,
x,y,cx,cy,
0,0,Width,Height,
Bits,
BmpInfo,
DIB_RGB_COLORS,
SRCCOPY);
end;

procedure TEffectBmp.Flip;
var
Buff,
Line: PLine;
x,y: Integer;
begin
GetMem(Line,Width*3);
GetMem(Buff,Width*3);

for y:=0 to Height-1 do
begin
GetScanLine(y,Buff);
for x:=0 to Width-1 do
begin
Line^[(Width-1)-x].r:=Buff[x].r;
Line^[(Width-1)-x].g:=Buff[x].g;
Line^[(Width-1)-x].b:=Buff[x].b;
end;
ScanLines[y]:=Line;
end;
FreeMem(Buff,Width*3);
FreeMem(Line,Width*3);
end;

procedure TEffectBmp.Flop;
var
y,cy: Integer;
Buff,
Line: PLine;
begin
GetMem(Buff,Width*3);
GetMem(Line,Width*3);
if Odd(Height)then cy:=Height div 2 else cy:=Height div 2 - 1;
for y:=0 to cy do
begin
GetScanLine(y,Buff);
GetScanLine((Height-1)-y,Line);
ScanLines[y]:=Line;
ScanLines[(Height-1)-y]:=Buff;
end;
FreeMem(Buff,Width*3);
FreeMem(Line,Width*3);
end;

procedure TEffectBmp.Draw(hDC,x,y:Integer);
begin
SetDIBitsToDevice(hDC,
x,y,Width,Height,
0,0,0,Height,
Bits,
BmpInfo,
DIB_RGB_COLORS);
end;

procedure TEffectBmp.DrawRect(hDC,hx,hy,x,y,cx,cy:Integer);
begin
StretchDiBits(hDC,
hx,hy+cy-1,cx,-cy+1,
x,Height-y,cx,-cy+1,
Bits,
BmpInfo,
DIB_RGB_COLORS,
SRCCOPY);
end;

procedure TEffectBmp.TileDraw(hDC,x,y,cx,cy:Integer);
var
w, h, hBmp, DeskDC, MemDC: Integer;
begin
DeskDC := GetWindowDC(0);
MemDC := CreateCompatibleDC(DeskDC);
ReleaseDC(0,DeskDC);
hBmp := CreateCompatibleBitmap(DeskDC,cx,cy);
SelectObject(MemDC,hBmp);
Draw(MemDC,0,0);
w := Width;
h := Height;
while h < cy do
begin
BitBlt(MemDC,0,h,w,h*2,MemDC,0,0,SRCCOPY);
Inc(h,h);
end;
while w < cx do
begin
BitBlt(MemDC,w,0,w*2,cy,MemDC,0,0,SRCCOPY);
Inc(w,w);
end;
BitBlt(hDC,x,y,cx,cy,MemDC,0,0,SRCCOPY);
DeleteDC(MemDC);
DeleteObject(hBmp);
end;

procedure TEffectBmp.Tile(Dst:TEffectBmp);
var
LineOut, LineIn: PLine;
x, y, a, b: Integer;
begin
a := 0;
b := 0;
GetMem(LineIn,Width*3);
GetMem(LineOut,Dst.Width*3);

for y := 0 to Dst.Height-1 do
begin
GetScanLine(b,LineIn);
for x := 0 to Dst.Width-1 do
begin
LineOut^[x].r := LineIn^[a].r;
LineOut^[x].g := LineIn^[a].g;
LineOut^[x].b := LineIn^[a].b;
Inc(a);
if a = Width then a:=0;
end;
Dst.ScanLines[y]:=LineOut;
a := 0;
Inc(b);
if b = Height then b:=0;
end;
FreeMem(LineOut,Dst.Width*3);
FreeMem(LineIn,Width*3);
end;

procedure TEffectBmp.Resize(Dst:TEffectBmp);
var
xCount, yCount, x,y: Integer;
xScale, yScale: Double;
begin
xScale := (Dst.Width-1) / Width;
yScale := (Dst.Height-1) / Height;

for y := 0 to Height-1 do
for x := 0 to Width-1 do
begin
for yCount := 0 to Trunc(yScale) do
for xCount := 0 to Trunc(xScale) do
begin
Dst.Pixels[Trunc(xScale*x)+xCount,Trunc(yScale*y)+yCount]:=Pixels[x,y];
end;
end;
end;

procedure TEffectBmp.AddColorNoise(Amount:Integer);
var
x,y,r,g,b: Integer;
Line: PLine;
begin
GetMem(Line,Width*3);
for y := 0 to Height - 1 do
begin
GetScanLine(y,Line);
for x:=0 to Width-1 do
begin
r := Line^[x].r+(Random(Amount)-(Amount div 2));
g := Line^[x].g+(Random(Amount)-(Amount div 2));
b := Line^[x].b+(Random(Amount)-(Amount div 2));
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b:=0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
end;
ScanLines[y]:=Line;
end;
FreeMem(Line,Width*3);
end;


procedure TEffectBmp.AddMiddleColor(Color: TColor);
var
x,y,r,g,b: Integer;
Line: PLine;
_r, _g, _b: byte;
begin
GetMem(Line,Width*3);
_r := GetRValue(ColorToRGB(Color));
_g := GetGValue(ColorToRGB(Color));
_b := GetBValue(ColorToRGB(Color));
for y := 0 to Height-1 do
begin
GetScanLine(y,Line);
for x := 0 to Width-1 do
begin
r:=(Line^[x].r + _r) div 2;
g:=(Line^[x].g + _g) div 2;
b:=(Line^[x].b + _b) div 2;
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
end;
ScanLines[y] := Line;
end;
FreeMem(Line,Width*3);
end;

procedure TEffectBmp.AddMiddleColorInRect(Color: TColor; Rct: TRect);
var
x,y,r,g,b: Integer;
Line: PLine;
_r, _g, _b: byte;
begin
GetMem(Line,Width*3);
_r := GetRValue(ColorToRGB(Color));
_g := GetGValue(ColorToRGB(Color));
_b := GetBValue(ColorToRGB(Color));
for y := Rct.Top to Rct.Bottom do
begin
GetScanLine(y,Line);
for x := Rct.Left to Rct.Right do
begin
r:=(Line^[x].r + _r) div 2;
g:=(Line^[x].g + _g) div 2;
b:=(Line^[x].b + _b) div 2;
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
end;
ScanLines[y] := Line;
end;
FreeMem(Line,Width*3);
end;

procedure TEffectBmp.SplitBlur(Amount:Integer);
var
Lin, Lin1, Lin2: PLine;
cx, x,y: Integer;
Buf: array[0..3]of TFColor;
Tmp: TFColor;
begin
if Amount = 0 then Exit;
for y := 0 to Height-1 do
begin
Lin := ScanLines[y];

if y - Amount < 0
then
Lin1:=ScanLines[y]
else
Lin1:=ScanLines[y-Amount];

if y + Amount < Height
then
Lin2:=ScanLines[y+Amount]
else
Lin2:=ScanLines[Height-y];

for x := 0 to Width-1 do
begin
if x - Amount<0
then
cx := x
else
cx := x-Amount;

Buf[0] := Lin1^[cx];
Buf[1] := Lin2^[cx];
if x + Amount < Width
then
cx := x + Amount
else
cx:=Width-x;

Buf[2]:= Lin1^[cx];
Buf[3] := Lin2^[cx];
Tmp.r := (Buf[0].r+Buf[1].r+Buf[2].r+Buf[3].r)div 4;
Tmp.g := (Buf[0].g+Buf[1].g+Buf[2].g+Buf[3].g)div 4;
Tmp.b := (Buf[0].b+Buf[1].b+Buf[2].b+Buf[3].b)div 4;
Lin^[x] := Tmp;
end;
end;
end;

procedure TEffectBmp.Blur(Amount: integer);
function MiddleColor(color1, color2: TColor): TColor;
var
R, C1, C2: TFColor;
begin
move(color1, C1, 3);
move(color2, C2, 3);
R.r := (C1.r + C2.r) div 2;
R.g := (C1.g + C2.g) div 2;
R.b := (C1.b + C2.b) div 2;
result := 0;
move(R, result, 3);
end;
var
col, row: integer;
CelCol, CelRow: Integer;
NewColor: TColor;
begin
for row := 0 to Height - 1 do
begin
for Col := 0 to Width - 1 do
begin
NewColor := pixels[col,row];
for CelCol := -Amount to Amount do
For CelRow := -Amount to Amount do
begin
if (Col + CelCol < 0) or (Col + CelCol > Width-1) or
(Row + CelRow < 0) or (Row + CelRow > Height-1) then Continue;
NewColor := MiddleColor(NewColor,
Pixels[col + Celcol, row + Celrow]);
end;
pixels[col,row] := NewColor;
end;
end;
end;

procedure TEffectBmp.Wave(XDIV,YDIV,RatioVal:Integer);
var
Tmp: TEffectBmp;
i,j,
XSrc, YSrc: Integer;
begin
Tmp := TEffectBmp.CreateCopy(Self);
for i := 0 to Width-1 do
for j := 0 to Height-1 do
begin
if (YDiv=0)or(XDiv=0) then Exit;
XSrc := Round(i+RatioVal*Sin(j/YDiv));
YSrc := Round(j+RatioVal*Sin(i/XDiv));
if XSrc<0 then XSrc:=0 else if XSrc>=Tmp.Width then XSrc:=Tmp.Width-1;
if YSrc<0 then YSrc:=0 else if YSrc>=Tmp.Height then YSrc:=Tmp.Height-1;
Pixels[i,j] := Tmp.Pixels[XSrc,YSrc];
end;
Tmp.Free;
end;

procedure TEffectBmp.MaskSplitBlur(Msk: TEffectBmp; Amount:Integer);
var
Lin, Lin1, Lin2, MskLine: PLine;
cx, x,y: Integer;
Buf: array[0..3]of TFColor;
Tmp: TFColor;
begin
if Amount = 0 then Exit;
if (Width <> Msk.Width) or (Height > Msk.Height) then Exit;

for y := 0 to Height-1 do
begin
Lin := ScanLines[y];

if y - Amount < 0
then
Lin1:=ScanLines[y]
else
Lin1:=ScanLines[y-Amount];

if y + Amount < Height
then
Lin2:=ScanLines[y+Amount]
else
Lin2:=ScanLines[Height-y];

MskLine := Msk.ScanLines[y];

for x := 0 to Width-1 do
if (MskLine^[x].r = 0) and (MskLine^[x].g = 0) and (MskLine^[x].b = 0)
then
begin
if x - Amount<0
then
cx := x
else
cx := x-Amount;

Buf[0] := Lin1^[cx];
Buf[1] := Lin2^[cx];
if x + Amount < Width
then
cx := x + Amount
else
cx:=Width-x;

Buf[2]:= Lin1^[cx];
Buf[3] := Lin2^[cx];
Tmp.r := (Buf[0].r+Buf[1].r+Buf[2].r+Buf[3].r) div 4;
Tmp.g := (Buf[0].g+Buf[1].g+Buf[2].g+Buf[3].g) div 4;
Tmp.b := (Buf[0].b+Buf[1].b+Buf[2].b+Buf[3].b) div 4;
Lin^[x] := Tmp;
end;
end;
end;

procedure TEffectBmp.MiddleBMP(EB:TEffectBmp);
var
x,y: Integer;
R, G, B: Byte;
L1, L2: PLine;
begin
if (EB.Width <> Width) or (EB.Height <> Height) then Exit;
for y := 0 to Height - 1 do
begin
L1 := ScanLines[y];
L2 := EB.ScanLines[y];
for x := 0 to Width - 1 do
begin
R := (L1^[x].r + L2^[x].r) div 2;
G := (L1^[x].g + L2^[x].g) div 2;
B := (L1^[x].b + L2^[x].b) div 2;
L1^[x].r := R;
L1^[x].g := G;
L1^[x].b := B;
end;
end;
end;

procedure TEffectBmp.AddGradColor(Color: TColor; Kind: TGradKind);
var
x,y,r,g,b: Integer;
Line: PLine;
_r, _g, _b: byte;
kf: Double;
step: Double;
begin
GetMem(Line,Width*3);
_r := GetRValue(ColorToRGB(Color));
_g := GetGValue(ColorToRGB(Color));
_b := GetBValue(ColorToRGB(Color));
case Kind of
gdLeft:
begin
Step := 1 / (Width - 1);
for y := 0 to Height-1 do
begin
GetScanLine(y,Line);
kf := 0;
for x := 0 to Width - 1 do
begin
r := Round(Line^[x].r * kf + _r * (1 - kf));
g := Round(Line^[x].g * kf + _g * (1 - kf));
b := Round(Line^[x].b * kf + _b * (1 - kf));
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
kf := kf + Step;
end;
ScanLines[y] := Line;
end;
end;
gdRight:
begin
Step := 1 / (Width - 1);
for y := 0 to Height-1 do
begin
GetScanLine(y,Line);
kf := 0;
for x := Width - 1 downto 0 do
begin
r := Round(Line^[x].r * kf + _r * (1 - kf));
g := Round(Line^[x].g * kf + _g * (1 - kf));
b := Round(Line^[x].b * kf + _b * (1 - kf));
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
kf := kf + Step;
end;
ScanLines[y] := Line;
end;
end;
gdTop:
begin
Step := 1 / (Height - 1);
kf := 0;
for y := 0 to Height-1 do
begin
GetScanLine(y,Line);
for x := 0 to Width - 1 do
begin
r := Round(Line^[x].r * kf + _r * (1 - kf));
g := Round(Line^[x].g * kf + _g * (1 - kf));
b := Round(Line^[x].b * kf + _b * (1 - kf));
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
end;
ScanLines[y] := Line;
kf := kf + Step;
end;
end;

gdBottom:
begin
Step := 1 / (Height - 1);
kf := 0;
for y := Height - 1 downto 0 do
begin
GetScanLine(y,Line);
for x := 0 to Width - 1 do
begin
r := Round(Line^[x].r * kf + _r * (1 - kf));
g := Round(Line^[x].g * kf + _g * (1 - kf));
b := Round(Line^[x].b * kf + _b * (1 - kf));
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
end;
ScanLines[y] := Line;
kf := kf + Step;
end;
end;

gdHCenter:
begin
Step := 1 / ((Height - 1) div 2);
kf := 0;
for y := Height div 2 to height - 1 do
begin
GetScanLine(y,Line);
for x := 0 to Width - 1 do
begin
r := Round(Line^[x].r * kf + _r * (1 - kf));
g := Round(Line^[x].g * kf + _g * (1 - kf));
b := Round(Line^[x].b * kf + _b * (1 - kf));
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
end;
ScanLines[y] := Line;
kf := kf + Step;
end;
kf := 0;
for y := Height div 2 - 1 downto 0 do
begin
GetScanLine(y,Line);
for x := 0 to Width - 1 do
begin
r := Round(Line^[x].r * kf + _r * (1 - kf));
g := Round(Line^[x].g * kf + _g * (1 - kf));
b := Round(Line^[x].b * kf + _b * (1 - kf));
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
end;
ScanLines[y] := Line;
kf := kf + Step;
end;
end;

gdVCenter:
begin
Step := 1 / ((Width - 1) div 2);
for y := 0 to Height - 1 do
begin
GetScanLine(y,Line);
kf := 0;
for x := Width div 2 downto 0 do
begin
r := Round(Line^[x].r * kf + _r * (1 - kf));
g := Round(Line^[x].g * kf + _g * (1 - kf));
b := Round(Line^[x].b * kf + _b * (1 - kf));
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
kf := kf + Step;
end;
ScanLines[y] := Line;
end;

for y := 0 to Height - 1 do
begin
GetScanLine(y,Line);
kf := 0;
for x := Width div 2 + 1 to Width - 1 do
begin
r := Round(Line^[x].r * kf + _r * (1 - kf));
g := Round(Line^[x].g * kf + _g * (1 - kf));
b := Round(Line^[x].b * kf + _b * (1 - kf));
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
kf := kf + Step;
end;
ScanLines[y] := Line;
end;
end;
end;
FreeMem(Line, Width*3);
end;


procedure TEffectBmp.AddGradBMP(BMP: TEffectBMP; Kind: TGradKind);
var
x,y,r,g,b: Integer;
Line, L: PLine;
kf: Double;
step: Double;
begin
if (BMP.Width <> Width) or (BMP.Height <> Height) then Exit;
GetMem(Line,Width*3);
case Kind of
gdLeft:
begin
Step := 1 / (Width - 1);
for y := 0 to Height-1 do
begin
GetScanLine(y,Line);
L := BMP.ScanLines[y];
kf := 0;
for x := 0 to Width - 1 do
begin
r := Round(Line^[x].r * kf + L^[x].r * (1 - kf));
g := Round(Line^[x].g * kf + L^[x].g * (1 - kf));
b := Round(Line^[x].b * kf + L^[x].b * (1 - kf));
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
kf := kf + Step;
end;
ScanLines[y] := Line;
end;
end;
gdRight:
begin
Step := 1 / (Width - 1);
for y := 0 to Height-1 do
begin
GetScanLine(y,Line);
L := BMP.ScanLines[y];
kf := 0;
for x := Width - 1 downto 0 do
begin
r := Round(Line^[x].r * kf + L^[x].r * (1 - kf));
g := Round(Line^[x].g * kf + L^[x].g * (1 - kf));
b := Round(Line^[x].b * kf + L^[x].b * (1 - kf));
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
kf := kf + Step;
end;
ScanLines[y] := Line;
end;
end;
gdTop:
begin
Step := 1 / (Height - 1);
kf := 0;
for y := 0 to Height-1 do
begin
GetScanLine(y,Line);
L := BMP.ScanLines[y];
for x := 0 to Width - 1 do
begin
r := Round(Line^[x].r * kf + L^[x].r * (1 - kf));
g := Round(Line^[x].g * kf + L^[x].g * (1 - kf));
b := Round(Line^[x].b * kf + L^[x].b * (1 - kf));
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
end;
ScanLines[y] := Line;
kf := kf + Step;
end;
end;

gdBottom:
begin
Step := 1 / (Height - 1);
kf := 0;
for y := Height - 1 downto 0 do
begin
GetScanLine(y,Line);
L := BMP.ScanLines[y];
for x := 0 to Width - 1 do
begin
r := Round(Line^[x].r * kf + L^[x].r * (1 - kf));
g := Round(Line^[x].g * kf + L^[x].g * (1 - kf));
b := Round(Line^[x].b * kf + L^[x].b * (1 - kf));
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
end;
ScanLines[y] := Line;
kf := kf + Step;
end;
end;
gdHCenter:
begin
Step := 1 / ((Height - 1) div 2);
kf := 0;
for y := Height div 2 to height - 1 do
begin
GetScanLine(y,Line);
L := BMP.ScanLines[y];
for x := 0 to Width - 1 do
begin
r := Round(Line^[x].r * kf + L^[x].r * (1 - kf));
g := Round(Line^[x].g * kf + L^[x].g * (1 - kf));
b := Round(Line^[x].b * kf + L^[x].b * (1 - kf));
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
end;
ScanLines[y] := Line;
kf := kf + Step;
end;
kf := 0;
for y := Height div 2 - 1 downto 0 do
begin
GetScanLine(y,Line);
L := BMP.ScanLines[y];
for x := 0 to Width - 1 do
begin
r := Round(Line^[x].r * kf + L^[x].r * (1 - kf));
g := Round(Line^[x].g * kf + L^[x].g * (1 - kf));
b := Round(Line^[x].b * kf + L^[x].b * (1 - kf));
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
end;
ScanLines[y] := Line;
kf := kf + Step;
end;
end;
gdVCenter:
begin
Step := 1 / ((Width - 1) div 2);
for y := 0 to Height - 1 do
begin
GetScanLine(y,Line);
L := BMP.ScanLines[y];
kf := 0;
for x := Width div 2 downto 0 do
begin
r := Round(Line^[x].r * kf + L^[x].r * (1 - kf));
g := Round(Line^[x].g * kf + L^[x].g * (1 - kf));
b := Round(Line^[x].b * kf + L^[x].b * (1 - kf));
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
kf := kf + Step;
end;
ScanLines[y] := Line;
end;

for y := 0 to Height - 1 do
begin
GetScanLine(y,Line);
L := BMP.ScanLines[y];
kf := 0;
for x := Width div 2 + 1 to Width - 1 do
begin
r := Round(Line^[x].r * kf + L^[x].r * (1 - kf));
g := Round(Line^[x].g * kf + L^[x].g * (1 - kf));
b := Round(Line^[x].b * kf + L^[x].b * (1 - kf));
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
kf := kf + Step;
end;
ScanLines[y] := Line;
end;
end;
end;
FreeMem(Line,Width*3);
end;

procedure TEffectBmp.Morph(BMP: TEffectBMP; Kf: Double);
var
x,y,r,g,b: Integer;
Line, L: PLine;
begin
if (BMP.Width <> Width) or (BMP.Height <> Height) then Exit;
if kf < 0 then kf := 0;
if kf > 1 then kf := 1;
GetMem(Line,Width*3);
for y := 0 to Height-1 do
begin
GetScanLine(y,Line);
L := BMP.ScanLines[y];
for x := 0 to Width - 1 do
begin
r := Round(Line^[x].r * (1 - kf) + L^[x].r * kf);
g := Round(Line^[x].g * (1 - kf) + L^[x].g * kf);
b := Round(Line^[x].b * (1 - kf) + L^[x].b * kf);
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
end;
ScanLines[y] := Line;
end;
FreeMem(Line,Width*3);
end;

procedure TEffectBmp.MorphRect(BMP: TEffectBMP; Kf: Double;
Rct: TRect;
StartX, StartY: Integer);
var
x,y,x1,y1,r,g,b: Integer;
Line, L: PLine;
begin
if kf < 0 then kf := 0;
if kf > 1 then kf := 1;
GetMem(Line,Width*3);
y1 := StartY;
for y := Rct.Top to Rct.Bottom do
begin
GetScanLine(y,Line);
L := BMP.ScanLines[y1];
x1 := StartX;
for x := Rct.Left to Rct.Right do
begin
r := Round(Line^[x].r * (1 - kf) + L^[x1].r * kf);
g := Round(Line^[x].g * (1 - kf) + L^[x1].g * kf);
b := Round(Line^[x].b * (1 - kf) + L^[x1].b * kf);
if r > 255 then r := 255 else if r < 0 then r := 0;
if g > 255 then g := 255 else if g < 0 then g := 0;
if b > 255 then b := 255 else if b < 0 then b := 0;
Line^[x].r := r;
Line^[x].g := g;
Line^[x].b := b;
Inc(x1);
end;
ScanLines[y] := Line;
Inc(y1);
end;
FreeMem(Line,Width*3);
end;


procedure TEffectBmp.CopyRect(BMP: TEffectBMP; Rct: TRect;
StartX, StartY:Integer);
var
x,y,x1,y1: Integer;
Line, L: PLine;
begin
GetMem(Line,Width*3);
y1 := StartY;
if Rct.Right > Width - 1 then Rct.Right := Width - 1;
if Rct.Bottom > Height - 1 then Rct.Bottom := Height - 1;
for y := Rct.Top to Rct.Bottom do
begin
GetScanLine(y,Line);
L := BMP.ScanLines[y1];
x1 := StartX;
for x := Rct.Left to Rct.Right do
begin
Line^[x] := L^[x1];
Inc(x1);
end;
ScanLines[y] := Line;
Inc(y1);
end;
FreeMem(Line,Width*3);
end;



destructor TEffectBmp.Destroy;
begin
DeleteObject(Handle);
inherited;
end;
 
楼上的 可能我说的不太清楚 不好意思
编译一个程序 实现以上功能（弱点也无所谓，简单一些） 不用控件（因为我看不懂控件的源代码，只想知道实现的基本原理），。。。。。。。。。。
而不是把 控件 贴上
我的信箱是
asdio@163.com 有好的提议也行 随时关注 谢谢大家了
 
我写了个动动，里面有你需要的，发到你信箱里了，接收吧
 
楼上的兄弟,能不能也给我发一份,谢谢了
我的邮箱是amnimal@163.com
 
楼上的大哥 如果哪个只是你自己编的
我实在。。。。。。。汗。。。。
天哪 功能太强大了 而且是个应用程序
估计我要补习几个月delphi才行了 555555555555
有没有 简单点的 源码 呀 我只是个新手呀 。。
 
milkroad，能不能给我发一份你的源程序。
 
放大缩小用stretchblt啊，或者copyrect，stretchdraw，
帮助你有他们的用法和例子，色调的调整可以用scanline，改变每个象素点相应的分量，
旋转也用scanline，到这里看看http://www.efg2.com，那里有很多图像处理方面的资料
绝对经典，对提高水平很有好处
 
我看了过以前 斑竹 的帖子 也提到过这个网站 当时我就特别高兴的进去
非常郁闷的出来 ..............我的e文那够看那个呀
大哥 麻烦你摘抄一下吧 为了帮助新人 请您引用一次吧
不过不管怎么样 先谢谢你了
 
如果300不够的话 我可以在加
~~~~~~~~~ 帮帮我吧
 
和我联系，我尽力帮你！huazai@zju.edu.cn
 
那个控件不可安装 我用的是5.0呀
我最近看了你说的那个网站 看到了 旋转 有找到了放大
能帮我找找有关 色度调整方面的吗
不要太好的 效果一般就可以 源程序少点最好
谢谢了：）
 
huazai大虾,急需你的帮助, 发邮件给你了, 谢谢了:)
 
那个大哥贴出的代码不是TFastBmp的源代码吗？
为什么成了Eff...？？
 
板主结束吧
 
您必须登录或注册才可回复。

Similar threads

不
Delphi实现类似Android锁屏的密码锁控件 - 不得闲
回复
0
查看
992
不得闲
不
S
[教程]使用 ZAsyncInvoker 进行异步编程教程之二：ZAsyncInvoker 解决了什么问题
回复
0
查看
710
swish
S
不
Delphi的参数传递约定以及动态参数个数(转载笔记) - 不得闲
回复
0
查看
924
不得闲
不
不
关于SpeedButton中使用下划线快捷键不响应的问题 - 不得闲
回复
0
查看
689
不得闲
不
不
B编码以及BT种子文件分析 - 不得闲
回复
0
查看
1K
不得闲
不
后退
顶部