论坛html颜色,HTML颜色转为Delphi的颜色；(10分)

以前些过这样一个东东,贴出来

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls,xProcs, ExtCtrls, TFlatEditUnit, TFlatButtonUnit;

type

TForm1 = class(TForm)

Label4: TLabel;

Label5: TLabel;

Bevel1: TBevel;

Button1: TFlatButton;

Edit5: TFlatEdit;

Edit1: TFlatEdit;

Edit2: TFlatEdit;

Edit3: TFlatEdit;

Edit4: TFlatEdit;

Edit6: TFlatEdit;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

FlatButton1: TFlatButton;

procedure Button1Click(Sender: TObject);

procedure Edit5Exit(Sender: TObject);

procedure Edit5KeyPress(Sender: TObject; var Key: Char);

procedure Edit1KeyPress(Sender: TObject; var Key: Char);

procedure Edit2KeyPress(Sender: TObject; var Key: Char);

procedure Edit3KeyPress(Sender: TObject; var Key: Char);

procedure Edit5Enter(Sender: TObject);

procedure EditEnter(Sender: TObject);

procedure EditExit(Sender: TObject);

procedure EditMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure FlatButton1Click(Sender: TObject);

private

{ Private declarations }

function isHex(S : string) : Integer;

function HtmlValueToRGB : Boolean;

function HexToInt(sDecmail : string) : Integer;

public

{ Public declarations }

end;

function iPow(const Value, iExp : Integer) : Int64;

var

Form1: TForm1;

implementation

{$R *.dfm}

function iPow(const Value, iExp : Integer) : Int64;

var

i :Integer;

begin

Result := 1;

for i:=0 to iExp -1 do

begin

Result := Result * Value;

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

iRgb : Integer;

iR,iG,iB : Integer;

begin

ir := HexToInt(trim(edit1.Text));

ig := HexToInt(trim(edit2.Text));

ib := HexToInt(trim(edit3.Text));

irgb := rgb(ir,ig,ib);

edit4.Text := IntToStr(irgb);

edit6.Text := Format('$%x',[irgb]);

Label4.Color := irgb;

end;

function TForm1.HexToInt(sDecmail: string): Integer;

const cHEX =16;

var

iLen : Integer;

I : Integer;

aPow : Integer;

a,b : Integer;

ch : char;

begin

Result := 0;

ilen := Length(sdecmail);

sDecmail := lowercase(sDecmail);

aPow := ilen;

for i:=1 to iLen do

begin

ch := sDecmail;

case ch of

'1','2','3','4','5','6','7','8','9','0' : a := ord(ch) - 48;

'a','b','c','d','e','f' : a:= ord(ch) - ord('a') + 10;

end;//case

b := iPow(chex,aPow -1);

Result := Result + a * b;

Dec(aPow);

end;

end;

procedure TForm1.Edit5Exit(Sender: TObject);

begin

if not Self.HtmlValueToRGB then Exit;

end;

function TForm1.HtmlValueToRGB: Boolean;

var

I : Integer;

S : string;

begin

S := lowercase(trim(edit5.Text));

i := isHex(s);

if i <> 0 then

begin

ShowMessage('第' + IntToStr(i) + '个字符是非法字符');

Result := False;

edit5.SetFocus;

Exit;

end;

//不足六位补足六位

if Length(s) <6 then

begin

for i:= 1 to 6 - Length(s) do edit5.Text := '0' + edit5.Text;

end;

//把数值分配到三种颜色

edit1.Text := Copy(edit5.Text,1,2);

edit2.Text := Copy(edit5.Text,3,2);

edit3.Text := Copy(edit5.Text,5,2);

Result := True;

end;

procedure TForm1.Edit5KeyPress(Sender: TObject; var Key: Char);

begin

if ord(key) = VK_RETURNthen

begin

if not Self.HtmlValueToRGB then Exit;

Self.Button1.Click;

end;

end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);

begin

if ord(key) =VK_RETURN then edit2.SetFocus;

end;

procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);

begin

if ord(key) =VK_RETURN then edit3.SetFocus;

end;

procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char);

begin

if ord(key) =VK_RETURN then button1.Click;

end;

function TForm1.isHex(S: string): Integer;

begin

try

Result := 0;

for Result :=1 to Length(s) do

if not (s[Result] in ['0'..'9','a'..'f']) then

begin

Exit;

end;

Result := 0;

except

end;//except

end;

procedure TForm1.Edit5Enter(Sender: TObject);

begin

try

TFlatEdit(Sender).SelectAll;

if (trim(Edit5.Text) <> '') and (strtoint(trim(Edit5.Text)) = 0) then

edit5.Text := '';

except

on e:Exception do Exit;

end;

end;

procedure TForm1.EditEnter(Sender: TObject);

begin

TFlatEdit(Sender).SelectAll;

TFlatEdit(Sender).Font.Color := clBlack;

end;

procedure TForm1.EditExit(Sender: TObject);

begin

TFlatEdit(Sender).Font.Color := clWhite;

end;

procedure TForm1.EditMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

TFlatEdit(Sender).SelectAll;

end;

procedure TForm1.FlatButton1Click(Sender: TObject);

begin

Close;

end;

end.