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

来源:互联网 发布:贝勒大学 知乎 编辑:程序博客网 时间:2024/03/29 16:52

 近日,在工作中由于需要使用Frame3D来画一个边框,需要带有立体感的,所以需要一个函数来获得填充颜色相近的两个颜色值,一个比填充色颜色浅的值,一个比填充色颜色深的值,于是写了一个函数来获得某个颜色的相邻颜色值。

具体代码如下:

DelphiCode:
{-------------------------------------------------------------------------------  过程名:    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指定为颜色差值  返回值:    TColor-------------------------------------------------------------------------------}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效果

DelphiCode:
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效果

DelphiCode:
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;

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

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

 

通过网友xiedewei的帮助,现将函数修改如下:

代码更加简洁,算法更加明了了,特此感谢xiedewei

 

 

DelphiCode:
{-------------------------------------------------------------------------------  过程名:    GetNearColor  作者:      不得闲  日期:      2009.01.19作用:    获得颜色值C的相近的颜色的值,OffsetValue指定为到当前颜色的偏移量,偏移值在 -127到127之间  返回值:    TColor-------------------------------------------------------------------------------}function GetNearColor(const Color: TColor;OffsetValue: Integer): TColor;var  R, G, B, dR, dG, dB: Byte;begin  if (OffsetValue > 127) or (OffsetValue < -127) then     raise Exception.Create('偏移值为-127-127之间')  else if OffsetValue = 0 then    Result := Color  else  begin    Result := ($80 + OffsetValue) shl 24 or (ColorToRGB(Color));    R := Byte(Result shr  0);    G := Byte(Result shr  8);    B := Byte(Result shr 16);    if OffsetValue > 0 then    begin      Inc(OffsetValue);      dR := not R;      dG := not G;      dB := not B;    end    else    begin      dR := R;      dG := G;      dB := B;    end;    R := R + (dR * OffsetValue) shr 7;    G := G + (dG * OffsetValue) shr 7;    B := B + (dB * OffsetValue) shr 7;    Result := RGB(R,G,B)  end;end;
原创粉丝点击