如何开发VCL控件，要源码！

Question

如何开发VCL控件，要源码！试后结帐！

Answer 1

unit CustomBevel;interfaceuses
  Windows, SysUtils, Classes, Controls, ExtCtrls, Graphics, Messages;type
  TCustomBevel = class(TBevel)
  private
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Caption;
    property Font;
    property OnClick;
  end;implementation{ TCustomBevel }procedure TCustomBevel.CMMouseEnter(var Message: TMessage);
begin
  if Not (csDesigning in ComponentState) then begin
    inherited;
    if Style = bsRaised then
      Style := bsLowered
    else
      Style := bsRaised;
    Invalidate;
  end;
end;procedure TCustomBevel.CMMouseLeave(var Message: TMessage);
begin
  if Not (csDesigning in ComponentState) then begin
    inherited;
    if Style = bsRaised then
      Style := bsLowered
    else
      Style := bsRaised;
    Invalidate;
  end;
end;procedure TCustomBevel.CMTextChanged(var Message: TMessage);
begin
  Invalidate
end;constructor TCustomBevel.Create(AOwner: TComponent);
begin
  inherited;
  Width := 100;
  Shape := bsTopLine;
  Canvas.Brush.Color := clBtnFace;
end;procedure TCustomBevel.Paint;
const
  XorColor = $00FFD8CE;
var
  Color1, Color2: TColor;
  Temp: TColor;
  ARect: TRect;
  I: Integer;  procedure BevelRect(const R: TRect);
  begin
    with Canvas do
    begin
      Pen.Color := Color1;
      PolyLine([Point(R.Left, R.Bottom), Point(R.Left, R.Top),
        Point(R.Right, R.Top)]);
      Pen.Color := Color2;
      PolyLine([Point(R.Right, R.Top), Point(R.Right, R.Bottom),
        Point(R.Left, R.Bottom)]);
    end;
  end;  procedure BevelLine(C: TColor; X1, Y1, X2, Y2: Integer);
  begin
    with Canvas do
    begin
      Pen.Color := C;
      MoveTo(X1, Y1);
      LineTo(X2, Y2);
    end;
  end;begin
  with Canvas do
  begin
    if (csDesigning in ComponentState) then
    begin
      if (Shape = bsSpacer) then
      begin
        Pen.Style := psDot;
        Pen.Mode := pmXor;
        Pen.Color := XorColor;
        Brush.Style := bsClear;
        Rectangle(0, 0, ClientWidth, ClientHeight);
        Exit;
      end
      else
      begin
        Pen.Style := psSolid;
        Pen.Mode  := pmCopy;
        Pen.Color := clBlack;
        Brush.Style := bsSolid;
      end;
    end;    Pen.Width := 1;    if Style = bsLowered then
    begin
      Color1 := clBtnShadow;
      Color2 := clBtnHighlight;
    end
    else
    begin
      Color1 := clBtnHighlight;
      Color2 := clBtnShadow;
    end;    I := TextHeight(Caption) DIV 2;
    ARect := Canvas.ClipRect;    Font := Self.Font;    case Shape of
      bsBox:
        begin
          BevelRect(Rect(0, I, Width - 1, Height - 1));
          DrawText(Canvas.Handle, PChar(Caption), Length(Caption), ARect, DT_CENTER);
        end;
      bsFrame:
        begin
          Temp := Color1;
          Color1 := Color2;
          BevelRect(Rect(1, I + 1, Width - 1, Height - 1));
          Color2 := Temp;
          Color1 := Temp;
          BevelRect(Rect(0, I, Width - 2, Height - 2));
          DrawText(Canvas.Handle, PChar(Caption), Length(Caption), ARect, DT_CENTER);
        end;
      bsTopLine:
        begin
          BevelLine(Color1, 0, I, Width, I);
          BevelLine(Color2, 1, I + 1, Width, I + 1);
          DrawText(Canvas.Handle, PChar(Caption), Length(Caption), ARect, DT_CENTER);
        end;
      bsBottomLine:
        begin
          BevelLine(Color1, 0, Height - 2, Width, Height - 2);
          BevelLine(Color2, 0, Height - 1, Width, Height - 1);
        end;
      bsLeftLine:
        begin
          BevelLine(Color1, 0, 0, 0, Height);
          BevelLine(Color2, 1, 0, 1, Height);
        end;
      bsRightLine:
        begin
          BevelLine(Color1, Width - 2, 0, Width - 2, Height);
          BevelLine(Color2, Width - 1, 0, Width - 1, Height);
        end;
    end;
  end;
end;end.

Answer 2

unit CustomBevelRegister;interface
uses
  Classes, Controls, Dialogs, DesignEditors, DesignIntf;type
  TCaptionEditor = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;procedure Register;implementationuses CustomBevel;procedure Register;
begin
  RegisterComponents('WGYKING', [TCustomBevel]);
  RegisterPropertyEditor(TypeInfo(TCaption), TCustomBevel, 'Caption', TCaptionEditor);
end;{ TCaptionEditor }procedure TCaptionEditor.Edit;
begin
  inherited;
  Value := InputBox('设置Caption', 'Caption值：', Value);
end;function TCaptionEditor.GetAttributes: TPropertyAttributes;
begin
  inherited GetAttributes;
  Result := [paDialog];
end;
end.我最近也在学习
嘿嘿上面的是个简单范例
没有什么意义不过系我写地