Delphi控件源码

开发平台：
Delphi

MMClrBtn.pas：源码内容
							{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: +49(0)351-8037944               =}
{=  Loewenstr.7a                = info@swiftsoft.de                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/index.html               =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 26.11.98 - 00:54:58 $                                        =}
{========================================================================}
unit MMClrBtn;
{$I COMPILER.INC}
interface
uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Graphics,
    Messages,
    StdCtrls,
    Classes,
    Controls,
    Dialogs,
    MMObj,
    MMUtils,
    MMButton,
    MMString;
const
    GridRows        = 5;
    GridCols        = 4;
    GridCells       = GridRows*GridCols;
    GridCellSize    = 18;
    GridMargin      = 3;
    GridWidth       = GridCols * GridCellSize;
    PopupWidth      = GridWidth + 2*GridMargin;
    GridHeight      = GridRows * GridCellSize;
    CustomLeft      = GridWidth-GridCellSize;
    DelimTop        = GridHeight + GridMargin div 2;
    CustomTop       = DelimTop + GridMargin div 2 + GridMargin;
    PopupHeight     = CustomTop + GridCellSize + 2*GridMargin;
    
    MM_DROPCOLORDLG = MM_USER + 1;
type
    {-- TMMColorSpeedButton --------------------------------------------------}
    TMMCustomColorButton= class;
    TMMColorSpeedButton = class(TMMSpeedButton)
    private
        function        GetColorButton: TMMCustomColorButton;
    protected
        procedure       Paint; override;
        procedure       FocusLine(X1, Y1, X2, Y2: integer);
        procedure       DrawColor(Canvas: TCanvas; const Rect: TRect);
        procedure       DrawDelimiter(Canvas: TCanvas; Left, Top, Bottom: Integer);
    public
        property        ColorButton: TMMCustomColorButton read GetColorButton;
    end;
    {-- TMMColorPopup --------------------------------------------------------}
    TMMColorPopUp       = class(TMMCustomControl)
    private
        FOpened         : Boolean;
        FIndex          : Integer;
        FColors         : array[0..GridCells-1] of TColor;
        FDrawCustom     : Boolean;
        FButton         : TButton;
        FSave           : Pointer;
        function        GetButtonCaption: string;
        procedure       SetButtonCaption(Value: string);
    protected
        procedure       CreateParams(var Params: TCreateParams); override;
        procedure       WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
        procedure       CloseUp(OK: Boolean);
        procedure       DropDown;
        function        ColorButton: TMMCustomColorButton;
        function        GetColorByIndex(Index: Integer): TColor;
        function        GetIndexByColor(Color: TColor): Integer;
        procedure       Paint; override;
        procedure       DrawItem(Canvas: TCanvas; i: Integer);
        procedure       DrawCustomColor(Canvas: TCanvas);
        procedure       DrawColorCell(Canvas: TCanvas; const Rect: TRect; Color: TColor; Focused: Boolean);
        procedure       MouseMove(Shift: TShiftState; X, Y: Integer); override;
        procedure       MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
        procedure       MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
        procedure       KeyDown(var Key: Word; Shift: TShiftState); override;
        function        IndexAt(X, Y: Integer): Integer;
        procedure       SetIndex(Value: Integer);
        procedure       CustomClick(Sender: TObject);
        procedure       DrawDelimiter(Canvas: TCanvas);
        procedure       CustomExit(Sender: TObject);
    public
        constructor     Create(AOwner: TComponent); override;
        property        ButtonCaption: string read GetButtonCaption write SetButtonCaption;
    end;
    {-- TMMCustomColorButton -------------------------------------------------}
    TMMCustomColorButton = class(TMMCustomControl)
    private
        FButton        : TMMColorSpeedButton;
        FValue         : TColor;
        FFocusColor    : TColor;
        FPopup         : TMMColorPopup;
        FColorDlg      : TColorDialog;
        FButtonCaption : string;
        FShowCurrent   : Boolean;
        FOnChange      : TNotifyEvent;
        procedure SetFocusColor(Value: TColor);
        function  GetGlyph: TBitmap;
        procedure SetGlyph(Value: TBitmap);
        function  GetNumGlyphs: Integer;
        procedure SetNumGlyphs(Value: Integer);
        procedure SetValue(Value: TColor);
        function  GetCustomColors: TStrings;
        procedure SetCustomColors(Value: TStrings);
        procedure SetButtonCaption(Value: string);
    protected
        procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
        procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
        procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
        procedure CMEnabledChanged(var Message); message CM_ENABLEDCHANGED;
        procedure BtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        procedure KeyDown(var Key: Word; Shift: TShiftState); override;
        procedure Change; dynamic;
        procedure BtnClick(Sender: TObject);
        procedure ShowPopup;
        procedure MMDropColorDlg(var Message); message MM_DROPCOLORDLG;
        function  Popup: TMMColorPopup;
    public
        constructor Create(AOwner: TComponent); override;
    protected
        property    Width default 43;
        property    Height default 21;
        property    TabStop default True;
        property    FocusColor: TColor read FFocusColor write SetFocusColor default clBlack;
        property    Glyph: TBitmap read GetGlyph write SetGlyph;
        property    NumGlyphs: Integer read GetNumGlyphs write SetNumGlyphs default 1;
        property    Value: TColor read FValue write SetValue default clBlack;
        property    CustomColors: TStrings read GetCustomColors write SetCustomColors;
        property    ButtonCaption: string read FButtonCaption write SetButtonCaption;
        property    ShowCurrent: Boolean read FShowCurrent write FShowCurrent default False;
        property    OnChange: TNotifyEvent read FOnChange write FOnChange;
    end;
    {-- TMMColorButton -------------------------------------------------------}
    TMMColorButton = class(TMMCustomColorButton)
    published
        property    Width;
        property    Height;
        property    TabStop;
        property    TabOrder;
        property    FocusColor;
        property    Glyph;
        property    NumGlyphs;
        property    Value;
        property    CustomColors;
        property    ButtonCaption;
        property    ShowCurrent;
        property    OnChange;
        property    Enabled;
        property    Visible;
    end;
