本文共 3833 字,大约阅读时间需要 12 分钟。
近日,在工作中由于需要使用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; |
不知道还有没有什么更简单的方法
目前偶就想到这个方法,期待牛人贴出更好的代码
通过网友的帮助,现将函数修改如下:
代码更加简洁,算法更加明了了,特此感谢
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; |
转载地址:http://zrsti.baihongyu.com/