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.
end.