Delphi控件源码

开发平台：
Delphi

Color.pas：源码内容
							unit Color;
interface
uses
  Classes,ComCtrls,Messages, Gauges,StdCtrls,StrUtils, ExtCtrls, SysUtils, Controls,
  Windows, Graphics, Math, Forms;
const
   MaxPixelCount = 65536;
type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..MaxPixelCount - 1] of TRGBTriple;
  
  function  ConvertBitmapToRTF(const Bitmap: TBitmap): string;
  procedure HSLtoRGB(H, S, L: Double; var R, G, B: Integer);
  procedure RGBtoHSL(R, G, B: Integer; var H, S, L: Double);
  procedure ConvertBitmapToColor(DestBitmap:TBitmap;DestColor:TColor);
  procedure ConvertBitmapToLighter(DestBitmap:TBitmap;FLightAdd:Integer);
implementation
{------------------------------------------------------------------------------}
{将Bitmap转换为RTF格式}
function ConvertBitmapToRTF(const Bitmap: TBitmap): string;
var
  bi, bb: string;
  bis, bbs: Cardinal;
  achar: string[2];
  Buffer: string;
  I: Integer;
type
  PWord = ^Word;
begin
  GetDIBSizes(Bitmap.Handle, bis, bbs);
  SetLength(bi, bis);
  SetLength(bb, bbs);
  GetDIB(Bitmap.Handle, Bitmap.Palette, PChar(bi)^, PChar(bb)^);
  SetLength(Buffer, (Length(bb) + Length(bi)) * 2);
  i := 1;
  for bis := 1 to Length(bi) do
  begin
    achar := IntToHex(Integer(bi[bis]), 2);
    PWord(@Buffer[i])^ := PWord(@achar[1])^;
    inc(i, 2);
  end;
  for bbs := 1 to Length(bb) do
  begin
    achar := IntToHex(Integer(bb[bbs]), 2);
    PWord(@Buffer[i])^ := PWord(@achar[1])^;
    inc(i, 2);
  end;
  Result := '{rtf1 {pictdibitmap ' + Buffer + ' }}';
end;
{------------------------------------------------------------------------------}
{改变Bitmap的亮度}
procedure ConvertBitmapToLighter(DestBitmap:TBitmap;FLightAdd:Integer);
var
   x, y, ScanlineBytes: integer;
   p: prgbtriplearray;
   RVALUE, bvalue, gvalue: integer;
   hVALUE, sVALUE, lVALUE: Double;
begin
  if not DestBitmap.Empty then
  begin
    DestBitmap.PixelFormat:=pf24bit;
    p := DestBitmap.ScanLine[0];
    ScanlineBytes := integer(DestBitmap.ScanLine[1]) - integer(DestBitmap.ScanLine[0]);
    for y := 0 to DestBitmap.Height - 1 do
    begin
      for x := 0 to DestBitmap.Width - 1 do
      begin
        RVALUE := p[x].rgbtRed;
        gVALUE := p[x].rgbtGreen;
        bVALUE := p[x].rgbtBlue;
        RGBtoHSL(RVALUE, gVALUE, bVALUE, hVALUE, sVALUE, lVALUE);
        lVALUE := min(100, lVALUE + FLightAdd);
        HSLtorgb(hVALUE, sVALUE, lVALUE, rVALUE, gVALUE, bVALUE);
        p[x].rgbtRed := RVALUE;
        p[x].rgbtGreen := gVALUE;
        p[x].rgbtBlue := bVALUE;
      end;
      inc(integer(p), ScanlineBytes);
    end;
  end;
end;
{------------------------------------------------------------------------------}
{改变Bitmap的色调}
procedure ConvertBitmapToColor(DestBitmap:TBitmap;DestColor:TColor);
var
   hexString:String;
   x, y, ScanlineBytes: integer;
   p: prgbtriplearray;
   RVALUE, bvalue, gvalue: integer;
   hVALUE, sVALUE, lVALUE: Double;
   hNewVALUE, sNewVALUE, lNewVALUE  : Double;