implementation
uses
    Buttons,
    ExtCtrls,
    Forms;
{$IFDEF WIN32}
    {$R MMCLRBTN.D32}
{$ELSE}
    {$R MMCLRBTN.D16}
{$ENDIF}
const
    ButtonRes = 'BM_CLRBTNDOWN';
{== TMMColorSpeedButton ==================================================}
procedure TMMColorSpeedButton.Paint;
var
    R, FR: TRect;
    ColorSize, GlyphSize: Integer;
begin
    if not Enabled and not (csDesigning in ComponentState) then
        FState := bsDisabled
    else if FState = bsDisabled then
        FState := bsUp;
    R := DrawButtonFace(Canvas, Rect(0, 0, Width, Height), 1, bsAutoDetect,
                        False, FState in [bsDown, bsExclusive], ColorButton.Focused);
    if Glyph = nil then
        GlyphSize := 0
    else
        GlyphSize := Glyph.Width + 2;
    ColorSize := R.Right - R.Left - GlyphSize - 2;
    if ColorSize < 0 then
        ColorSize := 0;
    if GlyphSize > 0 then
        DrawGlyph(Canvas,Rect(R.Left+ColorSize+2,R.Top,R.Right,R.Bottom));
    if (Enabled or (csDesigning in ComponentState)) and (ColorSize > 0) then
        DrawColor(Canvas,Rect(R.Left,R.Top,R.Left+ColorSize,R.Bottom));
    DrawDelimiter(Canvas,R.Left+ColorSize,R.Top+2,R.Bottom-2);
    if ColorButton.Focused then
    begin
        FR := Rect(R.Left,R.Top,R.Right-1,R.Bottom-1);
        InflateRect(FR,-1,-1);
        with FR do
        begin
            FocusLine(Left,Top,Right,Top);
            FocusLine(Right,Top,Right,Bottom);
            FocusLine(Left,Bottom,Right,Bottom);
            FocusLine(Left,Top,Left,Bottom);
        end;
    end;
