Delphi控件源码

开发平台：
C++ Builder

am2000options.pas：源码内容
							
{*******************************************************}
{                                                       }
{       AnimatedMenus/2000                              }
{       Menu options                                    }
{                                                       }
{       Copyright (c) 1997-99 AnimatedMenus.com         }
{       All rights reserved.                            }
{                                                       }
{*******************************************************}
unit am2000options;
{$I am2000.inc}
interface
uses
  Windows, Classes, Graphics, Menus, Controls,
  {$IFDEF Delphi4OrHigher} ImgList, {$ENDIF}
  am2000title;
type
  T_AM2000_Alignment = (taLeftJustify, taRightJustify, taCenter, taRightToLeft);
  // animation effect
  T_AM2000_Animation = (anNone, anVSlide, anHSlide, anSmart, anUnfold, anPopup,
    anRandom, anFadeIn);
  // flags
  T_AM2000_Flag = (mfHiddenAsRegular, mfHiddenIsVisible, mfNoAutoShowHidden, mfNoBitmapRect,
    mfNoChangeHidden, mfNoHighDisabled, mfNoShortDividers, mfShowCheckMark, mfStandardAlign);
  T_AM2000_Flags = set of T_AM2000_Flag;
  // mouse state
  T_AM2000_MouseState = set of (msMouseOver, msLeftButton, msRightButton);
  // item state
  T_AM2000_its = (isChecked, isSelected, isDisabled, isHidden, isDefault,
    isRadio, isSubmenu, isActivated, isHiddenPrev, isHiddenSucc, isSeparator,
    isGraphBack, isNoLeftSunken, isNoRightSunken);
  T_AM2000_ItemState = set of T_AM2000_its;
  // background display
  T_AM2000_BackgroundDisplay = (bdDefault, bdCenter, bdTile, bdStretch, bdExpand);
  T_AM2000_BaseOptions = class;
  // menu margins
  T_AM2000_Margins = class(TPersistent)
  private
    FLeft      : Integer;
    FTop       : Integer;
    FRight     : Integer;
    FBottom    : Integer;
    FSpace     : Integer;
    FBorder    : Integer;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    function IsDefault: Boolean;
  published
    property Left      : Integer
      read FLeft write FLeft default 23;
    property Top       : Integer
      read FTop write FTop default 0;
    property Right     : Integer
      read FRight write FRight default 23;
    property Bottom    : Integer
      read FBottom write FBottom default 0;
    property Space : Integer
      read FSpace write FSpace default 0;
    property Border : Integer
      read FBorder write FBorder default 1;
  end;
  // T_AM2000_MenuItemRect
  T_AM2000_MenuItemRect = class
  public
    LineLeft, LineRight,
    ItemLeft, ItemWidth,
    ShortcutLeft, ShortcutWidth,
    BitmapLeft, BitmapWidth,
    TriangleLeft, TriangleWidth,
    Top, Height, Border: Integer;
    function LineRect: TRect;
    function ItemRect: TRect;
    function ShortcutRect: TRect;
    function BitmapRect: TRect;
    function TriangleRect: TRect;
    procedure IncreaseOffset;
    procedure DecreaseOffset;
    procedure Clear;
  end;
  
  // T_AM2000_DrawMenuItemRect
  P_AM2000_DrawMenuItemRect = ^T_AM2000_DrawMenuItemRect;
  T_AM2000_DrawMenuItemRect = record
    Canvas: TCanvas;
    Handle: HMenu;
    Index: Integer;
    Item: TMenuItem;
    Options: T_AM2000_BaseOptions;
    State: T_AM2000_ItemState;
    MousePos: TPoint;
    MouseState: T_AM2000_MouseState;
    mir: T_AM2000_MenuItemRect;
    FullRepaint: Boolean;
    Images: TImageList;
  end;
  // menu colors
  T_AM2000_Colors = class(TPersistent)
  private
    FBorder          : TColor;
    FMenu            : TColor;
    FMenuText        : TColor;
    FMenuShadow      : TColor;
    FHighlight       : TColor;
    FHighlightText   : TColor;
    FDisabledText    : TColor;
    FDisabledShadow  : TColor;
    FLine            : TColor;
    FLineShadow      : TColor;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    function IsDefault: Boolean;
  published
    property Border         : TColor
      read FBorder write FBorder default clNone;
    property Menu           : TColor
      read FMenu write FMenu default clMenu;
    property MenuText       : TColor
      read FMenuText write FMenuText default clMenuText;
    property MenuShadow     : TColor
      read FMenuShadow write FMenuShadow default clBtnShadow;
    property Highlight      : TColor
      read FHighlight write FHighlight default clHighlight;
    property HighlightText  : TColor
      read FHighlightText write FHighlightText default clHighlightText;
    property DisabledText   : TColor
      read FDisabledText write FDisabledText default clBtnShadow;
    property DisabledShadow : TColor
      read FDisabledShadow write FDisabledShadow default clBtnHighlight;
    property Line           : TColor
      read FLine write FLine default clBtnShadow;
    property LineShadow     : TColor
      read FLineShadow write FLineShadow default clBtnHighlight;
  end;
  // menu options
  T_AM2000_MenuOptions = class(TPersistent)
  public
    function IsDefault: Boolean; virtual;
  end;
  T_AM2000_BaseOptions = class(T_AM2000_MenuOptions)
  private
    FItemHeight      : Integer;
    FSeparatorHeight : Integer;
    FTitle           : T_AM2000_Title;
    FBackground      : TBitmap;
    FColors          : T_AM2000_Colors;
    FMargins         : T_AM2000_Margins;
    FCaption         : String;
    FTextAlignment   : T_AM2000_Alignment;
    FFlags           : T_AM2000_Flags;
    FDraggable       : Boolean;
    FBackgroundDisplay : T_AM2000_BackgroundDisplay;
    function IsBackgroundStored: Boolean;
    function IsColorsStored: Boolean;
    procedure SetBackground(Value: TBitmap);
    procedure SetColors(Value: T_AM2000_Colors);
    procedure SetTitle(Value: T_AM2000_Title);
    procedure SetMargins(Value: T_AM2000_Margins);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function IsDefault: Boolean; override;
    property Flags           : T_AM2000_Flags
      read FFlags write FFlags default [];
  published
    property Alignment       : T_AM2000_Alignment
      read FTextAlignment write FTextAlignment default taLeftJustify;
    property Caption         : String
      read FCaption write FCaption;
    property Colors          : T_AM2000_Colors
      read FColors write SetColors stored  IsColorsStored;
    property ItemHeight      : Integer
      read FItemHeight write FItemHeight default 19;
    property SeparatorHeight : Integer
      read FSeparatorHeight write FSeparatorHeight default 9;
    property Title           : T_AM2000_Title
      read FTitle write SetTitle;
    property Background      : TBitmap
      read FBackground write SetBackground stored  IsBackgroundStored;
    property Draggable       : Boolean
      read FDraggable write FDraggable default False;
    property BackgroundDisplay : T_AM2000_BackgroundDisplay
      read FBackgroundDisplay write FBackgroundDisplay default bdDefault;
    property Margins         : T_AM2000_Margins
      read FMargins write SetMargins;
  end;
  T_AM2000_Options = class(T_AM2000_BaseOptions)
  private
    FAnimation   : T_AM2000_Animation;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    function IsDefault: Boolean; override;
  published
    property Flags;
    property Animation   : T_AM2000_Animation
      read FAnimation write FAnimation default anSmart;
  end;
  // Basic Control Options class
  T_AM2000_ControlOptions = class(TPersistent)
  protected
    Parent: TMenuItem;
    procedure Repaint;
  public
    constructor Create(AParent: TMenuItem); virtual;
    // drawing routine
    procedure Draw(DrawRect: P_AM2000_DrawMenuItemRect); virtual;
    // bounds routines
    function GetWidth(Canvas: TCanvas): Integer; virtual;
    function GetHeight(ItemHeight: Integer): Integer; virtual;
    // key management routines
    procedure KeyDown(var Key: Word; Shift: TShiftState); virtual;
    procedure KeyPress(var Key: Char); virtual;
  end;
