Delphi控件源码

开发平台：
C++ Builder

am2000bitmap.pas：源码内容
							
{*******************************************************}
{                                                       }
{       AnimatedMenus/2000                              }
{       T_AM2000_BitmapOptions                          }
{                                                       }
{       Copyright (c) 1997-99 AnimatedMenus.com         }
{       All rights reserved.                            }
{                                                       }
{*******************************************************}
unit am2000bitmap;
interface
uses
  Windows, Classes, Graphics, Menus, Controls,
  am2000options;
type
  // Bitmap menu control options
  T_AM2000_BitmapOptions = class(T_AM2000_ControlOptions)
  private
    FTransparent  : Boolean;
    FNumGlyphs    : Integer;
    FBitmap       : TBitmap;
    FDrawCaption  : Boolean;
    procedure SetBitmap(Value: TBitmap);
    procedure SetNumGlyphs(const Value: Integer);
  public
    constructor Create(AParent: TMenuItem); override;
    destructor Destroy; override;
    procedure Draw(DrawRect: P_AM2000_DrawMenuItemRect); override;
    function GetHeight(ItemHeight: Integer): Integer; override;
    function GetWidth(Canvas: TCanvas): Integer; override;
  published
//    property Transparent  : Boolean
//      read FTransparent write FTransparent default False;
    property NumGlyphs    : Integer
      read FNumGlyphs write SetNumGlyphs default 1;
    property Bitmap       : TBitmap
      read FBitmap write SetBitmap;
//    property DrawCaption  : Boolean
//      read FDrawCaption write FDrawCaption default True;
  end;
implementation
uses
  SysUtils,
  am2000menuitem, am2000utils, am2000const;
{ T_AM2000_BitmapOptions }
constructor T_AM2000_BitmapOptions.Create(AParent: TMenuItem);
begin
  inherited;
  FTransparent:= True;
  FDrawCaption:= True;
  FNumGlyphs:= 1;
  FBitmap:= TBitmap.Create;
end;
destructor T_AM2000_BitmapOptions.Destroy;
begin
  FBitmap.Free;
  inherited;
end;
procedure T_AM2000_BitmapOptions.SetBitmap(Value: TBitmap);
begin
  FBitmap.Assign(Value);
end;
procedure T_AM2000_BitmapOptions.Draw(DrawRect: P_AM2000_DrawMenuItemRect);
var
  DX, X: Integer;
  OldPalette: HPalette;
begin
  if (FBitmap = nil)
  or (FBitmap.Empty)
  then Exit;
  with DrawRect^ do begin
    // select bitmap
    DX:= FBitmap.Width div FNumGlyphs;
    X:= 0;
    if (FNumGlyphs > 1) and (isDisabled in State)  then X:= DX
    else
    if (FNumGlyphs > 2) and (isActivated in State) then X:= 2 * DX
    else
    if (FNumGlyphs > 3) and (isSelected in State)  then X:= 3 * DX;
    // draw
    OldPalette:= 0;
    if (FBitmap.Palette <> 0) then begin
      OldPalette:= SelectPalette(Canvas.Handle, FBitmap.Palette, True);
      RealizePalette(Canvas.Handle);
    end;
    BitBlt(Canvas.Handle, mir.LineLeft, mir.Top, mir.LineRight - mir.LineLeft, mir.Height,
      FBitmap.Canvas.Handle, X, 0, Canvas.CopyMode);
    if OldPalette <> 0
    then SelectPalette(Canvas.Handle, OldPalette, True);
  end;
end;
function T_AM2000_BitmapOptions.GetHeight(ItemHeight: Integer): Integer;
begin
  if
    (FBitmap <> nil)
  then
    Result:= FBitmap.Height
  else
    Result:= 0;
end;
function T_AM2000_BitmapOptions.GetWidth(Canvas: TCanvas): Integer;
begin
  if
    (FBitmap <> nil)
  then
    Result:= FBitmap.Width div FNumGlyphs
  else
    Result:= 0;
end;
procedure T_AM2000_BitmapOptions.SetNumGlyphs(const Value: Integer);
begin
  if
    (Value > 0) and (Value < 5)
  then
    FNumGlyphs:= Value
  else
    raise Exception.Create(SValueMustBeBetween1And4);
end;
end.

						