uWpLabel.pas
上传用户:yjb1804
上传日期:2021-01-30
资源大小:3105k
文件大小:3k
源码类别:

Email服务器

开发平台:

Delphi

  1. unit uWpLabel;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,CommCtrl,
  5.   StdCtrls, ImgList,ExtCtrls;
  6. type
  7.   TGyphyAlign=(gaLeft,gaRigth);
  8.   TwpLable=class(TLabel)
  9.   private
  10.    FShowShortName:Boolean;
  11.    FFullName:string;
  12.    FGyphyAlign:TGyphyAlign;
  13.    procedure LoadImage(Img:TImage);
  14.   protected
  15.    procedure Paint; override;
  16.    procedure DoDrawImage(align:TGyphyAlign) ;
  17.   published
  18.    property ShowShortName:Boolean read FShowShortName write FShowShortName default True;
  19.    property GyphyAlign:TGyphyAlign read FGyphyAlign write FGyphyAlign default  gaLeft;
  20.   end;
  21.   procedure Register;
  22. implementation
  23. uses ShellAPI;
  24. procedure Register;
  25. begin
  26.   classes.RegisterComponents('HtmlEdit',[TwpLable]);
  27. end;
  28. { TwpLable }
  29. procedure TwpLable.DoDrawImage(align: TGyphyAlign);
  30. var
  31.   TextWidth:integer;
  32.   R,ImageRect:TRect;
  33.   Image:TImage;
  34. begin
  35.   Image:=TImage.Create(nil);
  36.   try
  37.     LoadImage(Image);
  38.     image.AutoSize:=true;
  39.     self.AutoSize:=false;
  40.     case Align of
  41.     gaLeft:
  42.       begin
  43.         R:=GetClientRect;
  44.         ImageRect.Left:=R.Left;
  45.         ImageRect.Top:=R.Top;
  46.         ImageRect.Right:=Image.ClientWidth;
  47.         ImageRect.Bottom:=R.Bottom;
  48.       end;
  49.     gaRigth:
  50.       begin
  51.         R:=GetClientRect;
  52.         ImageRect.Left:=R.Right;
  53.         ImageRect.Top:=R.Top;
  54.         ImageRect.Right:=R.Right+Image.ClientWidth;
  55.         ImageRect.Bottom:=R.Bottom;
  56.         SetBounds(R.Left,r.Top,r.Right+Image.ClientWidth,r.Bottom);
  57.        
  58.         //self.AutoSize:=true;
  59.       end;
  60.     else;
  61.     end;
  62.     Canvas.StretchDraw(ImageRect,Image.Picture.Graphic);
  63.   finally
  64.     Image.free;
  65.   end;
  66. end;
  67. procedure TwpLable.LoadImage(Img: TImage);
  68. var
  69.   ImageList:TImageList;
  70.   FileInfo: TSHFileInfo;
  71.   ImageListHandle:THandle;
  72. begin
  73.   // 小图标
  74.   ImageListHandle := SHGetFileInfo(PAnsiChar(FFullName), 0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  75.   ImageList:=TImageList.Create(nil);
  76.   try
  77.     ImageList_AddIcon(ImageList.Handle,ImageListHandle);
  78.     ImageList.GetIcon(0,Img.Picture.Icon);
  79.   finally
  80.     ImageList.free;
  81.   end;
  82. end;
  83. procedure TwpLable.Paint;
  84. const
  85.   Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  86.   WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
  87. var
  88.   Rect, CalcRect: TRect;
  89.   DrawStyle: Longint;
  90. begin
  91.   
  92.   FFullName:=Caption;
  93.   if ShowShortName then Caption:=ExtractFileName(Caption);
  94.   AutoSize:=true;
  95.   with Canvas do
  96.   begin
  97.     if not Transparent then
  98.     begin
  99.       Brush.Color := Self.Color;
  100.       Brush.Style := bsSolid;
  101.       FillRect(ClientRect);
  102.     end;
  103.     Brush.Style := bsClear;
  104.     Rect := ClientRect;
  105.     { DoDrawText takes care of BiDi alignments }
  106.     DrawStyle := DT_EXPANDTABS or WordWraps[WordWrap] or Alignments[Alignment];
  107.     { Calculate vertical layout }
  108.     if Layout <> tlTop then
  109.     begin
  110.       CalcRect := Rect;
  111.       DoDrawText(CalcRect, DrawStyle or DT_CALCRECT);
  112.       if Layout = tlBottom then OffsetRect(Rect, 0, Height - CalcRect.Bottom)
  113.       else OffsetRect(Rect, 0, (Height - CalcRect.Bottom) div 2);
  114.     end;
  115.     DoDrawText(Rect, DrawStyle);
  116.   end;
  117.   DoDrawImage(GyphyAlign);
  118. end;
  119. end.