急急急急急急急急急急！那位有图片/图像处理控件？？？(300分)

  • 主题发起人 主题发起人 oqm
  • 开始时间 开始时间
O

oqm

Unregistered / Unconfirmed
GUEST, unregistred user!
小弟急需一个图像处理控件，要求能调整色彩、明暗、锐度、饱和度等，并且能够进行长宽不同比例的裁剪，最好还能做各种模板
 
帮顶
 
http://g32.org
G32 – a modular graphics library for Delphi, Kylix and C++ Builder (under construction)
Graphics32 – a fast graphics library for Delphi

应该能解决你的所有问题并且提供控件源代码还有例程
 
to bubble:
我下了下来，不能运行，说是ntdll.dll出错
另外，我看他的sample不能调rgb(颜色)，也没有裁剪功能
。能否帮我整理一下？
 
下了下来不能运行，
要是能做成ocx就好了。
那位大虾有这样的控件？？？？？？

急急急急急急急急急急急
如果ok，我再加200分！！！
 
ImageEn v2.1.2 For D3-7,delphi盒子可以下载，用过不错！
 
to cnzhw007:
在哪里可以下载，地址是什么？能贴出来吗？或者发一份给小弟可以吗？
 
我这有些资料,你可参看一下的
改变图象的对比度、亮度、饱和度
宋体 // Bitmap.ScanLine[X] 可以获取图像象素的内存地址,24Bits的Bitmap的每一象
// 素是以三原色RGB的次序存放的,改变RGB的值就可调节Bitmap的色彩.
// R, G, B: -255~255
procedure RGB(var Bmp: TBitmap
R, G, B: Integer)

var
X, Y: Integer

I: Byte

ColorTable: array[0..255] of TRGBColor

pRGB: PRGBColor

begin
for I := 0 to 255 do
begin
ColorTable.R := Byte(I + R)

ColorTable.G := Byte(I + G)

ColorTable.B := Byte(I + B)

end


for Y := 0 to Bmp.Height - 1 do
begin
pRGB := Bmp.ScanLine[Y]

for X := 0 to Bmp.Width - 1 do
begin
pRGB.R := ColorTable[pRGB.R].R

pRGB.G := ColorTable[pRGB.G].G

pRGB.B := ColorTable[pRGB.B].B

end

Inc(pRGB)

end

end


// 改变图像的亮度,也只需调用RGB(Bmp, X, X, X)改变三原色.
// 调节Bitmap的对比度
// 应用公式: 新颜色值 = (旧颜色值 - 128) * 系数 + 128
procedure Contrast(var Bmp: TBitmap
Amount: Integer)

// Amount: -255~255
var
X, Y: Integer

I: Byte

ColorTable: array[0..255] of TRGBColor

pRGB: PRGBColor

begin
for I := 0 to 126 do
begin
Y := (Abs(128 - I) * Amount) div 256

ColorTable.r := GetRValue(Byte(I - Y))

ColorTable.g := GetGValue(Byte(I - Y))

ColorTable.b := GetBValue(Byte(I - Y))

end

for I := 127 to 255 do
begin
Y := (Abs(128 - I) * Amount) div 256

ColorTable.r := GetRValue(Byte(I + Y))

ColorTable.g := GetGValue(Byte(I + Y))

ColorTable.b := GetBValue(Byte(I + Y))

end

for Y := 0 to Bmp.Height - 1 do
begin
pRGB := Bmp.ScanLine[Y]

for X := 0 to Bmp.Width - 1 do
begin
pRGB.R := ColorTable[pRGB.R].R

pRGB.G := ColorTable[pRGB.G].G

pRGB.B := ColorTable[pRGB.B].B

Inc(pRGB)

end

end

end


// 改变饱和度
procedure Saturation(var Bmp: TBitmap
Amount: Integer)
// Amount: 0~510
var
Grays: array[0..767] of Integer

Alpha: array[0..255] of Word

Gray, X, Y: Integer

pRGB: PRGBColor

I: Byte

begin
for I := 0 to 255 do Alpha := (I * Amount) shr 8

x := 0

for I := 0 to 255 do
begin
Gray := I - Alpha

Grays[X] := Gray
Inc(X)

Grays[X] := Gray
Inc(X)

Grays[X] := Gray
Inc(X)

end

for Y := 0 to Bmp.Height - 1 do
begin
pRGB := Bmp.ScanLine[Y]

for X := 0 to Bmp.Width - 1 do
begin
Gray := Grays[pRGB.R + pRGB.G + pRGB.B]

pRGB.R := Byte(Gray + Alpha[pRGB.R])

pRGB.G := Byte(Gray + Alpha[pRGB.G])

pRGB.B := Byte(Gray + Alpha[pRGB.B])

Inc(pRGB)

end

end

end

暗淡或者灰度一个图片：
function NewColor(ACanvas: TCanvas
clr: TColor
Value: integer): TColor;
var
r, g, b: integer;

begin
if Value > 100 then Value := 100;
clr := ColorToRGB(clr);
r := Clr and $000000FF;
g := (Clr and $0000FF00) shr 8;
b := (Clr and $00FF0000) shr 16;

r := r + Round((255 - r) * (value / 100));
g := g + Round((255 - g) * (value / 100));
b := b + Round((255 - b) * (value / 100));

Result := Windows.GetNearestColor(ACanvas.Handle, RGB(r, g, b));
end;

