高分求助如何做一个简单的控件?

Question

就一个输入对话框也行.
要完整说明,每一步都要.
Delphih 能运行的源代码
谢谢

Answer 1

在一个Edit旁加一个按钮：
unit ButtonEdit;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons;type  TddgButtonEdit = class(TWinControl)
  private
    FSpeedButton: TSpeedButton;
    FEdit: TEdit;
  protected
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure SetText(Value: String);
    function  GetText: String;
    function GetFont: TFont;
    procedure SetFont(Value: TFont);
    function GetOnButtonClick: TNotifyEvent;
    procedure SetOnButtonClick(Value: TNotifyEvent);
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    property Text: String read GetText write SetText;
    property Font: TFont read GetFont write SetFont;
    property OnButtonClick: TNotifyEvent read GetOnButtonClick write SetOnButtonClick;
  end;  procedure Register;implementationprocedure TddgButtonEdit.WMSize(var Message: TWMSize);
begin
  inherited;
  FEdit.Width := Message.Width-FSpeedButton.Width;
  FSpeedButton.Left := FEdit.Width;
end;constructor TddgButtonEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEdit        := TEdit.Create(Self);
  FEdit.Parent := self;
  FEdit.Height := 21;  FSpeedButton := TSpeedButton.Create(Self);
  FSpeedButton.Left := FEdit.Width;
  FSpeedButton.Height := 19; // two less than TEdit's Height
  FSpeedButton.Width  := 19;
  FSpeedButton.Caption := '...';
  FSpeedButton.Parent := Self;  Width  := FEdit.Width+FSpeedButton.Width;
  Height := FEdit.Height;
end;destructor  TddgButtonEdit.Destroy;
begin
  FSpeedButton.Free;
  FEdit.Free;
  inherited Destroy;
end;function TddgButtonEdit.GetText: String;
begin
  Result := FEdit.Text;
end;procedure TddgButtonEdit.SetText(Value: String);
begin
  FEdit.Text := Value;
end;function TddgButtonEdit.GetFont: TFont;
begin
  Result := FEdit.Font;
end;procedure TddgButtonEdit.SetFont(Value: TFont);
begin
  if Assigned(FEdit.Font) then
    FEdit.Font.Assign(Value);
end;function TddgButtonEdit.GetOnButtonClick: TNotifyEvent;
begin
  Result := FSpeedButton.OnClick;
end;procedure TddgButtonEdit.SetOnButtonClick(Value: TNotifyEvent);
begin
  FSpeedButton.OnClick := Value;
end;procedure register;
begin
  RegisterComponents('MyComs',[TddgButtonEdit]);
end;
end;

Answer 2

unit SUIURLLabel;interface{$I SUIPack.inc}uses Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Graphics,
     ShellAPI;type
    TsuiURLLabel = class(TCustomLabel)
    private
        m_Cursor : TCursor;
        m_URL : TCaption;
        m_HoverColor : TColor;
        m_LinkColor : TColor;        procedure OnMouseLeave(var Msg : TMessage); message CM_MOUSELEAVE;
        procedure OnMouseEnter(var Msg : TMessage); message CM_MOUSEENTER;
        procedure SetLinkColor(const Value: TColor);
        procedure SetURL(value : TCaption);    protected
        procedure Click(); override;    public
        constructor Create(AOwner: TComponent); override;    published
        property Anchors;
        property BiDiMode;            
        property Caption;
        property AutoSize;
        property Color;
        property Enabled;
        property ShowHint;
        property Transparent;
        property Visible;
        property WordWrap;
        property PopupMenu;        property Cursor read m_Cursor;
        property URL : TCaption read m_URL write SetURL;
        property FontHoverColor : TColor read m_HoverColor write m_HoverColor;
        property FontLinkColor : TColor read m_LinkColor write SetLinkColor;
        property Font;        property OnClick;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;    end;implementationuses SUIPublic;
{ TsuiURLLabel }procedure TsuiURLLabel.Click;
begin
    if Trim(m_URL) <> '' then
        ShellExecute(0, 'open', PChar(m_URL), nil, nil, SW_SHOW);    inherited;
end;constructor TsuiURLLabel.Create(AOwner: TComponent);
begin
    inherited;    Font.Style := [fsUnderline];
    Font.Color := clBlue;
    inherited Cursor := crHandPoint;
    m_Cursor := inherited Cursor;
    AutoSize := true;
    m_HoverColor := clRed;
    m_LinkColor := clBlue;    Caption := 'Welcome to Sunisoft';
    URL := 'http://www.sunisoft.com';
end;procedure TsuiURLLabel.OnMouseEnter(var Msg: TMessage);
begin
    if csDesigning in ComponentState then
    begin
        Font.Color := clBlue;
        Exit;
    end;    Font.Color := m_HoverColor;
end;procedure TsuiURLLabel.OnMouseLeave(var Msg: TMessage);
begin
    Font.Color := m_LinkColor;
end;procedure TsuiURLLabel.SetLinkColor(const Value: TColor);
begin
    m_LinkColor := Value;    Font.Color := m_LinkColor;
end;procedure TsuiURLLabel.SetURL(value: TCaption);
begin
    if value <> m_URL then
        m_URL := value;
end;end.

Answer 3

