xgraphics.pas

我自己用的Delphi函数单元 具体说明见打包文件的HELP目录下面

unit xGraphics;

interface

uses Windows, Messages, SysUtils, Forms, Controls, Graphics, ShellAPI, Registry;

//------------------------------------------------------------------//
function ColorToRGBString(AColor: TColor): string;
function RGBStringToColor(RGBStr: string): TColor;

//------------------------------------------------------------------//
function LoadIconEx(const Filename: string; DefaultIcon: HICON = 0): HICON;
function CursorToIcon(const hc: HCURSOR; bDestroyCursor: Boolean = False): HICON;

//------------------------------------------------------------------//
function ColorNumToStr(Num: Integer): string;

implementation

uses xStrings, xFiles;

//------------------------------------------------------------------//
//将TColor转换为红绿蓝三原色字符串
function ColorToRGBString(AColor: TColor): string;
begin
  Result := Format('%d %d %d',[GetRValue(AColor), GetGValue(AColor), GetBValue(AColor)]);
end;

//------------------------------------------------------------------//
//将红绿蓝三原色字符串转换为TColor
function RGBStringToColor(RGBStr: string): TColor;
var
  I      : Integer;
  R, G, B: Byte;
begin
  Result := $00000000;
  RGBStr := Trim(RGBStr);
  if GetWords(RGBStr) <> 3 then Exit;
  
  // Red Value
  I := Pos(' ', RGBStr);
  R := StrToIntDef(Copy(RGBStr, 1, I - 1), 0);
  Delete(RGBStr, 1, I);
  
  // Green Value
  I := Pos(' ', RGBStr);
  G := StrToIntDef(Copy(RGBStr, 1, I - 1), 0);
  Delete(RGBStr, 1, I);
  
  // Blue
  B := StrToIntDef(RGBStr, 0);
  
  Result := RGB(R, G, B);
end;

//------------------------------------------------------------------//
//输入图标文件名或图标资源表示字符串，取回包含该图标的ICON。如：
//LoadIconEx('ultima.ico');
//LoadIconEx('e:\winnt\system32\shell32.dll,15');
function LoadIconEx(const Filename: string;  DefaultIcon: HICON = 0): HICON;
var
  IconNo: Integer;
  S, Ext: string; 
begin
  Result := 0;
  
  S := AnsiUpperCase(Filename);
  IconNo := TruncateTrailNumber(S);
  
  Ext := ExtractFileExt(S);
  if Ext = '.ICO' then
    Result := LoadImage(HInstance, PChar(S), IMAGE_ICON, 32, 32,  LR_LOADFROMFILE)
  else if ((Ext = '.ICL') or (Ext = '.DLL') or (Ext = '.EXE'))
    and (IconNo <> -1) then
    Result := ExtractIcon(HInstance, PChar(S), IconNo);

  // 如果失败, 就用 default icon 代替..
  if Result = 0 then
    Result := DefaultIcon;
  // 如果 default icon 也不存在, 就用程式本身 icon 代替
  if Result = 0 then
    Result := Application.ICON.Handle;
end;

//------------------------------------------------------------------//
// 将光标图案转为 HICON 以便显示
//CursorToIcon(LoadCursor(hInstance,IDC_WAIT),True);
function CursorToIcon(const hc: HCURSOR; bDestroyCursor: Boolean = False): HICON;
var
  ii: TIconInfo;
begin
  if hc <> 0 then
  begin
    GetIconInfo(hc, ii);
    Result := CreateIconIndirect(ii);
    if bDestroyCursor then DestroyCursor(hc);
  end else
    Result := 0;
end;

//------------------------------------------------------------------//
//指示颜色位数
function ColorNumToStr(Num: Integer): string;
begin
  case Num of
    16:       Result := '4位';
    256:      Result := '8位';
    32768:    Result := '15位';
    65536:    Result := '16位';
    16777216: Result := '24位';
  else Result := IntToStr(Num) + '颜色';
  end;
end;


end.