Delphi控件源码

开发平台：
C++ Builder

am2000buttonarray.pas：源码内容
							
{*******************************************************}
{                                                       }
{       AnimatedMenus/2000                              }
{       T_AM2000_ButtonArrayOptions                     }
{                                                       }
{       Copyright (c) 1997-99 AnimatedMenus.com         }
{       All rights reserved.                            }
{                                                       }
{*******************************************************}
unit am2000buttonarray;
{$I am2000.inc}
interface
uses
  Windows, Classes, Graphics, Menus, Controls,
  {$IFDEF Delphi4OrHigher} ImgList, {$ENDIF}
  am2000options;
type
  // TButtonArrayOptions
  T_AM2000_ButtonArrayOptions = class(T_AM2000_ControlOptions)
  private
    LastLeft, LastRight, LastTop, LastBottom: Integer;
    FRows         : Integer;
    FColumns      : Integer;
    FHints        : TStrings;
    FItemIndex    : Integer;
    FAllowAllUp   : Boolean;
    FBitmap       : TBitmap;
    FCount        : Integer;
    procedure SetHints(Value: TStrings);
    procedure SetItemIndex(Value: Integer);
    procedure SetBitmap(const Value: TBitmap);
  public
    LastItemIndex : Integer;
    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;
    function GetIndexAt(X, Y: Integer): Integer;
  published
    property Rows         : Integer
      read FRows write FRows default 1;
    property Columns         : Integer
      read FColumns write FColumns default 1;
    property Hints        : TStrings
      read FHints write SetHints;
    property ItemIndex    : Integer
      read FItemIndex write SetItemIndex default -1;
    property AllowAllUp   : Boolean
      read FAllowAllUp write FAllowAllUp default True;
    property Bitmap       : TBitmap
      read FBitmap write SetBitmap;
    property Count        : Integer
      read FCount write FCount default 0;
  end;
implementation
uses
  CommCtrl, Dialogs, SysUtils,
  am2000menuitem, am2000utils;
{ T_AM2000_ButtonArrayOptions }
constructor T_AM2000_ButtonArrayOptions.Create;
begin
  inherited;
  FAllowAllUp:= True;
  FItemIndex:= -1;
  LastItemIndex:= -1;
  FRows:= 1;
  FColumns:= 1;
  FBitmap:= TBitmap.Create;
  FHints:= TStringList.Create;
end;
destructor T_AM2000_ButtonArrayOptions.Destroy;
begin
  FHints.Free;
  FBitmap.Free;
  inherited;
end;
function T_AM2000_ButtonArrayOptions.GetHeight(ItemHeight: Integer): Integer;
begin
  Result:= Bitmap.Height +1;
end;
function T_AM2000_ButtonArrayOptions.GetWidth(Canvas: TCanvas): Integer;
begin
  Result:= Bitmap.Width;
end;
procedure T_AM2000_ButtonArrayOptions.SetBitmap(const Value: TBitmap);
begin
  FBitmap.Assign(Value);
end;
procedure T_AM2000_ButtonArrayOptions.SetHints(Value: TStrings);
begin
  FHints.Assign(Value);
end;
procedure T_AM2000_ButtonArrayOptions.SetItemIndex(Value: Integer);
begin
  if Value <> -1
  then TMenuItem2000(Parent).TurnSiblingsOff;
  LastItemIndex:= FItemIndex;
  FItemIndex:= Value;
  RepaintFloatingMenus;
end;
procedure T_AM2000_ButtonArrayOptions.Draw(DrawRect: P_AM2000_DrawMenuItemRect);
// draws TMenuItem2000 with ControlStyle = ctlButtonArray
var
  R: TRect;
  I, J, NextLII: Integer;
  il: HImageList;
  DC: HDC;
  MaskBmp, SaveBmp: HBITMAP;
  Size: TPoint;