显示文件版本的Label控件
unit UVersionLabel;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
  TVersionLabel = class(TCustomLabel)
    private
      { Private declarations }
      FFileName : TFileName;
      FMask, FVersionStr: String;
      function GetEnvPathString : String;
      function GetApplicationName( const AppName : String ): String;
    protected
      { Protected declarations }
      procedure SetFileName( Value : TFileName );
      procedure SetVersion;
      procedure SetMask(const Value: String);    public
      function GetVersionStr: string;
    published
    { Published declarations }
      constructor Create(AOwner : TComponent); override;
      property FileName : TFileName read FFileName write
        SetFileName;
      property Mask : String read FMask write SetMask stored True;
      property Transparent;
      property AutoSize;
      property LayOut;
      property Font;
      property Caption stored False;
      property ParentFont;
      property Visible;
      property OnClick;
      property OnDblClick;
      property OnMouseMove;
      property OnMouseDown;
      property OnMouseUp;    end;
      procedure Register;implementation//{$R UVERSIONLABEL.RES}这儿是控件的图标,没法给你贴出来,就只好屏蔽掉了//得到文件版本
function GetVersionString(FileName: string): string;
var
  VerInfoSize: DWORD;
  VerInfo: Pointer;
  VerValueSize: DWORD;
  Dummy: DWORD;
  VerValue: PVSFixedFileInfo;
begin
  Result := '';
  VerInfoSize := GetFileVersionInfoSize(PChar(FileName), Dummy);
  if VerInfoSize = 0 then Exit;
  GetMem(VerInfo, VerInfoSize);
  GetFileVersionInfo(PChar(FileName), 0, VerInfoSize, VerInfo);
  VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
  
  Result := IntToStr(VerValue^.dwFileVersionMS shr 16) + '.' +
            IntToStr(VerValue^.dwFileVersionMS and $FFFF) + '.' +
            IntToStr(VerValue^.dwFileVersionLS shr 16) + '.' +
            IntToStr(VerValue^.dwFileVersionLS and $FFFF);
  FreeMem(VerInfo);
end;procedure DecodeVersion( Version : String; var MajorVersion,
  MinorVersion, Release, Build : String);
  function GetValue( var Version : String ) : String;
  var
    Position: Integer;
  begin
    Position := Pos('.', Version);
    if Position <> 0 then
      result := Copy( Version, 1, Position - 1)
    else
      result := Version;
    if( result = EmptyStr ) then result := 'X';
    if Position <> 0 then
      Delete( Version, 1, Pos('.', Version ));
  end;
begin  MajorVersion := GetValue(Version);
  MinorVersion := GetValue(Version);
  Release := GetValue(Version);
  Build := GetValue(Version);
end;procedure Register;
begin
  RegisterComponents('Yan', [TVersionLabel]);
end;constructor TVersionLabel.Create(AOwner : TComponent);
resourcestring
  DefaultMask = 'Version: %s.%s (Release %s, Build %s)';
begin
  inherited Create(AOwner);
  Mask := DefaultMask;
end;procedure TVersionLabel.SetVersion;
var
  MajorVersion, MinorVersion, Release, Build : String;
  SVersion: string;
begin
  FVersionStr := GetVersionString( FFileName );
  DecodeVersion(FVersionStr, MajorVersion, MinorVersion, Release,
  Build );
  Caption := Format(FMask, [MajorVersion, MinorVersion, Release,
  Build] );
end;resourcestring
  DefaultPath = '.\;\';
function TVersionLabel.GetEnvPathString : String;
const
  MAX = 1024;
begin
  SetLength( result, MAX );
  if( GetEnvironmentVariable( PChar('Path'), PChar(result), MAX )
  = 0 ) then
  result := DefaultPath;
end;function TVersionLabel.GetApplicationName(const AppName : String) : String;
begin
  if( csDesigning in ComponentState ) then
    result := FileSearch( AppName, GetEnvPathString + DefaultPath)
  else
    result := Application.EXEName;
end;procedure TVersionLabel.SetFileName( Value : TFileName );
begin
  if( CompareText( FFileName, Value ) = 0 ) then exit;
  FFileName := GetApplicationName( Value );
  SetVersion;
end;procedure TVersionLabel.SetMask(const Value: String);
begin
  if( FMask = Value ) then exit;
  FMask := Value;
  SetVersion;
end;function TVersionLabel.GetVersionStr: string;
begin
  Result := FVersionStr;
end;end.

Answer 4

//3DLalel
unit mylabel;interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;type
  TtdLabel = class(TLabel)
  private
     { Private declarations }
    procedure Draw3dText(R: TRect);
  protected
     { Protected declarations }
    procedure paint; override;
  public
     { Public declarations }
  published
     { Published declarations }  end;
procedure Register;implementationprocedure Ttdlabel.Draw3dText(R: trect);
var
  CaptionStz        : array[0..255] of Char;
  TempRct           : TRect;
  Flags             : word;
begin
  with Canvas do  begin
    StrPCopy(CaptionStz, Caption);
    if WordWrap then
      Flags := dt_WordBreak;
    Font := Self.Font;
    TempRct := R;
    OffsetRect(TempRct, 1, 1);
    Font.Color := clBtnShadow;
    DrawText(Handle, CaptionStz, -1, TempRct, Flags);
    TempRct := R;
    OffsetRect(TempRct, -1, -1);
    Canvas.Font.Color := clBtnHighLight;
    DrawText(Handle, CaptionStz, -1, TempRct, Flags);
    Font.Color := Self.Font.Color;
    if not Enabled then
      Font.Color := clGrayText;
    DrawText(Handle, CaptionStz, -1, R, Flags);  end;
end;procedure ttdlabel.paint;
begin
  with Canvas do  begin
    if not Transparent then    begin
      Brush.Color := Self.Color;
      Brush.Style := bsSolid;
      FillRect(ClientRect);    end;
    Brush.Style := bsClear;
    Draw3DText(ClientRect);  end;
end;procedure Register;
begin
  RegisterComponents('Additional', [TtdLabel]);
end;
end.