appcomm.pas

帮助编写程序

{*******************************************************}
{                                                       }
{                        公用函数                       }
{                                                       }
{     Copyright (C) 2000,2000 Justep Corporation        }
{                                                       }
{*******************************************************}
unit AppComm;

interface

uses
  classes, forms, Graphics, Sysutils, Math;

function GetSystemFont: TStrings;
function HtmlToColor(Color: string): TColor;
function ColorToHtml(Color: TColor): string;

implementation

function GetSystemFont: TStrings;
begin
  Result := TStringList.Create;
  with TScreen.Create(nil) do
  begin
    try
      Result.Assign(Fonts);
    finally
      Free;
    end;
  end;
end;

function HtmlToColor(Color: string): TColor;
var
  i, j, StrLength: Integer;
  lBit: Byte;
  Power: Longint;
begin
  Result := 0;
  try
    StrLength := Length(Color);
    for i := 2 to  StrLength do
    begin
      lBit := Ord(UpCase(Color[i]));
      case lBit of
        65 .. 70:  lBit := lBit - 55;
        48 .. 57:  lBit := lBit - 48;
        else       lBit := 0;
      end;
      Power := 1;
      for j := 3 to i do Power := Power * 16;
      Result := Result + lBit * Power;
    end;
  except
    Result := 0;
  end;
end;

function ColorToHtml(Color: TColor): string;
begin
  result:='#' + IntToHex(Color and $FF,2)+
          IntToHex(Color shr 8 and $FF,2)+
          IntToHex(Color shr 16 and $FF,2);
end;

end.