end;
{-- TMMColorSpeedButton --------------------------------------------------}
procedure TMMColorSpeedButton.FocusLine(X1, Y1, X2, Y2: integer);
var
    i: Integer;
begin
    if (X1 = X2) then
    begin
        i := Y1;
        while i < Y2 do
        begin
            Canvas.Pixels[X1, i] := ColorButton.FFocusColor;
            Inc(i,2)
        end;
    end
    else if (Y1 = Y2) then
    begin
        i := X1;
        while i < X2 do
        begin
            Canvas.Pixels[i, Y1] := ColorButton.FFocusColor;
            Inc(i,2)
        end;
    end;
end;
{-- TMMColorSpeedButton --------------------------------------------------}
function TMMColorSpeedButton.GetColorButton: TMMCustomColorButton;
begin
    Result := Owner as TMMCustomColorButton;
end;
{-- TMMColorSpeedButton --------------------------------------------------}
procedure TMMColorSpeedButton.DrawColor(Canvas: TCanvas; const Rect: TRect);
var
    R: TRect;
begin
    with Canvas do
    begin
        R := Rect;
        InflateRect(R,-4,-2);
        Brush.Color := ColorButton.Value;
        Brush.Style := bsSolid;
        Pen.Color   := clBlack;
        Pen.Width   := 1;
        Rectangle(R.Left,R.Top,R.Right,R.Bottom);
    end;
end;
{-- TMMColorSpeedButton --------------------------------------------------}
procedure TMMColorSpeedButton.DrawDelimiter(Canvas: TCanvas; Left, Top, Bottom: Integer);
begin
    with Canvas do
    begin
        Pen.Color := clBtnShadow;
        Pen.Width := 1;
        MoveTo(Left,Top);
        LineTo(Left,Bottom);
        Pen.Color := clBtnHighlight;
        MoveTo(Left+1,Top);
        LineTo(Left+1,Bottom);
    end;
end;
{== TMMCustomButton ======================================================}
type
    TMMCustomButton = class(TButton)
    protected
        procedure   KeyDown(var Key: Word; Shift: TShiftState); override;
    end;
{-- TMMCustomButton ------------------------------------------------------}
procedure TMMCustomButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
    if Key = VK_ESCAPE then
        PostMessage(Parent.Handle,WM_KEYDOWN,VK_ESCAPE,0);
end;
{== TMMColorPopup ========================================================}
constructor TMMColorPopup.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    Visible := False;
    Hide;
    TabStop := True;
    ClientWidth  := PopupWidth;
    ClientHeight := PopupHeight;
    FButton := TMMCustomButton.Create(Self);
    with FButton do
    begin
        Parent := Self;
        Left := GridMargin;
        Top := CustomTop;
        Width := GridWidth - GridCellSize - GridMargin;
        Height := GridCellSize;
        { TODO: Put to resource }
        Caption := '&Custom...';
        OnClick := CustomClick;
        OnExit := CustomExit;
    end;
   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;
{-- TMMColorPopup --------------------------------------------------------}
procedure TMMColorPopup.CreateParams(var Params: TCreateParams);
begin
    inherited CreateParams(Params);
    Params.Style := WS_POPUP or WS_CLIPCHILDREN or WS_DLGFRAME;
{$IFDEF WIN32}
    Params.ExStyle := WS_EX_TOOLWINDOW;
{$ENDIF}
    Params.WindowClass.Style := Params.WindowClass.Style or CS_SAVEBITS;
end;
{-- TMMColorPopup --------------------------------------------------------}
procedure TMMColorPopup.WMKillFocus(var Message: TWMKillFocus);
var
    H: THandle;
begin
    H := Message.FocusedWnd;
    while (H <> 0) and (H <> Handle) do
        H := GetParent(H);
    if H = Handle then
        Exit;
    if FOpened then
        CloseUp(False);