var
  DrawRect: T_AM2000_DrawMenuItemRect;
implementation
uses
  am2000popupmenu, am2000utils;
{ T_AM2000_Margins }
constructor T_AM2000_Margins.Create;
begin
  inherited;
  FLeft:= 23;
  FRight:= 23;
  FBorder:= 1;
end;
procedure T_AM2000_Margins.Assign(Source: TPersistent);
var
  Src: T_AM2000_Margins;
begin
  if Source is T_AM2000_Margins then begin
    Src:= T_AM2000_Margins(Source);
    FLeft:=      Src.FLeft;
    FTop:=       Src.FTop;
    FRight:=     Src.FRight;
    FBottom:=    Src.FBottom;
    FSpace:=     Src.FSpace;
    FBorder:=    Src.FBorder;
  end
  else
    inherited;
end;
{ T_AM2000_MenuItemRect }
function T_AM2000_MenuItemRect.LineRect: TRect;
begin
  Result:= Rect(LineLeft, Top, LineRight, Top + Height);
end;
function T_AM2000_MenuItemRect.ItemRect: TRect;
begin
  Result:= Rect(ItemLeft, Top, ItemLeft + ItemWidth, Top + Height);
end;
function T_AM2000_MenuItemRect.ShortcutRect: TRect;
begin
  Result:= Rect(ShortcutLeft, Top, ShortcutLeft + ShortcutWidth, Top + Height);
