cxbuttons.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,149 行 · 第 1/5 页

      if (AButtonMenuState = cxbsPressed) then
        if FIsFocused then
          AButtonMenuState := cxbsHot
        else
          AButtonMenuState := cxbsNormal;
    GetPainterClass.DrawButton(FCanvas, ATempRect, '', AButtonMenuState, True, AColor, FCanvas.Font.Color);
    GetPainterClass.DrawScrollBarArrow(FCanvas, ATempRect, AButtonMenuState, adDown);
  end;

  if CanFocus then
    if Focused and not FMenuVisible then
      FCanvas.DrawFocusRect(GetPainterClass.ButtonFocusRect(FCanvas, R));
end;

procedure TcxCustomButton.InternalRecreateWindow;
begin
  RecreateWnd;
end;

function TcxCustomButton.IsColorsStored: Boolean;
begin
  Result := FColors.AssignedColors <> [];
end;

function TcxCustomButton.IsHotTrack: Boolean;
begin
  Result := not StandardButton and GetPainterClass.IsButtonHotTrack and Enabled;
end;

procedure TcxCustomButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  inherited ActionChange(Sender, CheckDefaults);
  UpdateImageInfo;
end;

function TcxCustomButton.CanResize(var NewWidth, NewHeight: Integer): Boolean;
begin
  if AutoSize then
    with GetOptimalSize do
    begin
      NewWidth := cx;
      NewHeight := cy;
    end;
  Result := inherited CanResize(NewWidth, NewHeight);
end;

function TcxCustomButton.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TcxButtonActionLink;
end;

procedure TcxCustomButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if FKind = cxbkDropDownButton then
    if (Key in [VK_UP, VK_DOWN]) and
      ((ssAlt in Shift) or (ssShift in Shift)) then
    begin
      if not FMenuVisible then DoDropDownMenu;
      Key := 0;
      Exit
    end;
  inherited;
end;

procedure TcxCustomButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) then
  begin
    FLockDown := SpeedButtonMode;
    if Kind <> cxbkStandard then
      CheckShowMenu(Point(X, Y));
    FIsPressed := not PtInRect(GetMenuButtonBounds, Point(X, Y));
    Invalidate;
  end;
end;

procedure TcxCustomButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  if not FMouseInControl and IsHotTrack and PtInRect(ClientRect, Point(X, Y)) and
    (GetCapture = 0) then
      Perform(CM_MOUSEENTER, 0, 0);
end;

procedure TcxCustomButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  ALockDown: Boolean;
begin
  if (Button = mbLeft) and FLockDown and (GroupIndex <> 0) then
    SetDown(not FDown);
  ALockDown := FLockDown;
  inherited MouseUp(Button, Shift, X, Y);
  if (Button = mbLeft) and SpeedButtonMode then
  begin
    if ALockDown then
      Click;
    if FGroupIndex = 0 then
    begin
      FLockDown := False;
      FIsPressed := False;
    end;
    Invalidate;
  end;
end;

procedure TcxCustomButton.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FDropDownMenu then
      FDropDownMenu := nil
    else
      if AComponent = PopupMenu then
        PopupMenu := nil;
  end;
end;

procedure TcxCustomButton.DrawItem(const DrawItemStruct: TDrawItemStruct);
begin
  FCanvas.Canvas.Handle := DrawItemStruct.hDC;
  with DrawItemStruct do
  begin
    if not FLockDown then
      FIsPressed := itemState and ODS_SELECTED <> 0
    else
      FIsPressed := SpeedButtonMode and FIsPressed;
    FIsDefault := (itemState and ODS_FOCUS <> 0) or
     (Default and (csDesigning in ComponentState));
  end;
  InternalPaint;
  FCanvas.Canvas.Handle := 0;
end;

procedure TcxCustomButton.UpdateImageInfo;

  function GetImageList: TCustomImageList;
  begin
    if (Action is TCustomAction) and (TCustomAction(Action).ActionList <> nil) then
      Result := TCustomAction(Action).ActionList.Images
    else
      Result := nil;
  end;

  function GetImageIndex: Integer;
  begin
    if Action is TCustomAction then
      Result := TCustomAction(Action).ImageIndex
    else
      Result := -1;
  end;

begin
  FGlyph.ImageList := GetImageList;
  FGlyph.ImageIndex := GetImageIndex;
end;

procedure TcxCustomButton.WMCaptureChanged(var Message: TMessage);
var
  P: TPoint;
begin
  inherited;
  if csDesigning in ComponentState then Exit;
  GetCursorPos(P);
  FMouseInControl := IsHotTrack and (WindowFromPoint(P) = Handle);
end;

procedure TcxCustomButton.WMContextMenu(var Message: TWMContextMenu);
var
  AHandled: Boolean;
  P, P1: TPoint;
begin
  if Message.Result <> 0 then
    Exit;
  if csDesigning in ComponentState then
  begin
    inherited;
    Exit;
  end;

  P := SmallPointToPoint(Message.Pos);
  if (P.X = -1) and (P.Y = -1) then
    P1 := P
  else
  begin
    P1 := ScreenToClient(P);
    if not PtInRect(ClientRect, P1) then
    begin
      inherited;
      Exit;
    end;
  end;

  AHandled := False;
  DoContextPopup(P1, AHandled);
  Message.Result := Ord(AHandled);
  if not AHandled then
    inherited;
end;

procedure TcxCustomButton.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
{$IFNDEF DELPHI7}
  if (csDestroying in ComponentState) or StandardButton or
    (GetPainterClass = TcxWinXPLookAndFeelPainter) then
      inherited
  else
{$ENDIF}
    Message.Result := 1;
end;

procedure TcxCustomButton.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  Perform(WM_LBUTTONDOWN, Message.Keys,
    LPARAM(Word(Message.XPos) or (Word(Message.YPos) shr 16)));