end;
{-- TMMColorPopup --------------------------------------------------------}
function TMMColorPopup.ColorButton: TMMCustomColorButton;
begin
    Result := TMMCustomColorButton(Owner);
end;
{-- TMMColorPopup --------------------------------------------------------}
function TMMColorPopup.GetColorByIndex(Index: Integer): TColor;
begin
    Result := FColors[Index];
end;
{-- TMMColorPopup --------------------------------------------------------}
function TMMColorPopup.GetIndexByColor(Color: TColor): Integer;
begin
    Color := ColorToRGB(Color);
    for Result := Low(FColors) to High(FColors) do
        if ColorToRGB(FColors[Result]) = Color then
            Exit;
    Result := -1;
end;
{-- TMMColorPopup --------------------------------------------------------}
procedure TMMColorPopup.Paint;
var
    i: Integer;
    Offs: TBitmap;
begin
    Offs := TBitmap.Create;
    try
        Offs.Width  := ClientWidth;
        Offs.Height := ClientHeight;
        with Offs.Canvas do
        begin
            Brush.Color := clBtnFace;
            FillRect(ClientRect);
        end;
        for i := 0 to GridCells - 1 do
            DrawItem(Offs.Canvas,i);
        if FDrawCustom then
            DrawCustomColor(Offs.Canvas);
        DrawDelimiter(Offs.Canvas);
        Canvas.Draw(0,0,Offs);
    finally
        Offs.Free;
    end;
end;
{-- TMMColorPopup --------------------------------------------------------}
procedure TMMColorPopup.DrawCustomColor(Canvas: TCanvas);
begin
    DrawColorCell(Canvas,
                  Bounds(CustomLeft,CustomTop,GridCellSize,GridCellSize),
                  ColorButton.Value,
                  FIndex = -1);
end;
{-- TMMColorPopup --------------------------------------------------------}
procedure TMMColorPopup.DrawItem(Canvas: TCanvas; i: Integer);
var
    Row, Col: Integer;
begin
    Row := i div GridCols;
    Col := i mod GridCols;
    DrawColorCell(Canvas,
                  Bounds(Col*GridCellSize,Row*GridCellSize,GridCellSize,GridCellSize),
                  GetColorByIndex(i),FIndex=i);
end;
{-- TMMColorPopup --------------------------------------------------------}
procedure TMMColorPopup.DrawColorCell(Canvas: TCanvas; const Rect: TRect; Color: TColor; Focused: Boolean);
var
    R: TRect;
begin
    R := Rect;
    with Canvas do
    begin
        if Focused then
        begin
            Pen.Color := clBlack;
            Pen.Width := 1;
            Brush.Style := bsClear;
            Rectangle(Rect.Left,Rect.Top,Rect.Right,Rect.Bottom);
            Rectangle(Rect.Left+2,Rect.Top+2,Rect.Right-2,Rect.Bottom-2);
            Pen.Color := clWhite;
            Rectangle(Rect.Left+1,Rect.Top+1,Rect.Right-1,Rect.Bottom-1);
        end
        else
        begin
            Frame3D(Canvas,R,clBtnFace,clBtnFace,1);
            Frame3D(Canvas,R,clBtnShadow,clBtnHighlight,1);
            Frame3D(Canvas,R,clBtnText,clBtnFace,1);
        end;
        Brush.Color := Color;
        Brush.Style := bsSolid;
        FillRect(Classes.Rect(Rect.Left+3,Rect.Top+3,Rect.Right-3,Rect.Bottom-3));
    end;
end;
{-- TMMColorPopup --------------------------------------------------------}
procedure TMMColorPopup.DrawDelimiter(Canvas: TCanvas);
begin
    with Canvas do
    begin
        Pen.Style := psSolid;
        Pen.Color := clBtnShadow;
        MoveTo(0,DelimTop);
        LineTo(ClientWidth,DelimTop);
        Pen.Color := clBtnHighlight;
        MoveTo(0,DelimTop+1);
        LineTo(ClientWidth,DelimTop+1);
    end;
