继续送分。(100分)

  • 主题发起人 主题发起人 yaojiaqing
  • 开始时间 开始时间
Y

yaojiaqing

Unregistered / Unconfirmed
GUEST, unregistred user!
背景为一图象,当鼠标到达某一节点时(比如一个小图象),如何改变
此节点的颜色(如变浅或变深),有无好的算法或控件,别告诉我用
用另一个小图象替换,这样太繁。(类似 速达2000 的效果)
 
不知道你要求的图象是什么格式
先读出它们的色彩来,然后使用下面的函数可以调整颜色深浅

你可以在Mousemove里将mouse限制在你图象的范围之内

const
blocksize=5;

var
colorBuffer:array[0..(2*blocksize+1)*(2*blocksize+1)] of TColor;
oldx,oldy:Integer;


function BrightenColor(BaseColor: TColor; Adjust : Integer): TColor;
begin
BaseColor := ColorToRGB(BaseColor);
Result := ERGB(GetRValue(BaseColor) + Adjust, GetGValue(BaseColor) + Adjust,
GetBValue(BaseColor) + Adjust);
end;

function DarkenColor(BaseColor: TColor; Adjust : Integer): TColor;
begin
Result := BrightenColor(BaseColor, -Adjust);
end;


function CorrectColor(C : Single) : Integer;
begin
Result := Round(C);
if Result > 255 then Result := 255;
if Result < 0 then Result := 0;
end;

function ERGB(R,G,B : Single) : TColor;
begin
Result := RGB(CorrectColor(R), CorrectColor(G), CorrectColor(B));
end;


procedure TMainForm.Form1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
c: TColor;
i,j:Integer;
idx:Integer;
cx,cy:Integer;
begin
//if (oldx<>-1) and (x <oldx+blocksize) and (x>oldx-blocksize) then
// exit;

if oldx<> -1 then
for i:=oldx-blocksize to oldx+blocksize do
for j:=oldy-blocksize to oldy+blocksize do
begin
idx:=(i-oldx+blocksize)*2*blocksize+(j-oldy+blocksize);
Canvas.Pixels[i,j]:=ColorBuffer[idx];
end;

for i:=x-blocksize to x+blocksize do
for j:=y-blocksize to y+blocksize do
begin
//p:=ScreenToClient(Point(i,j));
c:=Canvas.Pixels[i,j];
idx:=(i-x+blocksize)*2*blocksize+(j-y+blocksize);
colorBuffer[idx]:=c;
c:=BrightenColor(c,10);
Canvas.Pixels[i,j]:=c;
end;
oldx:=x;
oldy:=y;
end;

 
未测试过, 如有问题请告之:
两种方法:
1. 继承TImage生成自定义的TActiveImage
TActiveImage = class(TImage)
procedure CMMSENTER(var Msg: TMessage);message CM_MOUSEENTER;
procedure CMMSLEAVE(var Msg: TMessage);message CM_MOUSELEAVE;
end;

implementation

procedure TActiveImage.CMMSENTER(var Msg: TMessage);
var
bmp: TBitmap;
dc,maskDC: HDC;
oldbmp: HBITMAP;
i,j,k: integer;
p: PByteArray;
begin
inherited;
if (parent=nil) or not visible
or (csDesigning in ComponentState) then
exit;
bmp:=TBitmap.Create;
with bmp do
begin
PixelFormat:=pf24bit;
height:=self.height;
width:=self.width;
end;
DC:=GetDC(parent.handle);
maskDC:=CreateCompatibleDC(DC);
oldbmp:=SelectObject(maskDC, picture.Bitmap.MaskHandle);
BitBlt(bmp.Canvas.Handle, 0, 0, DC, left, top, SRCCOPY);
for i:=0 to bmp.height-1 do
begin
p:=bmp.Scanline;
j:=bmp.width shl 1 + bmp.width; // bmp.width*3
k:=0;
for k:=0 to j do
p[k]:=p[k] shl 1; // red=red*2, blue=blue*2, green=green*2
end;
TransparentStretchBlt(DC, left, top,
width, height, bmp.Canvas.Handle,
0, 0, width, height, maskDC, 0,0);
SelectObject(maskDC, oldbmp);
DeleteDC(maskDC);
ReleaseDC(parent.handle, DC);
bmp.Free;
end;

procedure TActiveImage.CMMSLEAVE(var: Msg: TMessage);
var
DC,maskDC: HDC;
oldbmp: HBITMAP;
begin
inherited;
if (parent=nil) or not visible
or (csDesigning in ComponentState) then
exit;
DC:=GetDC(Parent.Handle);
maskDC:=CreateCompatibleDC(DC);
oldbmp:=SelectObject(maskDC, picture.Bitmap.MaskHandle);
TransparentStretchBlt(DC, left, top,
width, height,
picture.Bitmap.Canvas.Handle,
0, 0, width, height,
maskDC, 0,0);
SelectObject(maskDC, oldbmp);
DeleteDC(maskDC);
ReleaseDC(parent.handle, DC);
end;

2. 在application.OnMessage中判断是否需要激活图象
procedure TForm1.OnApplicationMessage(Msg: TMsg;var handled: boolean);
begin
if (Msg.Wnd=image1) then
if (Msg.message=CM_MOUSEENTER) then
begin
......... (处理方法同上)
end
else if (Msg.message=CM_MOUSELEAVE) then
begin
...... (处理方法同上)
end;
end;
 
忘了说一句, 上例是针对透明效果的图象的
如果非透明那要简单多了, 不需要用mask. 直接输出修改效果之后的图象即可
 
回 Another eYes:您的方法(1)我试了,我只该了一句:
BitBlt(bmp.Canvas.Handle, 0, 0,width,heigth, DC, left, top, SRCCOPY);
就好用了。
jiangtao 您说的方法,我还没来的及试,有答案后我回通知的。
 
才发现没有给同志门加分,惭愧!
 
上次分怎么每加上?
 

Similar threads

S
回复
0
查看
1K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
900
SUNSTONE的Delphi笔记
S
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
后退
顶部