procedure DimBitmap(ABitmap: TBitmap
Value: integer);
var
x, y: integer;
LastColor1, LastColor2, Color: TColor;
begin
if Value > 100 then Value := 100;
LastColor1 := -1;
LastColor2 := -1;

for y := 0 to ABitmap.Height - 1 do
for x := 0 to ABitmap.Width - 1 do
begin
Color := ABitmap.Canvas.Pixels[x, y];
if Color = LastColor1 then
ABitmap.Canvas.Pixels[x, y] := LastColor2
else
begin
LastColor2 := NewColor(ABitmap.Canvas, Color, Value);
ABitmap.Canvas.Pixels[x, y] := LastColor2;
LastColor1 := Color;
end;
end;
end;

function GrayColor(ACanvas: TCanvas
clr: TColor
Value: integer): TColor;
var
r, g, b, avg: integer;

begin
if Value > 100 then Value := 100;
clr := ColorToRGB(clr);
r := Clr and $000000FF;
g := (Clr and $0000FF00) shr 8;
b := (Clr and $00FF0000) shr 16;

Avg := (r + g + b) div 3;
Avg := Avg + Value;

if Avg > 240 then Avg := 240;

Result := Windows.GetNearestColor(ACanvas.Handle, RGB(Avg, avg, avg));
end;

procedure GrayBitmap(ABitmap: TBitmap
Value: integer);
var
x, y: integer;
LastColor1, LastColor2, Color: TColor;
begin
LastColor1 := 0;
LastColor2 := 0;

for y := 0 to ABitmap.Height do
for x := 0 to ABitmap.Width do
begin
Color := ABitmap.Canvas.Pixels[x, y];
if Color = LastColor1 then
ABitmap.Canvas.Pixels[x, y] := LastColor2
else
begin
LastColor2 := GrayColor(ABitmap.Canvas, Color, Value);
ABitmap.Canvas.Pixels[x, y] := LastColor2;
LastColor1 := Color;
end;
end;
end;

Window API 里面有这些东东。
可以打开 Delphi 5 的 Windows SDK 帮助，然后查找
COLORADJUSTMENT
调整亮度：需要同时增加或减少像素点的R，G，B值，增加或减少的R，G，B值应该相等！比如均增加
或减少10；
调整对比度：首先设定一个阀值，通常是128；然后判断像素点的R，G，B值，凡是大于128的，
增加一个值，小于128的，减少一个值！
有很多控件的，如fxtool（http://go1.163.com/~easyvc/dl/fxgold5.zip）
http://my.szptt.net.cn/pb/tools/fxtools/fxcrack.zip（破解文件）
或者XpressPE（http://www.vckbase.com/ocx/ocx_image/XpressPE.EXE）
简单的调节,试试SetPalette API 吧
我找回以前的程序，试了一下，仅仅对于有调色板的图像，例如256色图像
才能用Window API处理。若对于16位或24位真彩色图像只能自己处理。
建议先识别图像的颜色深度，然后再处理。
不要使用TBitmap的Pixel属性，应使用ScanLine。若不是使用TBitmap，
也是类似，要直接获得象素的内存指针来操作。
处理方法就如【卷起千堆雪tyn】所说的那样。

给你段代码参考一下吧：
procedure TForm1.Button1Click(Sender: TObject);
var
x,y,i: integer;
BitMap : TBitMap;
ptr : PByteArray;
begin
BitMap := TBitMap.Create;
try
BitMap.LoadFromFile('lanmannt.bmp');
BitMap.PixelFormat := pf24bit;
for i := 0 to 255 do begin
for y := 0 to BitMap.Height - 1 do begin
ptr := BitMap.ScanLine[y];
for x := 0 to ((BitMap.Width * 3) - 1) do
if ptr[x] > 0 then ptr[x] := (ptr[x] - 1);
end;
Image1.Canvas.Draw(0,0,BitMap);
Application.ProcessMessages;
end;
finally
BitMap.free;
end;
end;

色彩的灰度转化
function RgbToGray(RGBColor : TColor) : TColor

var
Gray : byte

begin
Gray := Round((0.30 * GetRValue(RGBColor)) +
(0.59 * GetGValue(RGBColor)) +
(0.11 * GetBValue(RGBColor )))

Result := RGB(Gray, Gray, Gray)

end


procedure TForm1.FormCreate(Sender: TObject)

begin
Shape1.Brush.Color := RGB(255, 64, 64)

Shape2.Brush.Color := RgbToGray(Shape1.Brush.Color)

end;
 
地址是http://www.delphibox.com/article.asp?articleid=752
 
imageEn很好用的。
http://www.2ccc.com/article.asp?articleid=752
 
leadtools可以实现，功能强大
 
您必须登录或注册才可回复。

Similar threads

J
各位高手，关于左右声道的问题！急！急！急！ 是DSPack这个控件 (100分)
回复
14
查看
306
jeven
J
惟
关于图像处理的一个问题？（分不够可再加）急！(200分)
回复
5
查看
173
惟一
惟
B
急！！！在线等。ImageEn控件组有没有调节图片为透明的功能？有的话该如何设置？(100分)
回复
6
查看
341
billjohn1999
B
L
ｄｅｌｐｈｉ中的ｉｎｄｙ控件的ｗａｉｔｆｏｒ　（急急急急急急）(200分)
回复
9
查看
192
lianrchina
L
T
十万火急！！！请各位靓哥靓姐靓们帮我找一下进销存、物资管理方面所用到的图标！先谢谢了！(100分)
回复
7
查看
207
tyagain
T
后退
顶部