class_71702_image.pas

自己编写的在Delphi下进行图像开发的空间可以向

unit  Class_71702_image;

interface

uses
    SysUtils,   Classes,   StdCtrls,   Controls,   ExtCtrls,   Messages,   Windows;

type
    TTxtImage   =   class(TImage)
    private
      FImageLabel:TBoundLabel;
      FLabelPosition:TLabelPosition;
      FLabelSpacing:Integer;
      procedure   SetLabelPosition(const   Value:TLabelPosition);
      procedure   SetFLabelSpacing(const   Value:Integer);
    protected
      procedure   SetParent(AParent:TWinControl);override;
      procedure   Notification(AComponent:TComponent;Operation:TOperation);override;
      procedure   SetName(const   Value:TComponentName);override;
      procedure   CMVisiblechanged(var   Message:TMessage);
          message   CM_VISIBLECHANGED;
      procedure   CMEnabledchanged(var   Message:TMessage);
          message   CM_ENABLEDCHANGED;
      procedure   CMBidimodechanged(var   Message:TMessage);
          message   CM_BIDIMODECHANGED;
    public
      constructor   Create(AOwner:TComponent);   override;   //   构造函数
      procedure   SetBounds(ALeft,ATop,AWidth,AHeight:Integer);override;
      procedure   SetupInternalLabel;
    published
      property   Align;
      property   Anchors;
      property   AutoSize;
      property   Center;
      property   Constraints;
      property   DragCursor;
      property   DragKind;
      property   DragMode;
      property   Enabled;
      property   ImageLabel:TBoundLabel   read   FImageLabel;
      property   IncrementalDisplay;
      property   LabelPosition:TLabelPosition   read   FLabelPosition   write   SetLabelPosition;
      property   LabelSpacing:Integer   read   FLabelSpacing   write   SetFLabelSpacing;
      property   ParentShowHint;
      property   Picture;
      property   PopupMenu;
      property   Proportional;
      property   ShowHint;
      property   Stretch;
      property   Transparent;
      property   Visible;
      property   OnClick;
      property   OnContextPopup;
      property   OnDblClick;
      property   OnDragDrop;
      property   OnDragOver;
      property   OnEndDock;
      property   OnEndDrag;
      property   OnMouseDown;
      property   OnMouseMove;
      property   OnMouseUp;
      property   OnProgress;
      property   OnStartDock;
      property   OnStartDrag;
    end;

procedure   Register;

implementation

procedure   Register;
begin
  RegisterComponents('Additional',   [TTxtImage]);
end;   
    
{   TTxtImage   }
procedure   TTxtImage.CMBidimodechanged(var   Message:   TMessage);
begin
  inherited;
  FImageLabel.BiDiMode:=BiDiMode;
end;

procedure   TTxtImage.CMEnabledchanged(var   Message:   TMessage);
begin
  inherited;
  FImageLabel.Enabled:=Enabled;
end;

procedure   TTxtImage.CMVisiblechanged(var   Message:   TMessage);
begin
  inherited;
  FImageLabel.Visible:=Visible;
end;

constructor   TTxtImage.Create(AOwner:   TComponent);
begin
  inherited   Create(AOwner);//   首先调用父类的构造函数
  FLabelPosition:=lpBelow;
  FLabelSpacing:=3;
  SetupInternalLabel;
end;

procedure   TTxtImage.Notification(AComponent:   TComponent;
   Operation:   TOperation);
begin
  inherited   Notification(AComponent,Operation);
  if   (AComponent=FImageLabel)   and   (Operation=opRemove)   then
      FImageLabel:=nil;
end;

procedure   TTxtImage.SetBounds(ALeft,   ATop,   AWidth,   AHeight:   Integer);
begin
  inherited   SetBounds(ALeft,   ATop,   AWidth,   AHeight);
  SetLabelPosition(FLabelPosition);
end;

procedure   TTxtImage.SetFLabelSpacing(const   Value:   Integer);
begin
  FLabelSpacing:=Value;
  SetLabelPosition(FLabelPosition);
end;

procedure   TTxtImage.SetupInternalLabel;
begin
  if   Assigned(FImageLabel)   then   exit;
  FImageLabel:=TBoundLabel.Create(Self);
  FImageLabel.FreeNotification(Self);
//FImageLabel.FocusControl:=Self;
end;

procedure   TTxtImage.SetLabelPosition(const   Value:   TLabelPosition);
var   P:TPoint;
begin
  if   FImageLabel=nil   then   exit;
  FLabelPosition:=Value;
  case   Value   of
      lpAbove:   P:=Point(Left,Top-FImageLabel.Height-FLabelSpacing);
      lpBelow:   P:=Point(Left,Top+Height+FLabelSpacing);
      lpLeft:     P:=Point(Left-FImageLabel.Width-FLabelSpacing,
                                  Top+((Height-FImageLabel.Height)   div   2));
      lpRight:   P:=Point(Left+Width+FlabelSpacing,
                                  Top+((Height-FImageLabel.Height)   div   2));
  end;
  FImageLabel.SetBounds(P.x,P.y,FImageLabel.Width,FImageLabel.Height);
end;

procedure   TTxtImage.SetName(const   Value:   TComponentName);
begin
  if   (csDesigning   in   ComponentState)   and   (FImageLabel.GetTextLen=0)   or
      (CompareText(FImageLabel.Caption,Name)=0)   then
      FImageLabel.Caption:=Value;
  inherited   SetName(Value);
end;

procedure   TTxtImage.SetParent(AParent:   TWinControl);
begin
  inherited   SetParent(AParent);
  if   FImageLabel=nil   then   exit;
  FImageLabel.Parent:=AParent;
  FImageLabel.Visible:=True;
end;

end.