end;

procedure TcxCustomButton.WMLButtonDown(var Message: TWMLButtonDown);
var
  R: TRect;
begin
  if FKind = cxbkDropDownButton then
  begin
    R := ClientRect;
    R.Left := R.Right - cxDropDownButtonWidth;
    if PtInRect(R, Point(Message.XPos, Message.YPos)) then
      FLockDown := True;
  end;
  inherited;
end;

procedure TcxCustomButton.CMCloseupPopupMenu(var Message: TMessage);
var
  P: TPoint;
begin
  GetCursorPos(P);
  FMouseInControl := IsHotTrack and (WindowFromPoint(P) = Handle);
  FMenuVisible := False;
  Repaint;
  if not SpeedButtonMode then
    FLockDown := False;
end;

procedure TcxCustomButton.CMDialogChar(var Message: TCMDialogChar);
begin
  if IsAccel(Message.CharCode, Caption) and inherited CanFocus then
  begin
    Click;
    Message.Result := 1;
  end
  else
    inherited;
end;

procedure TcxCustomButton.CMDropDownPopupMenu(var Message: TMessage);
var
  P: TPoint;
  APopupAlignment: TPopupAlignment;
  APopupMenu: TPopupMenu;
begin
  if (Kind <> cxbkStandard) then
  begin
    APopupMenu := FDropDownMenu;
    if DoOnDropDownMenuPopup(APopupMenu) or (APopupMenu = nil) then
      Exit;
    FMenuVisible := True;
    Repaint;
    P := GetDropDownMenuPopupPoint(APopupMenu);
    APopupAlignment := APopupMenu.Alignment;
    try
      APopupMenu.Alignment := GetDropDownMenuAlignment(P, FPopupAlignment);
      APopupMenu.PopupComponent := Self;
      APopupMenu.Popup(P.X, P.Y);
    finally
      APopupMenu.Alignment := APopupAlignment;
    end;
    PostMessage(Handle, CM_CLOSEUPPOPUPMENU, 0, 0);
  end;
end;

procedure TcxCustomButton.CMFontChanged(var Message: TMessage);
begin
  inherited;
  UpdateSize;
  Invalidate;
end;

procedure TcxCustomButton.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  if not Enabled then FMouseInControl := False;
  Invalidate;
end;

procedure TcxCustomButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
{$IFDEF DELPHI7}
  if csDesigning in ComponentState then Exit;
{$ENDIF}
  if not FMouseInControl and IsHotTrack and (GetCapture = 0) then
  begin
    BeginMouseTracking(Self, Rect(0, 0, Width, Height), Self);
    FMouseInControl := True;
    Repaint;
  end;
end;

procedure TcxCustomButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
{$IFDEF DELPHI7}
  if csDesigning in ComponentState then Exit;
{$ENDIF}
  EndMouseTracking(Self);
  FLockDown := FMenuVisible; 
  if FMouseInControl and IsHotTrack then
  begin
    FMouseInControl := False;
    Invalidate;
  end;
end;

procedure TcxCustomButton.CNDrawItem(var Message: TWMDrawItem);
begin
  if not(csDestroying in ComponentState) then
    DrawItem(Message.DrawItemStruct^);
end;

procedure TcxCustomButton.CNKeyDown(var Message: TWMKeyDown);
begin
  if IsPopupMenuShortCut(PopupMenu, Message) then
    Message.Result := 1
  else
    inherited;
end;

procedure TcxCustomButton.CNMeasureItem(var Message: TWMMeasureItem);
var
  ATempVar: TMeasureItemStruct;
begin
  ATempVar := Message.MeasureItemStruct^;
  ATempVar.itemWidth := Width;
  ATempVar.itemHeight := Height;
  Message.MeasureItemStruct^ := ATempVar;
end;

procedure TcxCustomButton.CNSysKeyDown(var Message: TWMSysKeyDown);
begin
  if IsPopupMenuShortCut(PopupMenu, Message) then
    Message.Result := 1
  else
    inherited;
end;

procedure TcxCustomButton.CMButtonPressed(var Message: TMessage);
var
  ASender: TcxButton;
begin
  if SpeedButtonMode then
  begin
    if (Message.WParam = FGroupIndex) and (FGroupIndex <> 0) then
    begin
      ASender := TcxButton(Message.LParam);
      if ASender <> Self then
      begin
        FAllowAllUp := ASender.AllowAllUp;
        FCanBeFocused := ASender.CanBeFocused;
        if ASender.Down and FDown then
        begin
          FDown := False;
          if (Action is TCustomAction) then
            TCustomAction(Action).Checked := False;
          Invalidate;
        end;
      end;
    end;
  end;
end;

procedure TcxCustomButton.CreateHandle;
var
  AState: TcxButtonState;
begin
  if Enabled then
    AState := cxbsNormal
  else
    AState := cxbsDisabled;
  inherited CreateHandle;
  FGlyph.CreateButtonGlyph(AState);
end;

procedure TcxCustomButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if not StandardButton then
    with Params do Style := Style or BS_OWNERDRAW;
end;

procedure TcxCustomButton.DestroyWindowHandle;
begin
  if FMenuVisible then
    SendMessage(Handle, CM_CLOSEUPPOPUPMENU, 0, 0);
  inherited DestroyWindowHandle;
end;

function TcxCustomButton.GetPalette: HPALETTE;
begin
  Result := Glyph.Palette;
end;

procedure TcxCustomButton.SetButtonStyle(ADefault: Boolean);
begin
  if StandardButton then
    inherited SetButtonStyle(ADefault)
  else
    if ADefault <> FIsFocused then
    begin
      FIsFocused := ADefault;
      Refresh;
    end;
end;

end.