Delphi控件源码

开发平台：
C++ Builder

am2000button.pas：源码内容
							
{*******************************************************}
{                                                       }
{       AnimatedMenus/2000                              }
{       T_AM2000_ButtonOptions                          }
{                                                       }
{       Copyright (c) 1997-99 AnimatedMenus.com         }
{       All rights reserved.                            }
{                                                       }
{*******************************************************}
unit am2000button;
{$I am2000.inc}
interface
uses
  SysUtils, Windows, Graphics, Menus,
  am2000options;
type
  // TButtonOptions - options for ControlType = ctButton
  T_AM2000_ButtonOptions = class(T_AM2000_ControlOptions)
  private
    FAllowAllUp   : Boolean;
    FBorderFrame  : Boolean;
    FDown         : Boolean;
    procedure SetDown(Value: Boolean);
  public
    constructor Create(AParent: TMenuItem); override;
    procedure Draw(DrawRect: P_AM2000_DrawMenuItemRect); override;
    function GetHeight(ItemHeight: Integer): Integer; override;
  published
    property AllowAllUp   : Boolean
      read FAllowAllUp write FAllowAllUp default True;
    property BorderFrame  : Boolean
      read FBorderFrame write FBorderFrame default True;
    property Down         : Boolean
      read FDown write SetDown default False;
  end;
implementation
uses
  am2000menuitem, am2000utils;
// draws TMenuItem2000 with ControlStyle = ctlButton
procedure DrawMenuItemButton(Canvas: TCanvas;
            Item: TMenuItem2000;
            Options: T_AM2000_BaseOptions;
            State: T_AM2000_ItemState;
            MouseState: T_AM2000_MouseState;
            mir: T_AM2000_MenuItemRect);
var
  R: TRect;
begin
  if not (Item.ControlOptions is T_AM2000_ButtonOptions) then Exit;
  // clear background
  R:= mir.LineRect;
  DrawBackground(Canvas, [], Options, R);
  InflateRect(R, -2, -1); Dec(R.Bottom, 2);
  with Item.ControlOptions as T_AM2000_ButtonOptions do begin
    if (msLeftButton in MouseState)
    or (Down and not (isSelected in State))
    then begin
      DrawPatternBackground(Canvas, R);
      DrawEdge(Canvas.Handle, R, bdr_SunkenOuter, bf_Rect);
    end
    else
      if isSelected in State then
        if Down
        then DrawEdge(Canvas.Handle, R, bdr_SunkenOuter, bf_Rect)
        else DrawEdge(Canvas.Handle, R, bdr_RaisedInner, bf_Rect);
    Canvas.Brush.Style:= bsClear;
    Canvas.Font.Color:= Options.Colors.MenuText;
    DrawCaption(Canvas, Item.Caption, am2000options.taCenter, R);
    if BorderFrame then begin
      Canvas.Brush.Color:= clBtnShadow;
      if Canvas.Brush.Style <> bsSolid then
        Canvas.Brush.Style:= bsSolid;
      InflateRect(R, -5, -3);
      Canvas.FrameRect(R);
    end;
  end;
end;
{ T_AM2000_ButtonOptions }
constructor T_AM2000_ButtonOptions.Create;
begin
  inherited;
  FAllowAllUp:= True;
  FBorderFrame:= True;
end;
procedure T_AM2000_ButtonOptions.Draw(DrawRect: P_AM2000_DrawMenuItemRect);
begin
  with DrawRect^ do
    DrawMenuItemButton(Canvas, TMenuItem2000(Parent), Options, State, MouseState, mir)
end;
function T_AM2000_ButtonOptions.GetHeight(ItemHeight: Integer): Integer;
begin
  Result:= ItemHeight +6;
end;
procedure T_AM2000_ButtonOptions.SetDown(Value: Boolean);
begin
  if Value <> False
  then TMenuItem2000(Parent).TurnSiblingsOff;
  if FAllowAllUp or Value
  then FDown:= Value;
  RepaintFloatingMenus;
end;
end.

						