end;
function T_AM2000_MenuItemRect.BitmapRect: TRect;
begin
  Result:= Rect(BitmapLeft, Top, BitmapLeft + BitmapWidth, Top + Height);
end;
function T_AM2000_MenuItemRect.TriangleRect: TRect;
begin
  Result:= Rect(TriangleLeft, Top, TriangleLeft + TriangleWidth, Top + Height);
end;
procedure T_AM2000_MenuItemRect.IncreaseOffset;
begin
  Inc(LineLeft);
  Inc(LineRight);
  Inc(ItemLeft);
  Inc(ShortcutLeft);
  Inc(BitmapLeft);
  Inc(TriangleLeft);
  Inc(Top);
end;
procedure T_AM2000_MenuItemRect.DecreaseOffset;
begin
  Dec(LineLeft);
  Dec(LineRight);
  Dec(ItemLeft);
  Dec(ShortcutLeft);
  Dec(BitmapLeft);
  Dec(TriangleLeft);
  Dec(Top);
end;
{ TColors }
constructor T_AM2000_Colors.Create;
begin
  inherited Create;
  FBorder:=         clBtnShadow;
  FMenu:=           clMenu;
  FMenuText:=       clMenuText;
  FMenuShadow:=     clBtnShadow;
  FHighlight:=      clHighlight;
  FHighlightText:=  clHighlightText;
  FDisabledText:=   clBtnShadow;
  FDisabledShadow:= clBtnHighlight;
  FLine:=           clBtnShadow;
  FLineShadow:=     clBtnHighlight;
end;
function T_AM2000_Colors.IsDefault: Boolean;
begin
  Result:= (FBorder =      clBtnShadow)
    and (FMenu =           clMenu)
    and (FMenuText =       clMenuText)
    and (FMenuShadow =     clBtnShadow)
    and (FHighlight =      clHighlight)
    and (FHighlightText =  clHighlightText)
    and (FDisabledText =   clBtnShadow)
    and (FDisabledShadow = clBtnHighlight)
    and (FLine =           clBtnShadow)
    and (FLineShadow =     clBtnHighlight);
end;
procedure T_AM2000_Colors.Assign(Source: TPersistent);
var
  Src: T_AM2000_Colors;
begin
  if Source is T_AM2000_Colors then begin
    Src:= T_AM2000_Colors(Source);
    Border:=         Src.Border;
    Menu:=           Src.Menu;
    MenuText:=       Src.MenuText;
    Highlight:=      Src.Highlight;
    HighlightText:=  Src.HighlightText;
    DisabledText:=   Src.DisabledText;
    DisabledShadow:= Src.DisabledShadow;
    Line:=           Src.Line;
    LineShadow:=     Src.LineShadow;
  end
  else
    inherited;
end;
function T_AM2000_Margins.IsDefault: Boolean;
begin
  Result:=
    (Left = 23) and
    (Top = 1) and
    (Right = 23) and
    (Bottom = 1) and
    (Space = 0) and
    (Border = 1);
end;
{ T_AM2000_MenuItemRect }
procedure T_AM2000_MenuItemRect.Clear;
begin
  LineLeft:= 0;
  LineRight:= 0;
  ItemLeft:= 0;
  ItemWidth:= 0;
  ShortcutLeft:= 0;
  ShortcutWidth:= 0;
  BitmapLeft:= 0;
  BitmapWidth:= 0;
  TriangleLeft:= 0;
  TriangleWidth:= 0;
  Top:= 0;
  Height:= 0;
  Border:= 0;
end;
{ T_AM2000_MenuOptions }
function T_AM2000_MenuOptions.IsDefault: Boolean; 
begin
  Result:= True;