end;
{-- TMMColorPopup --------------------------------------------------------}
procedure TMMColorPopup.MouseMove(Shift: TShiftState; X, Y: Integer);
var
    i: Integer;
begin
    if InRange(X,0,Width) and InRange(Y,0,Height) then
    begin
        i := IndexAt(X,Y);
        if i <> -1 then
            SetIndex(i);
    end;
end;
{-- TMMColorPopup --------------------------------------------------------}
function TMMColorPopup.IndexAt(X, Y: Integer): Integer;
var
    R, C : Integer;
begin
    C := X div GridCellSize;
    R := Y div GridCellSize;
    if InRange(C,0,GridCols-1) and InRange(R,0,GridRows-1) then
        Result := C + R * GridCols
    else
    begin
        if FDrawCustom and
           InRange(X,CustomLeft,CustomLeft+GridCellSize) and
           InRange(Y,CustomTop,CustomTop+GridCellSize) then
            Result := -2
        else
            Result := -1;
    end;
end;
{-- TMMColorPopup --------------------------------------------------------}
procedure TMMColorPopup.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
    Ind: Integer;
begin
    Ind := IndexAt(X,Y);
    if Ind <> -1 then
    begin
        SetIndex(Ind);
        CloseUp(True);
    end;
end;
{-- TMMColorPopup --------------------------------------------------------}
procedure TMMColorPopup.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    inherited MouseDown(Button,Shift,X,Y);
    if not InRange(X,0,Width) or not InRange(Y,0,Height) then
    begin
        CloseUp(False);
    end
    else if InRange(X,FButton.Left,FButton.Left+FButton.Width) and
            InRange(Y,FButton.Top,FButton.Top+FButton.Height) then
            FButton.Click;
end;
{-- TMMColorPopup --------------------------------------------------------}
procedure TMMColorPopup.KeyDown(var Key: Word; Shift: TShiftState);
var
    Col, Row: Integer;
begin
    if Key = VK_TAB then
    begin
        FButton.SetFocus;
        Key := 0;
        Exit;
    end;
    if (Key = VK_ESCAPE) or (Key = VK_RETURN) then
    begin
        CloseUp(Key = VK_RETURN);
        Key := 0;
        Exit;
    end;
    if FIndex = -1 then
        if FDrawCustom then
        begin
            Col := 3;
            Row := 5;
        end
        else
            Exit
    else
    begin
        Col := FIndex mod GridCols;
        Row := FIndex div GridCols;
    end;
    case Key of
        VK_LEFT : if Col > 0 then Dec(Col);
        VK_UP   : if Row > 0 then Dec(Row);
        VK_DOWN : if (Row < 4) or (FDrawCustom and (Col = 3) and (Row < 5)) then Inc(Row);
        VK_RIGHT: if Col < 3 then Inc(Col);
        VK_HOME : begin Col := 0; Row := 0; end;
        VK_END  : if FDrawCustom then
                  begin
                    Col := 3;
                    Row := 5;
                  end
                  else
                  begin
                    Col := 3;
                    Row := 4;
                  end;
    else
        Exit;
    end;
    Key := 0;
    if Row = 5 then
        SetIndex(-2)
    else
        SetIndex(Col+Row*GridCols);
end;
{-- TMMColorPopup --------------------------------------------------------}
procedure TMMColorPopup.SetIndex(Value: Integer);
begin
    if Value = -2 then Value := -1;
    FIndex := Value;
    Invalidate;
end;
{-- TMMColorPopup --------------------------------------------------------}
procedure TMMColorPopup.CustomClick(Sender: TObject);
begin
    CloseUp(False);
    PostMessage(ColorButton.Handle,MM_DROPCOLORDLG,0,0);
end;
{-- TMMColorPopup --------------------------------------------------------}
procedure TMMColorPopup.CustomExit(Sender: TObject);
begin
    CloseUp(False);
