具体代码如下:
{-------------------------------------------------------------------------------
过程名: TColorToRGB
作者: 不得闲
日期: 2009.01.19
返回值: 无
-------------------------------------------------------------------------------}
procedure TColorToRGB(const Color: TColor; var R, G, B: Integer);
var
C: Integer;
begin
C := ColorToRGB(Color);
R := C and $FF;
G := (C shr 8) and $FF;
B := (C shr 16) and $FF;
end;
{-------------------------------------------------------------------------------
过程名: GetNearColor
作者: 不得闲
日期: 2009.01.19
作用: 获得颜色值C的相近的颜色的值,NearValue指定为颜色差值
返回值: 无
-------------------------------------------------------------------------------}
function GetNearColor(C: TColor;NearValue: Integer): Integer;
var
R,G,B: Integer;
procedure CheckRGB(var Value: Integer);
begin
if Value < 0 then
Value := 0
else if Value > 255 then
Value := 255;
end;
begin
TColorToRGB(C,R,G,B);
if R = 0 then
begin
if G <> 0 then
begin
if B <> 0 then
begin
NearValue := NearValue div 2;
G := G + NearValue;
B := B + NearValue;
end
else
G := G + NearValue;
end
else
begin
if B <> 0 then
B := B+NearValue
else
begin
NearValue := NearValue div 3;
R := R + NearValue;
G := G + NearValue;
B := B + NearValue;
end;
end;
end
else
begin
if G <> 0 then
begin
if B <> 0 then
begin
NearValue := NearValue div 3;
R := R + NearValue;
G := G + NearValue;
B := B + NearValue;
end
else
begin
NearValue := NearValue div 2;
R := R + NearValue;
G := G + NearValue;
end;
end
else
begin
if B <> 0 then
begin
NearValue := NearValue div 2;
R := R + NearValue;
B := B + NearValue;
end
else
R := R + Nearvalue;
end;
end;
CheckRGB(R);
CheckRGB(G);
CheckRGB(B);
Result := RGB(R,G,B);
end;
比如要获得ClBlue的颜色距离为 80 的颜色值
GetNearColor(clBlue,-80);//颜色值比clBlue颜色要暗
GetNearColor(clBlue,80);//颜色值比clBlue颜色要亮
例如,画一个凸起的Button效果
var
R: TRect;
begin
SetRect(R,20,20,60,40);
Canvas.Brush.Color := clBtnFace;
Canvas.FillRect(R);
Frame3D(Canvas,R,GetNearColor(clBtnFace,100),GetNearColor(clBtnFace,-100),1);
end;
例如,画一个凹下的Button效果
var
R: TRect;
begin
SetRect(R,20,20,60,40);
Canvas.Brush.Color := clBtnFace;
Canvas.FillRect(R);
Frame3D(Canvas,R,GetNearColor(clBtnFace,-100),GetNearColor(clBtnFace,100),1);
end;
不知道还有没有什么更简单的方法
目前偶就想到这个方法,期待牛人贴出更好的代码