您现在的位置:首页 >> 图形媒体 >> 图形媒体 >> 内容

获取某个颜色的相邻颜色值

时间:2011/9/3 15:03:27 点击:

  核心提示:具体代码如下:{------------------------------------------------------------------------------- 过程名: TColorT...

具体代码如下:

 

{-------------------------------------------------------------------------------
  过程名:    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;

 

 

不知道还有没有什么更简单的方法

目前偶就想到这个方法,期待牛人贴出更好的代码

作者:不得闲 日期: 20 来源:原创
共有评论 0相关评论
发表我的评论
  • 大名:
  • 内容:
本类推荐
  • 没有
本类固顶
  • 没有
  • 盒子文章(www.2ccc.com) © 2024 版权所有 All Rights Reserved.
  • 沪ICP备05001939号