end;
{-- TMMColorPopup --------------------------------------------------------}
procedure TMMColorPopup.DropDown;
begin
    FSave := DisableTaskWindows(Handle);
    Show;
    SetFocus;
    FOpened := True;
    FColors[0]  := clWhite;
    FColors[1]  := clBlack;
    FColors[2]  := clLtGray;
    FColors[3]  := clDkGray;
    FColors[4]  := clRed;
    FColors[5]  := clMaroon;
    FColors[6]  := clYellow;
    FColors[7]  := clOlive;
    FColors[8]  := clLime;
    FColors[9]  := clGreen;
    FColors[10] := clAqua;
    FColors[11] := clTeal;
    FColors[12] := clBlue;
    FColors[13] := clNavy;
    FColors[14] := clFuchsia;
    FColors[15] := clPurple;
    FColors[16] := clMoneyGreen;
    FColors[17] := clSkyBlue;
    FColors[18] := clCream;
    FColors[19] := clMdGray;
    FIndex        := GetIndexByColor(ColorButton.Value);
    FDrawCustom   := ColorButton.ShowCurrent or (FIndex = -1);
    ButtonCaption := ColorButton.ButtonCaption;
    SetCaptureControl(Self);
end;
{-- TMMColorPopup --------------------------------------------------------}
procedure TMMColorPopup.CloseUp(OK: Boolean);
begin
    if not FOpened then
        Exit;
    EnableTaskWindows(FSave);
    SetCaptureControl(nil);
    Hide;
    FOpened := False;
    {$IFDEF WIN32}
    Windows.SetFocus(ColorButton.Handle);
    {$ELSE}
    WinProcs.SetFocus(ColorButton.Handle);
    {$ENDIF}
    if OK and (FIndex <> -1) then
        ColorButton.Value := GetColorByIndex(FIndex);
end;
{-- TMMColorPopup --------------------------------------------------------}
function TMMColorPopup.GetButtonCaption: string;
begin
    Result := FButton.Caption;
end;
{-- TMMColorPopup --------------------------------------------------------}
procedure TMMColorPopup.SetButtonCaption(Value: string);
begin
    FButton.Caption := Value;
end;
{== TMMCustomColorButton =================================================}
constructor TMMCustomColorButton.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    FButton         := TMMColorSpeedButton.Create(Self);
    FButton.Parent  := Self;
    FButton.Visible := True;
    FButton.OnMouseDown := BtnMouseDown;
    FButton.OnClick := BtnClick;
    FFocusColor     := clBlack;
    ButtonCaption   := '';
    FColorDlg       := TColorDialog.Create(Self);
    FColorDlg.Options := FColorDlg.Options + [cdFullOpen];
    Glyph           := nil;
    Value           := clBlack;
    Width           := 43;
    Height          := 21;
    TabStop         := True;
    ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
    if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;
{-- TMMCustomColorButton -------------------------------------------------}
function TMMCustomColorButton.Popup: TMMColorPopup;
begin
    if FPopup = nil then
    begin
        FPopup := TMMColorPopup.Create(Self);
        if GetParentForm(Self) <> nil then
        begin
           FPopup.Parent := Self;
        end
        {$IFDEF BUILD_ACTIVEX}
        else
        begin
           FPopup.ParentWindow := ParentWindow;
           FPopup.FButton.Parent := nil;
           FPopup.FButton.ParentWindow := FPopup.Handle;
        end;
        FPopup.SetDesigning(False);
        {$ENDIF}
    end;
    Result := FPopup;
end;
{-- TMMCustomColorButton -------------------------------------------------}
procedure TMMCustomColorButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
    inherited SetBounds(ALeft,ATop,AWidth,AHeight);
    FButton.SetBounds(0,0,AWidth,AHeight);
end;
{-- TMMCustomColorButton -------------------------------------------------}
procedure TMMCustomColorButton.SetFocusColor(Value: TColor);
begin
    if FFocusColor <> Value then
    begin
        FFocusColor := Value;
        Changed;
    end;
end;
{-- TMMCustomColorButton -------------------------------------------------}
procedure TMMCustomColorButton.WMSetFocus(var Message: TWMSetFocus);
begin
    Invalidate;
