LRGB一个带亮度值的颜色

截图有一些颜色失真

 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    TrackBar1: TTrackBar;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormPaint(Sender: TObject);
    procedure Edit1TrackBar1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  LRGB = Cardinal;
  {含亮度的颜色,
  LRGB($80XXXXXX) = TColor($XXXXXX),
  LRGB($FFXXXXXX) = TColor($FFFFFF),
  LRGB($00XXXXXX) = TColor(0), }

var
  Form1: TForm1;


implementation

{$R *.dfm}
{$R WindowsXP.res}

function TLColor(Color: TColor; LValue: Byte = $80): LRGB;
begin
  Result := LValue shl 24 or ColorToRGB(Color);
end;

function LTColor(Color: LRGB): TColor;
var
  Delta: Integer;
  L, R, G, B, dR, dG, dB: Byte;
begin
  R := Byte(Color);
  G := Byte(Color shr  8);
  B := Byte(Color shr 16);
  L := Byte(Color shr 24);
  Delta := L - $80;
  if L > $80 then
  begin
    dR := not R;
    dG := not G;
    dB := not B;
  end
  else begin
    dR := R;
    dG := G;
    dB := B;
  end;
  Inc(R, (dR * Delta) shr 7);
  Inc(G, (dG * Delta) shr 7);
  Inc(B, (dB * Delta) shr 7);
  Result := R or (G shl 8) or (B shl 16);
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  T: TColor;
begin
  T := StrToIntDef(Edit1.Text, 0);
  Canvas.Brush.Color := T;
  Canvas.FillRect(Bounds(80, 50, 100, 100));
  Canvas.Brush.Color := LTColor(TLColor(T, TrackBar1.Position));
  Canvas.FillRect(Bounds(200, 50, 100, 100));
end;

procedure TForm1.Edit1TrackBar1Change(Sender: TObject);
begin
  Edit2.Text := '$'
    + IntToHex(TLColor(StrToIntDef(Edit1.Text, 0), TrackBar1.Position), 8);
  Repaint;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;
end;

end.