end;
{ T_AM2000_BaseOptions }
constructor T_AM2000_BaseOptions.Create;
begin
  inherited;
  FItemHeight:= 19;
  FSeparatorHeight:= 9;
  FMargins:= T_AM2000_Margins.Create;
//  FIndent:= 23;
  FTitle:= T_AM2000_Title.Create;
  FColors:= T_AM2000_Colors.Create;
  FBackground:= TBitmap.Create;
end;
destructor T_AM2000_BaseOptions.Destroy;
begin
  FColors.Free;
  FTitle.Free;
  FBackground.Free;
  FMargins.Free;
  inherited;
end;
procedure T_AM2000_BaseOptions.SetBackground(Value: TBitmap);
begin
  FBackground.Assign(Value);
end;
procedure T_AM2000_BaseOptions.SetTitle(Value: T_AM2000_Title);
begin
  FTitle.Assign(Value);
end;
procedure T_AM2000_BaseOptions.SetColors(Value: T_AM2000_Colors);
begin
  FColors.Assign(Value);
end;
procedure T_AM2000_BaseOptions.SetMargins(Value: T_AM2000_Margins);
begin
  FMargins.Assign(Value);
end;
function T_AM2000_BaseOptions.IsBackgroundStored: Boolean;
begin
  Result:= not FBackground.Empty;
end;
function T_AM2000_BaseOptions.IsColorsStored: Boolean;
begin
  Result:= not Colors.IsDefault;
end;
procedure T_AM2000_BaseOptions.Assign(Source: TPersistent);
var
  Src: T_AM2000_BaseOptions;
begin
  if Source is T_AM2000_BaseOptions then begin
    Src:= T_AM2000_BaseOptions(Source);
    FItemHeight:= Src.FItemHeight;
    FSeparatorHeight:= Src.FSeparatorHeight;
    FBackgroundDisplay:= Src.FBackgroundDisplay;
    FTextAlignment:= Src.FTextAlignment;
    FCaption:= Src.FCaption;
    FDraggable:= Src.FDraggable;
    FMargins.Assign(Src.FMargins);
    FTitle.Assign(Src.FTitle);
    FBackground.Assign(Src.FBackground);
    FColors.Assign(Src.FColors);
  end
  else
    inherited;
end;
function T_AM2000_BaseOptions.IsDefault: Boolean;
begin
  Result:=
    inherited IsDefault and
    (Alignment = taLeftJustify) and
    (Caption = '') and
    (Colors.IsDefault) and
    (Draggable = False) and
    (ItemHeight = 19) and
    (SeparatorHeight = 9) and
    (Title.IsDefault) and
    (Background.Empty) and
    (FFlags = []) and
    (FBackgroundDisplay = bdDefault) and 
    (Margins.IsDefault);
end;
{ T_AM2000_Options }
constructor T_AM2000_Options.Create;
begin
  inherited;
  FAnimation:=  anSmart;
end;
procedure T_AM2000_Options.Assign(Source: TPersistent);
var
  Src: T_AM2000_Options;
begin
  inherited;
  if Source is T_AM2000_Options then begin
    Src:= T_AM2000_Options(Source);
    FAnimation:=  Src.FAnimation;
    FFlags:= Src.FFlags;
  end;
end;
function T_AM2000_Options.IsDefault: Boolean;
begin
  Result:=
    (inherited IsDefault) and
    (Animation = anSmart);
end;
{ T_AM2000_ControlOptions }
constructor T_AM2000_ControlOptions.Create(AParent: TMenuItem);
begin
  inherited Create;
  Parent:= AParent;
end;
procedure T_AM2000_ControlOptions.Draw(DrawRect: P_AM2000_DrawMenuItemRect);
begin
end;
function T_AM2000_ControlOptions.GetHeight(ItemHeight: Integer): Integer;
begin
  Result:= 0;
end;
function T_AM2000_ControlOptions.GetWidth(Canvas: TCanvas): Integer;
begin
  Result:= 0;
end;
procedure T_AM2000_ControlOptions.KeyDown(var Key: Word;
  Shift: TShiftState);
begin
end;
procedure T_AM2000_ControlOptions.KeyPress(var Key: Char);
begin
end;
procedure T_AM2000_ControlOptions.Repaint;
begin
  if AssignedActivePopupMenu2000Form
  then TCustomPopupMenu2000(ActivePopupMenu).Form.Repaint;
end;
initialization
  DrawRect.mir:= T_AM2000_MenuItemRect.Create;
finalization
  DrawRect.mir.Free;
end.

						