end;
{-- TMMCustomColorButton -------------------------------------------------}
procedure TMMCustomColorButton.WMKillFocus(var Message: TWMKillFocus);
begin
    Invalidate;
end;
{-- TMMCustomColorButton -------------------------------------------------}
procedure TMMCustomColorButton.CMEnabledChanged(var Message);
begin
    inherited;
    FButton.Enabled := Enabled;
end;
{-- TMMCustomColorButton -------------------------------------------------}
procedure TMMCustomColorButton.BtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    SetFocus;
end;
{-- TMMCustomColorButton -------------------------------------------------}
procedure TMMCustomColorButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
    if Key = VK_SPACE then
    begin
        ShowPopup;
        Key := 0;
    end;
end;
{-- TMMCustomColorButton -------------------------------------------------}
procedure TMMCustomColorButton.Change;
begin
    if csLoading in ComponentState then
        Exit;
    if Assigned(FOnChange) then FOnChange(Self);
end;
{-- TMMCustomColorButton -------------------------------------------------}
procedure TMMCustomColorButton.BtnClick(Sender: TObject);
begin
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
    ShowPopup;
end;
{-- TMMCustomColorButton -------------------------------------------------}
procedure TMMCustomColorButton.ShowPopup;
var
    P: TPoint;
begin
    P := ClientToScreen(Point(0,Height));
    Popup.Left := P.X;
    if P.Y + Popup.Height > Screen.Height then
        P.Y := P.Y - Popup.Height - Height;
    Popup.Top  := P.Y;
    Popup.DropDown;
end;
{-- TMMCustomColorButton -------------------------------------------------}
procedure TMMCustomColorButton.MMDropColorDlg(var Message);
begin
    with FColorDlg do
    begin
        Color := Value;
        if Execute then
            Value := Color;
    end;
end;
{-- TMMCustomColorButton -------------------------------------------------}
function TMMCustomColorButton.GetGlyph: TBitmap;
begin
    Result := FButton.Glyph;
end;
{-- TMMCustomColorButton -------------------------------------------------}
procedure TMMCustomColorButton.SetGlyph(Value: TBitmap);
begin
    if Value = nil then
        FButton.Glyph.Handle := LoadBitmap(HInstance,ButtonRes)
    else
        FButton.Glyph := Value;
end;
{-- TMMCustomColorButton -------------------------------------------------}
function TMMCustomColorButton.GetNumGlyphs: Integer;
begin
    Result := FButton.NumGlyphs;
end;
{-- TMMCustomColorButton -------------------------------------------------}
procedure TMMCustomColorButton.SetNumGlyphs(Value: Integer);
begin
    FButton.NumGlyphs := Value;
end;
{-- TMMCustomColorButton -------------------------------------------------}
procedure TMMCustomColorButton.SetValue(Value: TColor);
begin
    {$IFDEF WIN32}
    {$IFDEF TRIAL}
    {$DEFINE _HACK2}
    {$I MMHACK.INC}
    {$ENDIF}
    {$ENDIF}
    if FValue <> Value then
    begin
        FValue := Value;
        Changed;
        Change;
    end;
end;
{-- TMMCustomColorButton -------------------------------------------------}
function TMMCustomColorButton.GetCustomColors: TStrings;
begin
    Result := FColorDlg.CustomColors;
end;
{-- TMMCustomColorButton -------------------------------------------------}
procedure TMMCustomColorButton.SetCustomColors(Value: TStrings);
begin
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
    FColorDlg.CustomColors := Value;
end;
{-- TMMCustomColorButton -------------------------------------------------}
procedure TMMCustomColorButton.SetButtonCaption(Value: string);
begin
    if Value = '' then
        Value := '&Other...';
    if FButtonCaption <> Value then
    begin
        FButtonCaption := Value;
        if (FPopup <> nil) and FPopup.Visible then
            Popup.ButtonCaption := Value;
    end;
end;
end.

						