actnctrls.pas

这是不可多得的源代码

end;

procedure TCustomButtonControl.SetDown(Value: Boolean);
begin
  if not IsGrouped then Value := False;
  if Value <> FDown then
  begin
    if FDown and (not FAllowAllUp) then Exit;
    FDown := Value;
    if Value then
    begin
      if FState = bsUp then Invalidate;
      FState := bsExclusive
    end
    else
    begin
      FState := bsUp;
      Repaint;
    end;
  end;
end;

procedure TCustomButtonControl.SetFlat(const Value: Boolean);
begin
  if FFlat <> Value then
  begin
    FFlat := Value;
    Invalidate;
  end;
end;

procedure TCustomButtonControl.SetSelected(Value: Boolean);
const
  StateFlag: array[Boolean] of TButtonState = (bsUp, bsDown);
begin
  inherited SetSelected(Value);
  State := StateFlag[Value];
  FMouseInControl := False;
end;

procedure TCustomButtonControl.SetState(const Value: TButtonState);
begin
  if FState <> Value then
  begin
    FState := Value;
    Invalidate;
  end;
end;

procedure TCustomButtonControl.SetBounds(ALeft, ATop, AWidth,
  AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  CalcLayout;
end;

procedure TCustomButtonControl.UpdateTracking;
var
  P: TPoint;
begin
  if not (csDestroying in ComponentState) and FFlat and Enabled then
  begin
    GetCursorPos(P);
    FMouseInControl := FindDragTarget(P, True) = Self;
    Invalidate;
{    if MouseInControl then
      Perform(CM_MOUSELEAVE, 0, 0)
    else
      Perform(CM_MOUSEENTER, 0, 0);}
  end;
end;

procedure TCustomButtonControl.WMLButtonDblClk(var Message: TWMLButtonDown);
begin
  inherited;
  if FDown then DblClick;
end;

procedure TCustomButtonControl.SetGlyphLayout(const Value: TButtonLayout);
begin
  inherited;
  Spacing := 4;
end;

procedure TCustomButtonControl.DrawLargeGlyph(Location: TPoint);
var
  NewLocation: TPoint;
begin
  NewLocation := Location;
  if not (csDesigning in ComponentState) and ((FState = bsDown) or IsChecked) then
  begin
    Inc(NewLocation.X);
    Inc(NewLocation.Y);
  end;
  inherited DrawLargeGlyph(NewLocation);
end;

procedure TCustomButtonControl.CMDialogChar(var Message: TCMDialogChar);
begin
{  with Message do
    if IsAccel(CharCode, Caption) and Enabled and Visible and
      (Parent <> nil) and Parent.Showing then
    begin
      Click;
      Result := 1;
    end else}
      inherited;
end;

{ TCustomUtilityButton }

const
  Offset: array[Boolean] of Integer = (0, 1);

constructor TCustomUtilityButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAutoScroll := False;
  FArrowSize := 2;
  FArrowType := atArrows;
  FScrollTimer := TTimer.Create(Self);
  with FScrollTimer do
  begin
    Enabled := False;
    OnTimer := OnDelay;
    Interval := 750;
  end;
end;

destructor TCustomUtilityButton.Destroy;
begin
  FScrollTimer.Free;
  inherited Destroy;
end;

procedure TCustomUtilityButton.Click;
begin
  if Assigned(FOnClick) then
    FOnClick(Self);
end;

procedure TCustomUtilityButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if FAutoScroll then
    FScrollTimer.Enabled := True;
end;

procedure TCustomUtilityButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  FScrollTimer.Enabled := False;
end;

procedure TCustomUtilityButton.DrawArrows;
var
  P: TPoint;
  FDown: Boolean;
  FState: TButtonState;
begin
  FState := bsUp;
  FDown := False;
  case FDirection of
    sdUp,
    sdDown : P := Point(Width div 2 - FArrowSize + Offset[FDown],
                        Height div 2 - (FArrowSize div 2) + Offset[FState = bsDown]);
    sdRight,
    sdLeft : P := Point(Width div 2 - FArrowSize div 2 + Offset[FState = bsDown],
                        Height div 2 - FArrowSize + Offset[FState = bsDown]);
  end;
  case FArrowType of
    atSolid : DrawArrow(Canvas, FDirection, P, FArrowSize);
    atArrows: DrawChevron(Canvas, FDirection, P, FArrowSize);
  end;
end;

procedure TCustomUtilityButton.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    FScrollTimer.Enabled := False;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TCustomUtilityButton.OnDelay(Sender: TObject);
begin
  FScrollTimer.Enabled := FAutoScroll;
  if FAutoScroll then
    FScrollTimer.Interval := RepeatRate;
  Click;
end;

procedure TCustomUtilityButton.SetArrowSize(const Value: Integer);
begin
  if FArrowSize <> Value then
  begin
    FArrowSize := Value;
    Invalidate;
  end;
end;

procedure TCustomUtilityButton.SetArrowType(const Value: TArrowType);
begin
  if FArrowType <> Value then
  begin
    FArrowType := Value;
    Invalidate;
  end;
end;

procedure TCustomUtilityButton.SetDirection(const Value: TScrollDirection);
begin
  if FDirection <> Value then
  begin
    FDirection := Value;
    Invalidate;
  end;
end;

procedure TCustomUtilityButton.Paint;
begin
  inherited Paint;
  Canvas.Pen.Color := ActionBar.ColorMap.FontColor;
  DrawArrows;
end;

{ TCustomToolScrollBtn }

constructor TCustomToolScrollBtn.Create(AOwner: TComponent);
begin
  inherited;
  Hint := SMoreButtons;
end;

procedure TCustomToolScrollBtn.DrawArrows;
const
  ArrowDirection: array[TAlign] of TScrollDirection = (sdDown, sdUp,
    sdDown, sdDown, sdDown, sdDown, sdDown);
var
  P: TPoint;
begin
  case FDirection of
    sdUp,
    sdDown : P := Point(Width div 2 - FArrowSize, 3);
    sdRight,
    sdLeft : P := Point(Width div 2 - FArrowSize div 2, 3);
  end;
  if Enabled then
    Canvas.Pen.Color := ActionBar.ColorMap.FontColor
  else
    Canvas.Pen.Color := ActionBar.ColorMap.DisabledFontColor;
  if Parent is TCustomActionToolBar then
    if TCustomActionToolBar(Parent).HiddenCount > 0 then
      DrawChevron(Canvas, Direction, P, FArrowSize);
  DrawArrow(Canvas, ArrowDirection[Align], Point(Width div 2 - FArrowSize, Height - 8), 2);
end;

{ TCustomDropDownButton }

const
  cDropDownButtonWidth = 9;

procedure TCustomDropDownButton.CalcBounds;
begin
  inherited CalcBounds;
  Width := Width + cDropDownButtonWidth;
end;

procedure TCustomDropDownButton.Click;
begin
  if MouseOverDropDown then
    DropDownClick
  else
    inherited Click;
end;

procedure TCustomDropDownButton.CMMouseleave(var Message: TMessage);
begin
  inherited;
  FDroppedDown := False;
end;

procedure TCustomDropDownButton.DrawFrame(ARect: TRect; Down: Boolean);
begin
  Dec(ARect.Right, 9);
  inherited DrawFrame(ARect, Down and not MouseOverDropDown);
  ARect.Left := ARect.Right;
  Inc(ARect.Right, 9);
  inherited DrawFrame(ARect, Down or FDroppedDown);
end;

procedure TCustomDropDownButton.DropDownClick;
var
  Popup: TCustomActionPopupMenu;
  P: TPoint;
begin
  Popup := GetPopupClass.Create(nil) as TCustomActionPopupMenu;
  try
    Popup.ActionClient := ActionClient;
    P := ClientToScreen(Point(Left, Top + Height));
    Popup.ParentControl := Self;
    FDroppedDown := True;
    try
      Flat := False;
      Popup.Popup(P.X - Left, P.Y);
    finally
      FDroppedDown := False;
      Flat := True;
    end;
  finally
    Popup.Free;
  end;
end;

function TCustomDropDownButton.GetPopupClass: TCustomActionBarClass;
begin
  with ActionBar.Style as TActionBarStyleEx do
    Result := GetPopupClass(ActionBar);
end;

procedure TCustomDropDownButton.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if MouseOverDropDown then
    FState := bsUp;
  if Button = mbLeft then
    FDroppedDown := True;
end;

function TCustomDropDownButton.MouseOverDropDown: Boolean;
begin
  Result := PtInRect(Rect(ClientWidth - cDropDownButtonWidth, 0, ClientWidth,
    ClientHeight), ScreenToClient(Mouse.CursorPos));
end;

procedure TCustomDropDownButton.Paint;
begin
  inherited Paint;
  Canvas.Pen.Color := clBlack;
  DrawArrow(Canvas, sdDown, Point((ClientWidth - cDropDownButtonWidth div 2) - 3,
    ClientHeight div 2 - 1), 2);
end;

{ TCustomActionBarCombo }

type
  TControlClassType = class(TControl);

procedure TCustomActionCombo.BeginAutoDrag;
begin
  FComboControl.BeginAutoDrag;
end;

function TCustomActionCombo.DesignWndProc(var Message: TMessage): Boolean;
begin
  Result := inherited DesignWndProc(Message);
  case Message.Msg of
    WM_LBUTTONDOWN:
        Result := True;
  end;
end;

procedure TCustomActionCombo.DragDrop(Source: TObject; X, Y: Integer);
begin
  FComboControl.DoDragDrop(Source, X, Y);
end;

procedure TCustomActionCombo.DragOver(Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  inherited;
  Accept := Assigned(FComboControl.ActionClient) and (Source is TActionDragObject) or
    (Source is TActionItemDragObject) or (Source is TCategoryDragObject);
end;

{ TCustomComboControl }

type
  TCustomComboType = class(TCustomCombo);

constructor TCustomComboControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FComboBox := TCustomActionCombo.Create(Self);
  ComboBox.TabStop := False;
  ComboBox.Width := 100;
  TCustomComboType(ComboBox).OnClick := ComboClick;
  ComboBox.FComboControl := Self;
  if csDesigning in FComboBox.ComponentState then
    ComboBox.DragMode := dmAutomatic;
end;

destructor TCustomComboControl.Destroy;
begin
  FreeAndNil(FComboBox);
  inherited Destroy;
end;

procedure TCustomComboControl.CalcBounds;
begin
  inherited CalcBounds;
  if ComboBox.HandleAllocated then
    if ShowCaption then
      Width := Width + ComboBox.Width
    else
      Width := ComboBox.Width;
end;

procedure TCustomComboControl.Click;
begin
  if csDesigning in ComponentState then
    SetSelected(True);
  inherited Click;
end;

procedure TCustomComboControl.CMVisiblechanged(var Message: TMessage);
begin
  inherited;
  ComboBox.Visible := Visible;
end;

procedure TCustomComboControl.ComboClick(Sender: TObject);
begin
  if Assigned(ActionBar) and not ActionBar.DesignMode then
    Click;
end;

procedure TCustomActionCombo.ComboWndProc(var Message: TMessage;
  ComboWnd: HWND; ComboProc: Pointer);
begin
  if DragMode = dmAutomatic then
    case Message.Msg of
      WM_KEYFIRST..WM_KEYLAST: exit;
    end;
  inherited ComboWndProc(Message, ComboWnd, ComboProc);
end;

procedure TCustomComboControl.Paint;
begin
  inherited Paint;
  if Assigned(ComboBox) and ComboBox.HandleAllocated then
    ComboBox.Invalidate;
end;

procedure TCustomComboControl.SetActionClient(Value: TActionClientItem);
begin
  inherited SetActionClient(Value);
  if Assigned(Value) and (Value.Action <> ComboBox.Action) then
    ComboBox.Action := Value.Action;
end;

procedure TCustomComboControl.SetBounds(ALeft, ATop, AWidth,
  AHeight: Integer);
var
  T: Integer;
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if Assigned(FComboBox) then
  begin
    T := Top + (Height div 2) - (ComboBox.Height div 2);
    if ShowCaption then
      ComboBox.SetBounds(ALeft + TextBounds.Right + 5, T, ComboBox.Width,
        ComboBox.Height)
    else
      ComboBox.SetBounds(ALeft, T, Width, ComboBox.Height);
  end;
  CalcLayout;
end;

procedure TCustomComboControl.SetDragMode(Value: TDragMode);
begin
  inherited SetDragMode(Value);
  ComboBox.DragMode := Value;
end;

procedure TCustomComboControl.SetParent(AParent: TWinControl);
begin
  if Assigned(ComboBox) then
    ComboBox.Parent := AParent;
  inherited SetParent(AParent);
end;

procedure TCustomComboControl.VisibleChanging;
begin
  inherited VisibleChanging;