求制作椭圆形按扭的控件

解决方案 »

  1.   

    能不能直接给发一个椭圆形按扭的控件包,SUIPACK太大了,还要找好久,我现在急着用.
      

  2.   

    画几个图片,Timage事件响应一下就可以了
      

  3.   

    或者
    unit RVButton; interface uses 
      SysUtils, Classes, Controls, Messages, Graphics, Windows; const 
      iOffset = 3; type 
      TRVButton = class(TGraphicControl) 
      private 
        FCaption : string; 
        FButtonColor: TColor; 
        FLButtonDown: boolean; 
        FBtnPoints : array[1..2] of TPoint; 
        FKRgn : HRgn; 
        procedure SetCaption(Value: string); 
        procedure SetButtonColor(Value: TColor); 
        procedure FreeRegion; 
      protected 
        procedure Paint; override; 
        procedure DrawCircle; 
        procedure MoveButton; 
        procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; 
        procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP; 
      public 
        constructor Create(AOwner: TComponent); override; 
        destructor Destroy; override; 
      published 
        property ButtonColor: TColor read FButtonColor write SetButtonColor; 
        property Caption: string read FCaption write SetCaption; 
        property Enabled; 
        property Font; 
        property ParentFont; 
        property ParentShowHint; 
        property ShowHint; 
        property Visible; 
        property OnClick; 
      end; procedure Register; implementation procedure Register; 
    begin 
      RegisterComponents('Samples', [TRVButton]); 
    end; { TRVButton } constructor TRVButton.Create(AOwner: TComponent); 
    begin 
      inherited Create(AOwner); 
      ControlStyle := [csClickEvents,csCaptureMouse]; 
      Width := 50; 
      Height := 50; 
      FButtonColor := clBtnFace; 
      FKRgn := 0; 
      FLButtonDown := False; 
    end; destructor TRVButton.Destroy; 
    begin 
      if FKRgn <> 0 then FreeRegion; 
      inherited Destroy; 
    end; procedure TRVButton.DrawCircle; 
    begin 
      FBtnPoints[1] := Point(iOffset,iOffset); 
      FBtnPoints[2] := Point(Width - iOffset,Height - iOffset); 
      FKRgn := CreateEllipticRgn(FBtnPoints[1].x,FBtnPoints[1].y,FBtnPoints[2].x,FBtnPoints[2].y); 
      Canvas.Brush.Color := FButtonColor; 
      FillRgn(Canvas.Handle,FKRgn,Canvas.Brush.Handle); 
      MoveButton; 
    end; procedure TRVButton.FreeRegion; 
    begin 
      if FKRgn <> 0 then DeleteObject(FKRgn); 
      FKRgn := 0; 
    end; procedure TRVButton.MoveButton; 
    var 
      Color1: TColor; 
      Color2: TColor; 
    begin 
      with Canvas do 
        begin 
        if not FLButtonDown then 
          begin 
          Color1 := clBtnHighlight; 
          Color2 := clBtnShadow; 
          end 
        else 
          begin 
          Color1 := clBtnShadow; 
          Color2 := clBtnHighLight; 
          end;       Pen.Width := 1;       if FLButtonDown then Pen.Color := clBlack 
          else                 Pen.Color := Color2;       Ellipse(FBtnPoints[1].x - 2,FBtnPoints[1].y - 2,FBtnPoints[2].x + 2,FBtnPoints[2].y + 2);       if not FLButtonDown then Pen.Width := 2 
          else                     Pen.Width := 1;       Pen.Color := Color1;       Arc(FBtnPoints[1].x,FBtnPoints[1].y,FBtnPoints[2].x,FBtnPoints[2].y, 
              FBtnPoints[2].x,FBtnPoints[1].y,FBtnPoints[1].x,FBtnPoints[2].y);       Pen.Color := Color2;       Arc(FBtnPoints[1].x,FBtnPoints[1].y,FBtnPoints[2].x,FBtnPoints[2].y, 
              FBtnPoints[1].x,FBtnPoints[2].y,FBtnPoints[2].x,FBtnPoints[1].y); 
          end;   SetCaption(''); 
    end; procedure TRVButton.Paint; 
    begin 
      inherited Paint; 
      FreeRegion; 
      DrawCircle; 
    end; procedure TRVButton.SetButtonColor(Value: TColor); 
    begin 
      if Value <> FButtonColor then 
        begin 
        FButtonColor := Value; 
        Invalidate; 
        end; 
    end; procedure TRVButton.SetCaption(Value: string); 
    var 
      X: Integer; 
      Y: Integer; 
    begin 
      if ((Value <> FCaption) and (Value <> '')) then 
      begin 
        FCaption := Value; 
      end;   with Canvas.Font do 
      begin 
        Name  := Font.Name; 
        Size  := Font.Size; 
        Style := Font.Style; 
        if Self.Enabled then Color := Font.Color 
        else 
          Color := clDkGray; 
      end;   X := (Width div 2) - (Canvas.TextWidth(FCaption) div 2); 
      Y := (Height div 2) - (Canvas.TextHeight(FCaption) div 2); 
      Canvas.TextOut(X, Y, FCaption); 
      //  Invalidate; 
    end; 
    procedure TRVButton.WMLButtonDown(var Message: TWMLButtonDown); 
    begin 
      if not PtInRegion(FKRgn,Message.xPos,Message.yPos) then exit; 
      FLButtonDown := True; 
      MoveButton; 
      inherited; 
    end; procedure TRVButton.WMLButtonUp(var Message: TWMLButtonUp); 
    begin 
      if not FLButtonDown then exit; 
      FLButtonDown := False; 
      MoveButton; 
      inherited; 
    end; 
    end. 
      

  4.   

    有个程序是CrystinaButton,可以做各种各样的按钮,但是不是控件
    是个外部程序,做好后放到button上,然后设置一下
      

  5.   

    http://www.86dl.com/soft/data/18905.html
    这个看看,满足你要求吗?
      

  6.   

    http://www.86dl.com/soft/data/18905.html
      

  7.   

    我只是知道suipack
    顺便说一句
    楼上的不厚道人如其名阿
      

  8.   

    我找到了Suipack,已安装了,只是是试用版的,每次运行的时候都提示注册.我安装的时候,也没提求要注册呀,怎么注册呀?