begin
  if not DestBitmap.Empty then
  begin
    hexString:=IntToHex(DestColor,6);
    RGBtoHSL(StrToInt('$'+Copy(hexString,5,2)), StrToInt('$'+Copy(hexString,3,2)), StrToInt('$'+Copy(hexString,1,2)), hNewVALUE, sNewVALUE, lNewVALUE);
    DestBitmap.PixelFormat:=pf24bit;
    p := DestBitmap.ScanLine[0];
    ScanlineBytes := integer(DestBitmap.ScanLine[1]) - integer(DestBitmap.ScanLine[0]);
    for y := 0 to DestBitmap.Height - 1 do
    begin
      for x := 0 to DestBitmap.Width - 1 do
      begin
        RVALUE := p[x].rgbtRed;
        gVALUE := p[x].rgbtGreen;
        bVALUE := p[x].rgbtBlue;
        RGBtoHSL(RVALUE, gVALUE, bVALUE, hVALUE, sVALUE, lVALUE);
        HSLtorgb(hNewVALUE, sNewVALUE, lVALUE, rVALUE, gVALUE, bVALUE);
        p[x].rgbtRed := RVALUE;
        p[x].rgbtGreen := gVALUE;
        p[x].rgbtBlue := bVALUE;
      end;
      inc(integer(p), ScanlineBytes);
    end;
  end;
end;
{------------------------------------------------------------------------------}
{hsl颜色空间到rgb空间的转换}
procedure HSLtoRGB(H, S, L: Double; var R, G, B: Integer);
var //类似于返回多个值的函数
   Sat, Lum: Double;
begin
   R := 0;
   G := 0;
   B := 0;
   if (H < 360) and (H >= 0) and (S <= 100) and (S >= 0) and (L <= 100) and (L
      >=
      0) then
      begin
         if H <= 60 then
            begin
               R := 255;
               G := Round((255 / 60) * H);
               B := 0;
            end
         else if H <= 120 then
            begin
               R := Round(255 - (255 / 60) * (H - 60));
               G := 255;
               B := 0;
            end
         else if H <= 180 then
            begin
               R := 0;
               G := 255;
               B := Round((255 / 60) * (H - 120));
            end
         else if H <= 240 then
            begin
               R := 0;
               G := Round(255 - (255 / 60) * (H - 180));
               B := 255;
            end
         else if H <= 300 then
            begin
               R := Round((255 / 60) * (H - 240));
               G := 0;
               B := 255;
            end
         else if H < 360 then
            begin
               R := 255;
               G := 0;
               B := Round(255 - (255 / 60) * (H - 300));
            end;
         Sat := Abs((S - 100) / 100);
         R := Round(R - ((R - 128) * Sat));
         G := Round(G - ((G - 128) * Sat));
         B := Round(B - ((B - 128) * Sat));
         Lum := (L - 50) / 50;
         if Lum > 0 then
            begin
               R := Round(R + ((255 - R) * Lum));
               G := Round(G + ((255 - G) * Lum));
               B := Round(B + ((255 - B) * Lum));
            end
         else if Lum < 0 then
            begin
               R := Round(R + (R * Lum));
               G := Round(G + (G * Lum));
               B := Round(B + (B * Lum));
            end;
      end;
end;
{------------------------------------------------------------------------------}
{RGB空间到HSL空间的转换}
procedure RGBtoHSL(R, G, B: Integer; var H, S, L: Double);
var
   Delta: Double;
   CMax, CMin: Double;
   Red, Green, Blue, Hue, Sat, Lum: Double;
begin
   Red := R / 255;
   Green := G / 255;
   Blue := B / 255;
   CMax := Max(Red, Max(Green, Blue));
   CMin := Min(Red, Min(Green, Blue));
   Lum := (CMax + CMin) / 2;
   if CMax = CMin then
      begin
         Sat := 0;
         Hue := 0;
      end
   else
      begin
         if Lum < 0.5 then
            Sat := (CMax - CMin) / (CMax + CMin)
         else
            Sat := (cmax - cmin) / (2 - cmax - cmin);
         delta := CMax - CMin;
         if Red = CMax then
            Hue := (Green - Blue) / Delta
         else if Green = CMax then
            Hue := 2 + (Blue - Red) / Delta
         else
            Hue := 4.0 + (Red - Green) / Delta;
         Hue := Hue / 6;
         if Hue < 0 then
            Hue := Hue + 1;
      end;
   H := (Hue * 360);
   S := (Sat * 100);
   L := (Lum * 100);
end;
end.
 

						