begin
  if (FBitmap = nil)
  or (FBitmap.Empty)
  then Exit;
  with DrawRect^ do begin
    // draw background
    if Canvas.Brush.Color <> Options.Colors.Menu
    then Canvas.Brush.Color:= Options.Colors.Menu;
    R:= mir.LineRect;
    Canvas.FrameRect(R);
    InflateRect(R, -1, 0);
    Canvas.FrameRect(R);
{$IFDEF Delphi3OrHigher}
    // set pixel format
    if Bitmap.PixelFormat <> pf24bit
    then Bitmap.PixelFormat:= pf24bit;
{$ENDIF}
    // create mask
    MaskBmp:= CreateBitmap(Bitmap.Width, Bitmap.Height, 1, 1, nil);
    DC:= CreateCompatibleDC(0);
    SaveBmp:= SelectObject(DC, MaskBmp);
    SetBkColor(Bitmap.Canvas.Handle, Bitmap.Canvas.Pixels[0, 0]);
    BitBlt(DC, 0, 0, Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle, 0, 0, SrcCopy);
    SelectObject(DC, SaveBmp);
    DeleteDC(DC);
    // fast draw bitmap
    il:= ImageList_Create(Bitmap.Width, Bitmap.Height, ilc_Color24 + ilc_Mask, 1, 1);
    ImageList_SetBkColor(il, ColorToRgb(Options.Colors.Menu));
    ImageList_Add(il, Bitmap.Handle, MaskBmp);
    ImageList_Draw(il, 0, Canvas.Handle, mir.LineLeft +2, mir.Top +1, ild_Normal);
    ImageList_Destroy(il);
    DeleteObject(MaskBmp);
    // count
    if Count = 0 then Count:= Rows * Columns;
    // draw rectangle
    // get size
    Size:= Point(Bitmap.Width div Columns, Bitmap.Height div Rows);
    // draw item index
    if (ItemIndex >=0)
    then begin
      I:= ItemIndex mod Columns;
      J:= ItemIndex div Columns;
      R:= Rect(I * Size.X + mir.LineLeft +2, J * Size.Y + mir.Top +1, 0, 0);
      R.Right:= R.Left + Size.X;
      R.Bottom:= R.Top + Size.Y;
      // draw edge
      DrawEdge(Canvas.Handle, R, bdr_SunkenOuter, bf_Rect)
    end;
    // save coordinates
    LastLeft:= mir.LineLeft;
    LastRight:= mir.LineRight;
    LastTop:= mir.Top;
    LastBottom:= mir.Top + mir.Height;
    // draw current item
    NextLii:= -1;
    if (isSelected in State)
    and (MousePos.X > mir.LineLeft -2)
    and (MousePos.X < mir.LineRight)
    and (MousePos.Y > mir.Top -1)
    and (MousePos.Y < mir.Top + mir.Height)
    then begin
      I:= (MousePos.X - mir.LineLeft -2) div Size.X;
      J:= (MousePos.Y - mir.Top -2) div Size.Y;
      NextLII:= I + J * Columns;
      if (I >= 0) and (I < Columns)
      and (J >= 0) and (J < Rows)
      and (NextLII < Count)
      then begin
        // get current item's size
        R:= Rect(I * Size.X + mir.LineLeft +2, J * Size.Y + mir.Top +1, 0, 0);
        R.Right:= R.Left + Size.X;
        R.Bottom:= R.Top + Size.Y;
        // draw edge
        if (msLeftButton in MouseState)
        then DrawEdge(Canvas.Handle, R, bdr_SunkenOuter, bf_Rect)
        else DrawEdge(Canvas.Handle, R, bdr_RaisedInner, bf_Rect);
      end { acceptable I and J } ;
    end;
    LastItemIndex:= NextLII;
  end;
end;
function T_AM2000_ButtonArrayOptions.GetIndexAt(X, Y: Integer): Integer;
var
  I, J: Integer;
  Size: TPoint;
begin
  Result:= -1;
  if (X > LastLeft)
  and (X < LastRight)
  and (Y > LastTop -1)
  and (Y < LastBottom)
  then begin
    Size:= Point(Bitmap.Width div Columns, Bitmap.Height div Rows);
    I:= (X - LastLeft -2) div Size.X;
    J:= (Y - LastTop -2) div Size.Y;
    Result:= I + J * Columns;
  end;
end;
end.

						