mmclrbtn.pas

一套及时通讯的原码

            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.