图象色彩过滤(50分)(50分)

  • 主题发起人 主题发起人 Lonyel
  • 开始时间 开始时间
L

Lonyel

Unregistered / Unconfirmed
GUEST, unregistred user!
Q: 我希望向IE的工具栏按纽一样,在 Hot 状态时显示彩色,Normal状态下
显示黑白图象,我知道用多副图可以作到,但我希望{{{只用一副彩色图}}}
用过滤的方法将彩色图转换为黑白图.

我第一天加入, 没多少分, 请不要嫌少.
 
procedure MonoBitmap(Bmp:TBitmap;R,G,B:integer);
var
i,j,col: longint;
begin
if Bmp.Empty then Exit;
for i := 0 to Bmp.Width do
for j := 0 to Bmp.Height do
begin
Col := Bmp.Canvas.Pixels[i,j];
Col := (GetRValue(Col)*R + GetGValue(Col)*G + GetBValue(Col)*B) div (R+G+B);
Bmp.Canvas.Pixels[i,j] := RGB(Col,Col,Col);
end;
end;
 
一个完整的控件(临时写的, 未测试过):
type
TMySpeedButton = class(SpeedButton)
private
FOrignBmp: TBitmap;
FMonoBmp: TBitmap;
procedure GlyphChange(Sender: TObject);
procedure MouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
procedure MouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
protected
procedure MonoBitmap(bmp: TBitmap; TransColor, MaskColor: TColor);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;

implimentation
procedure TMySpeedButton.GlyphChange(Sender: TObject);
var
n, l: Integer;
begin
if glyph.empty then
begin
NumGlyphs := 1;
exit;
end;
glyph.OnChange := nil;
l := glyph.width;
if glyph.width mod glyph.height = 0 then
begin
n := glyph.width div glyph.height;
if (n <1) or (n > 4) then n := 1;
l := glyph.width div n;
end;
forignbmp.width := l;
forignbmp.height := glyph.height;
forignbmp.canvas.draw(0,0,glyph);
fmonobmp.assign(forignbmp);
monobitmap(fmonobmp, fmonobmp.transparentcolor, clWhite);
glyph.assign(fmonobmp);
glyph.Onchange := GlyphChange;
NumGlyphs := 1;
invalidate;
end;

procedure TMySpeedButton.MouseEnter(var Msg: TMessage);
begin
inherited;
if enabled then
begin
glyph.onchange := nil;
glyph.assign(forignbmp);
glyph.onchange := glyphchange;
invalidate;
end;
end;

procedure TMySpeedButton.MouseLeave(var Msg: TMessage);
begin
inherited;
glyph.Onchange := nil;
glyph.assign(fmonobmp);
glyph.onchange := glyphChange;
invalidate;
end;

procedure MonoBitmap(bmp: TBitmap; TransColor, MaskColor: TColor);
var
i, j, c1, c2, r, g, b: LongInt;
p: Pchar;
pf:TPixelFormat;
begin
c1 := ColorToRGB(transcolor);
r := getrvalue(colortorgb(maskcolor));
g := getgvalue(colortorgb(maskcolor));
b := getbvalue(colortorgb(maskcolor));
bmp.PixelFormat := pf24bit;
for i := 0 to bmp.height-1 do
begin
p := bmp.scanline;
for j := 0 to bmp.width - 1 do
begin
if not comparemem(@c1, p, 3) then // not transparent color
begin
c2 := (byte(p^)*b + byte((p+1)^)*g + byte((p+2)^)*r) div (r+g+b);
c2 := byte(c2) + (c2 and $ff) shl 8 + (c2 and $ff) shl 16;
move(c2, p^, 3);
end;
p := p + 3;
end;
end;
bmp.pixelformat := pf;
end;

constructor TMySpeedButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fOrignBmp := TBitmap.Create;
forignbmp.pixelformat := pf24bit;
FMonoBmp := TBitmap.Create;
fmonobmp.pixelformat := pf24bit;
end;

destructor TMySpeedButton.Destroy;
begin
forignbmp.free;
fmonobmp.free;
inherited;
end;

end.
 
我测试过,好象不行.
 
monobitmap(fmonobmp, fmonobmp.transparentcolor, clWhite);
^^^^^^^ 改成其他颜色(clGray, clSilver,....)
 
Function Color2Bw(Incolor:Tcolor):Tcolor; //将一个色点变成黑白色
Var R,G,B,Y:Integer;// Y,Fr,Fg,Fb:Double;
Begin
Break_Color(Incolor,R,G,B);
Y:=(R+G+B) Div 3 ;
If Y>$Ff Then Y:=$Ff; If Y<0 Then Y:=0;
Color2Bw:=Y*$10000+Y*$100+Y;
End; //99.6.4

这个东西我调试过,绝对没有错误
 
> Y:=(R+G+B) Div 3 ;
Y = 0.30*R+0.59*G+0.11*B
一般是使用这个公式的,比RGB等权重的变换要更接近于人的感觉.
 
这个问题已经很长时间没有人参加讨论,为保持版面
整洁,节约网友时间,请提问者选择继续讨论或结束
问题。关于本版管理细则,请参见<a href="http://www.gislab.ecnu.edu.cn/delphibbs/DispQ.asp?LID=111927">这个</a>问题。如两天
内提问者没有响应,我将采取强制措施。请提问者尽
可能自己处理自己的问题。这是您的权利,也是您的
义务。

如有管理建议,请到<a href="http://www.gislab.ecnu.edu.cn/delphibbs/DispQ.asp?LID=111927">这里</a>提出。谢谢!
 
多人接受答案了。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
回复
0
查看
594
import
I
I
回复
0
查看
748
import
I
I
回复
0
查看
774
import
I
后退
顶部