{%MainUnit ../buttons.pp} {****************************************************************************** TCustomSpeedButton ****************************************************************************** ***************************************************************************** * * * This file is part of the Lazarus Component Library (LCL) * * * * See the file COPYING.modifiedLGPL, included in this distribution, * * for details about the copyright. * * * * This program is distributed in the hope that it will be useful, * * but WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * * ***************************************************************************** } {$IFOPT C-} // Uncomment for local trace // {$C+} // {$DEFINE ASSERT_IS_ON} {$ENDIF} {------------------------------------------------------------------------------ Method: TCustomSpeedButton.Create Params: none Returns: Nothing Constructor for the class. ------------------------------------------------------------------------------} constructor TCustomSpeedButton.Create(AOwner: TComponent); begin Inherited Create(AOwner); FCompStyle := csSpeedButton; FGlyph := TButtonGlyph.Create; FGlyph.OnChange := @GlyphChanged; SetInitialBounds(0, 0, 23, 22); ControlStyle := ControlStyle + [csCaptureMouse]-[csSetCaption, csClickEvents]; FLayout:= blGlyphLeft; FAllowAllUp:= false; FMouseInControl := False; FDragging := False; FShowAccelChar:=true; FSpacing := 4; FMargin := -1; FTransparent := true; Color := clBtnFace; FShowCaption := true; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.Destroy Params: None Returns: Nothing Destructor for the class. ------------------------------------------------------------------------------} destructor TCustomSpeedButton.Destroy; begin FreeAndNil(FGlyph); inherited Destroy; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.FindDownButton: TCustomSpeedButton; Searches the speed button with Down=true and the same GroupIndex. ------------------------------------------------------------------------------} function TCustomSpeedButton.FindDownButton: TCustomSpeedButton; function FindDown(AWinControl: TWinControl): TCustomSpeedButton; var i: Integer; Child: TControl; Button: TCustomSpeedButton; begin if AWinControl=nil then exit(nil); for i:=0 to AWinControl.ControlCount-1 do begin Child:=AWinControl.Controls[i]; if Child is TCustomSpeedButton then begin Button:=TCustomSpeedButton(Child); if (Button.GroupIndex=GroupIndex) and (Button.Down) then exit(Button); end; if Child is TWinControl then begin Result:=FindDown(TWinControl(Child)); if Result<>nil then exit; end; end; Result:=nil; end; begin if Down or (GroupIndex=0) then exit(Self); Result:=FindDown(GetFirstParentForm(Self)); end; procedure TCustomSpeedButton.Click; begin inherited Click; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.SetAllowAllUp Params: Value: Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.SetAllowAllUp(Value : Boolean); begin if FAllowAllUp <> Value then begin FAllowAllUp := Value; UpdateExclusive; end; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.SetDown Params: Value: Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.SetDown(Value : Boolean); var OldState: TButtonState; OldDown: Boolean; begin //since Down needs GroupIndex, then we need to wait that all properties //loaded before we continue if (csLoading in ComponentState) then begin FDownLoaded := Value; exit; end else begin if FGroupIndex = 0 then Value:= false; if FDown <> Value then begin if FDown and not FAllowAllUp then Exit; OldDown:=FDown; FDown := Value; OldState := fState; if FDown then begin fState := bsExclusive; end else begin FState := bsUp; end; if (OldDown<>FDown) or (OldState<>FState) then Invalidate; if Value then begin UpdateExclusive; end; end; end; end; procedure TCustomSpeedButton.SetEnabled(NewEnabled: boolean); begin inherited; UpdateState(true); end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.SetFlat Params: Value: Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.SetFlat(const Value : boolean); begin if FFlat <> Value then begin FFlat := Value; Invalidate; end; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.SetGlyph Params: Value: Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.SetGlyph(Value : TBitmap); begin FGlyph.Glyph := Value; Invalidate; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.SetGroupIndex Params: Value: Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.SetGroupIndex(const Value : Integer); begin if FGroupIndex <> Value then begin FGroupIndex := Value; UpdateExclusive; end; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.SetMargin Params: Value: Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.SetMargin(const Value : Integer); begin if FMargin <> Value then begin FMargin := Value; Invalidate; end; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.SetNumGlyphs Params: Value : Integer = Number of glyphs in the file/resource Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.SetNumGlyphs(Value : integer); Begin if Value < 0 then Value := 1; if Value > 4 then Value := 4; if Value <> TButtonGlyph(fGlyph).NumGlyphs then Begin TButtonGlyph(fGlyph).NumGlyphs := TNumGlyphs(Value); Invalidate; end; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.SetSpacing Params: Value: Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.SetSpacing(const Value : Integer); begin if FSpacing <> Value then begin FSpacing := Value; Invalidate; end; end; Procedure TCustomSpeedButton.SetShowAccelChar(Value : Boolean); begin If FShowAccelChar <> Value then begin FShowAccelChar := Value; Invalidate; end; end; {------------------------------------------------------------------------------ procedure TCustomSpeedButton.RealSetText(const Value: TCaption); ------------------------------------------------------------------------------} procedure TCustomSpeedButton.RealSetText(const Value: TCaption); begin if Caption = Value then Exit; inherited RealSetText(Value); Invalidate; end; {------------------------------------------------------------------------------ procedure TCustomSpeedButton.UpdateState(InvalidateOnChange: boolean); ------------------------------------------------------------------------------} procedure TCustomSpeedButton.UpdateState(InvalidateOnChange: boolean); var OldState: TButtonState; begin OldState:=FState; if not Enabled then begin FState := bsDisabled; FDragging := False; end else begin if FState = bsDisabled then begin if FDown and (GroupIndex <> 0) then FState := bsExclusive else FState := bsUp; end else if (FState = bsDown) and (not FMouseInControl) and (not FDragging) and (not FDown) then begin // return to normal FState := bsUp; end; end; if FState<>OldState then if (Action is TCustomAction) then TCustomAction(Action).Checked := FState=bsDown; if InvalidateOnChange and ( (FState<>OldState) or not ThemedElementDetailsEqual(FLastDrawDetails, GetDrawDetails) ) then Invalidate; end; {------------------------------------------------------------------------------ function TCustomSpeedButton.GetDrawDetails: TThemedElementDetails; ------------------------------------------------------------------------------} function TCustomSpeedButton.GetDrawDetails: TThemedElementDetails; function ButtonPart: TThemedButton; begin // tbPushButtonNormal, tbPushButtonHot, tbPushButtonPressed, // tbPushButtonDisabled, tbPushButtonDefaulted // no check states available Result := tbPushButtonNormal; if not Enabled then Result := tbPushButtonDisabled else if FState in [bsDown, bsExclusive] then Result := tbPushButtonPressed else if fMouseInControl then Result := tbPushButtonHot else Result := tbPushButtonNormal end; function ToolButtonPart: TThemedToolBar; begin // ttbButtonNormal, ttbButtonHot, ttbButtonPressed, ttbButtonDisabled // ttbButtonChecked, ttbButtonCheckedHot if not Enabled then Result := ttbButtonDisabled else begin if Down then begin // checked states if fMouseInControl then Result := ttbButtonCheckedHot else Result := ttbButtonChecked end else begin if FState in [bsDown, bsExclusive] then Result := ttbButtonPressed else if fMouseInControl then Result := ttbButtonHot else Result := ttbButtonNormal end; end; end; begin if Flat then Result := ThemeServices.GetElementDetails(ToolButtonPart) else Result := ThemeServices.GetElementDetails(ButtonPart) end; procedure TCustomSpeedButton.ActionChange(Sender: TObject; CheckDefaults: Boolean); procedure CopyImage(ImageList: TCustomImageList; Index: Integer); begin ImageList.GetBitmap(Index, Glyph); end; begin inherited ActionChange(Sender,CheckDefaults); if Sender is TCustomAction then begin with TCustomAction(Sender) do begin if CheckDefaults or (Self.GroupIndex = 0) then Self.GroupIndex := GroupIndex; if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then CopyImage(ActionList.Images,ImageIndex); end; end; end; function TCustomSpeedButton.GetActionLinkClass: TControlActionLinkClass; begin Result := TSpeedButtonActionLink; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.UpdateExclusive Params: none Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.UpdateExclusive; var msg : TLMessage; begin if (FGroupIndex <> 0) and (Parent <> nil) and (not (csLoading in ComponentState)) then begin Msg.Msg := CM_ButtonPressed; Msg.WParam := FGroupIndex; Msg.LParam := PtrInt(Self); Msg.Result := 0; Parent.Broadcast(Msg); end; end; {------------------------------------------------------------------------------ Function: TCustomSpeedButton.GetGlyph Params: none Returns: The bitmap ------------------------------------------------------------------------------} function TCustomSpeedButton.GetGlyph : TBitmap; begin Result := FGlyph.Glyph; end; procedure TCustomSpeedButton.SetShowCaption(const AValue: boolean); begin if FShowCaption=AValue then exit; FShowCaption:=AValue; invalidate; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.GetNumGlyphs Params: none Returns: The number stored in TButtonGlyph(FGlyph).NumGlyphs ------------------------------------------------------------------------------} Function TCustomSpeedButton.GetNumGlyphs : Integer; Begin Result := TButtonGlyph(fGlyph).NumGlyphs; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.GlyphChanged Params: Sender - The glyph that changed Returns: zippo ------------------------------------------------------------------------------} Procedure TCustomSpeedButton.GlyphChanged(Sender : TObject); Begin //redraw the button; Invalidate; end; function TCustomSpeedButton.DialogChar(var Message: TLMKey): boolean; begin Result := false; Assert(Message.Msg = LM_SYSCHAR, '*** Warning: non LM_SYSCHAR passed to TCustomSpeedButton.DialogChar ! ***'); if not FShowAccelChar then exit; if IsAccel(Message.CharCode, Caption) then begin Result := true; Self.Click; end else Result := inherited DialogChar(Message); end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.Paint Params: none Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.Paint; var PaintRect: TRect; GlyphWidth, GlyphHeight: Integer; Offset, OffsetCap: TPoint; ClientSize, TotalSize, TextSize, GlyphSize: TSize; M, S : integer; SIndex : Longint; TMP : String; begin {$IFDEF VerboseBug1152} DebugLn(['TCustomSpeedButton.Paint ',DbgSName(Self)]); {$ENDIF} UpdateState(false); if FGlyph=nil then exit; PaintRect:=ClientRect; FLastDrawDetails := GetDrawDetails; if not Transparent and ThemeServices.HasTransparentParts(FLastDrawDetails) then begin Canvas.Brush.Color := Color; Canvas.FillRect(PaintRect); end; ThemeServices.DrawElement(Canvas.Handle, FLastDrawDetails, PaintRect); PaintRect := ThemeServices.ContentRect(Canvas.Handle, FLastDrawDetails, PaintRect); GlyphSize := GetGlyphSize(PaintRect); GlyphWidth := GlyphSize.CX; if TButtonGlyph(FGlyph).NumGlyphs > 1 then GlyphWidth:=GlyphWidth div NumGlyphs; GlyphHeight := GlyphSize.CY; ClientSize.cx:= PaintRect.Right - PaintRect.Left; ClientSize.cy:= PaintRect.Bottom - PaintRect.Top; TextSize := GetTextSize(PaintRect); if Caption <> '' then begin TMP := Caption; SIndex := DeleteAmpersands(TMP); If SIndex > 0 then If SIndex <= Length(TMP) then begin FShortcut := Ord(TMP[SIndex]); end; end; if (GlyphWidth = 0) or (GlyphHeight = 0) or (TextSize.cx = 0) or (TextSize.cy = 0) then S:= 0 else S:= Spacing; // Calculate caption and glyph layout if Margin = -1 then begin if S = -1 then begin TotalSize.cx:= TextSize.cx + GlyphWidth; TotalSize.cy:= TextSize.cy + GlyphHeight; if Layout in [blGlyphLeft, blGlyphRight] then M:= (ClientSize.cx - TotalSize.cx) div 3 else M:= (ClientSize.cy - TotalSize.cy) div 3; S:= M; end else begin TotalSize.cx:= GlyphWidth + S + TextSize.cx; TotalSize.cy:= GlyphHeight + S + TextSize.cy; if Layout in [blGlyphLeft, blGlyphRight] then M:= (ClientSize.cx - TotalSize.cx) div 2 else M:= (ClientSize.cy - TotalSize.cy) div 2; end; end else begin if S = -1 then begin TotalSize.cx:= ClientSize.cx - (Margin + GlyphWidth); TotalSize.cy:= ClientSize.cy - (Margin + GlyphHeight); if Layout in [blGlyphLeft, blGlyphRight] then S:= (TotalSize.cx - TextSize.cx) div 2 else S:= (TotalSize.cy - TextSize.cy) div 2; end; M:= Margin; end; case Layout of blGlyphLeft : begin Offset.X:= M; Offset.Y:= (ClientSize.cy - GlyphHeight) div 2; OffsetCap.X:= Offset.X + GlyphWidth + S; OffsetCap.Y:= (ClientSize.cy - TextSize.cy) div 2; end; blGlyphRight : begin Offset.X:= ClientSize.cx - M - GlyphWidth; Offset.Y:= (ClientSize.cy - GlyphHeight) div 2; OffsetCap.X:= Offset.X - S - TextSize.cx; OffsetCap.Y:= (ClientSize.cy - TextSize.cy) div 2; end; blGlyphTop : begin Offset.X:= (ClientSize.cx - GlyphWidth) div 2; Offset.Y:= M; OffsetCap.X:= (ClientSize.cx - TextSize.cx) div 2; OffsetCap.Y:= Offset.Y + GlyphHeight + S; end; blGlyphBottom : begin Offset.X:= (ClientSize.cx - GlyphWidth) div 2; Offset.Y:= ClientSize.cy - M - GlyphHeight; OffsetCap.X:= (ClientSize.cx - TextSize.cx) div 2; OffsetCap.Y:= Offset.Y - S - TextSize.cy; end; end; // todo: for Themed painting we need imagelist here. Wait for it implementation DrawGlyph(Canvas, PaintRect, Offset, FState, Transparent, 0); if FShowCaption and (Caption <> '') then begin with PaintRect, OffsetCap do begin Left := Left + X; Top := Top + Y; end; ThemeServices.DrawText(Canvas, FLastDrawDetails, Caption, PaintRect, DT_LEFT or DT_TOP, 0); end; inherited Paint; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.MouseDown Params: Button: Shift: X, Y: Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown(Button, Shift, X, Y); if csDesigning in ComponentState then exit; if (Button = mbLeft) and Enabled then begin if not FDown then begin FState := bsDown; if (Action is TCustomAction) then TCustomAction(Action).Checked := False; Invalidate; end; FDragging := True; end; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.MouseMove Params: Shift: X, Y: Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.MouseMove(Shift: TShiftState; X, Y: Integer); var NewState: TButtonState; begin inherited MouseMove(Shift, X, Y); if csDesigning in ComponentState then exit; if FDragging then begin Assert(False,'Trace:FDragging is true'); if FDown then NewState := bsExclusive else begin if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then NewState := bsDown else NewState := bsUp; end; if NewState <> FState then begin //debugln(['TCustomSpeedButton.MouseMove ',DbgSName(Self),' fState=',ord(fstate),' NewState=',ord(NewState)]); FState := NewState; Invalidate; end; end; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.MouseUp Params: Button: Shift: X, Y: Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseUp(Button, Shift, X, Y); end; {------------------------------------------------------------------------------ procedure TCustomSpeedButton.DoBeforeMouseMessage; ------------------------------------------------------------------------------} procedure TCustomSpeedButton.DoBeforeMouseMessage; begin if Application<>nil then Application.DoBeforeMouseMessage(Self); end; {------------------------------------------------------------------------------ TCustomSpeedButton DoMouseUp "Event Handler" ------------------------------------------------------------------------------} procedure TCustomSpeedButton.DoMouseUp(var Message: TLMMouse; Button: TMouseButton); begin if not (csNoStdEvents in ControlStyle) then with Message do MouseUp(Button, KeysToShiftState(Keys), XPos, YPos); end; procedure TCustomSpeedButton.WMLButtonDown(var Message: TLMLButtonDown); begin inherited; // because csClickEvents is not set no csClicked is set in the inherited method Include(FControlState, csClicked); end; procedure TCustomSpeedButton.WMLButtonDBLCLK(var Message: TLMLButtonDblClk); begin inherited; // if in a group, raise dblclick event, otherwise translate to click event if Down then DblClick else Click; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.WMLButtonUp Params: Message Returns: Nothing Mouse event handler ------------------------------------------------------------------------------} procedure TCustomSpeedButton.WMLButtonUp(var Message: TLMLButtonUp); var OldState: TButtonState; begin DoBeforeMouseMessage; //DebugLn('TCustomSpeedButton.WMLButtonUp A ',DbgSName(Self),' csCaptureMouse=',DbgS(csCaptureMouse in ControlStyle),' csClicked=',DbgS(csClicked in ControlState)); if (csCaptureMouse in ControlStyle) and (mbLeft in CaptureMouseButtons) then begin {$IFDEF VerboseMouseCapture} DebugLn('TCustomSpeedButton.WMLButtonUp ',Name,':',ClassName); {$ENDIF} MouseCapture := False; end; if not (csDesigning in ComponentState) and FDragging then begin OldState:=FState; FDragging := False; if FGroupIndex = 0 then begin FState := bsUp; if OldState<>FState then Invalidate; end else if (Message.XPos >= 0) and (Message.XPos < Width) and (Message.YPos >= 0) and (Message.YPos < Height) then SetDown(not FDown); end; DoMouseUp(Message, mbLeft); if csClicked in ControlState then begin Exclude(FControlState, csClicked); //DebugLn('TCustomSpeedButton.WMLButtonUp B ',dbgs(ClientRect.Left),',',dbgs(ClientRect.Top),',',dbgs(ClientRect.Right),',',dbgs(ClientRect.Bottom),' ',dbgs(Message.Pos.X),',',dbgs(Message.Pos.Y)); if PtInRect(ClientRect, SmallPointToPoint(Message.Pos)) then begin //DebugLn('TCustomSpeedButton.WMLButtonUp C'); // Important: Calling Click can invoke modal dialogs, so call this as last Click; end; end; //DebugLn('TCustomSpeedButton.WMLButtonUp END'); end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.SetLayout Params: Value: new layout value Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.SetLayout(const Value : TButtonLayout); begin if Value <> FLayout then begin FLayout:= Value; Invalidate; end; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.SetTransparent Params: Value: new transparency value Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.SetTransparent(const Value : boolean); begin if Value <> FTransparent then begin FTransparent:= Value; if Value then ControlStyle:= ControlStyle - [csOpaque] else ControlStyle:= ControlStyle + [csOpaque]; Invalidate; end; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.CMButtonPressed Params: Message: Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.CMButtonPressed(var Message : TLMessage); var Sender : TCustomSpeedButton; begin if csDestroying in ComponentState then exit; if Message.WParam = WParam(FGroupIndex) then begin Sender := TCustomSpeedButton(Message.LParam); if Sender <> Self then begin if Sender.Down and FDown then begin FDown := False; FState := bsUp; Invalidate; end; FAllowAllUp := Sender.AllowAllUp; end; end; end; procedure TCustomSpeedButton.Loaded; begin inherited Loaded; UpdateExclusive; if FDownLoaded then SetDown(FDownLoaded); end; function TCustomSpeedButton.GetGlyphSize(PaintRect: TRect): TSize; begin Result.CX := TButtonGlyph(FGlyph).Glyph.Width; Result.CY := TButtonGlyph(FGlyph).Glyph.Height; end; function TCustomSpeedButton.GetTextSize(PaintRect: TRect): TSize; var TMP: String; TXTStyle: TTextStyle; Flags: Cardinal; begin if FShowCaption and (Caption <> '') then begin TMP := Caption; TXTStyle := Canvas.TextStyle; TXTStyle.Opaque := False; TXTStyle.Clipping := True; TXTStyle.ShowPrefix := ShowAccelChar; TXTStyle.Alignment := taLeftJustify; TXTStyle.Layout := tlTop; TXTStyle.SystemFont := Canvas.Font.IsDefault;//Match System Default Style DeleteAmpersands(TMP); Flags := DT_CalcRect; if not TXTStyle.SingleLine then Inc(Flags, DT_WordBreak); DrawText(Canvas.Handle, PChar(TMP), Length(TMP), PaintRect, Flags); Result.CY := PaintRect.Bottom - PaintRect.Top; Result.CX := PaintRect.Right - PaintRect.Left; end else begin Result.CX:= 0; Result.CX:= 0; end; end; function TCustomSpeedButton.DrawGlyph(ACanvas: TCanvas; const AClient: TRect; const AOffset: TPoint; AState: TButtonState; ATransparent: Boolean; BiDiFlags: Longint): TRect; begin if Assigned(FGlyph) then if (AState = bsDown) or (Down = true) then Result := FGlyph.Draw(ACanvas, AClient, point(AOffset.x + 1, AOffset.y + 1), AState, ATransparent, BiDiFlags) else Result := FGlyph.Draw(ACanvas, AClient, AOffset, AState, ATransparent, BiDiFlags); end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.CMEnabledChanged Params: Message: Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.CMEnabledChanged(var Message: TLMEssage); Begin //Should create a new glyph based on the new state Invalidate; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.MouseEnter Params: Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.MouseEnter; begin inherited MouseEnter; if csDesigning in ComponentState then exit; if not FMouseInControl and Enabled and (GetCapture = 0) then begin FMouseInControl := True; UpdateState(true); if Assigned(FOnMouseEnter) then FOnMouseEnter(Self); end; end; {------------------------------------------------------------------------------ Method: TCustomSpeedButton.MouseLeave Params: Returns: nothing ------------------------------------------------------------------------------} procedure TCustomSpeedButton.MouseLeave; begin inherited MouseLeave; if csDesigning in ComponentState then exit; ///DebugLn(['TCustomSpeedButton.MouseLeave ',DbgSName(Self),' FMouseInControl=',FMouseInControl,' FDragging=',FDragging]); if FMouseInControl then begin FMouseInControl := False; if Enabled then begin if FDragging and (not MouseCapture) then begin // something fetched our mouse capture FDragging:=false; end; UpdateState(true); if Assigned(FOnMouseExit) then FOnMouseExit(Self); end; end; end; { TSpeedButtonActionLink } procedure TSpeedButtonActionLink.AssignClient(AClient: TObject); begin inherited AssignClient(AClient); FClient := AClient as TCustomSpeedButton; end; function TSpeedButtonActionLink.IsCheckedLinked: Boolean; var SpeedButton: TCustomSpeedButton; begin SpeedButton:=TCustomSpeedButton(FClient); Result := inherited IsCheckedLinked and (SpeedButton.GroupIndex <> 0) and SpeedButton.AllowAllUp and (SpeedButton.Down = (Action as TCustomAction).Checked); end; function TSpeedButtonActionLink.IsGroupIndexLinked: Boolean; var SpeedButton: TCustomSpeedButton; begin SpeedButton:=TCustomSpeedButton(FClient); Result := (SpeedButton is TCustomSpeedButton) and (SpeedButton.GroupIndex = (Action as TCustomAction).GroupIndex); end; procedure TSpeedButtonActionLink.SetGroupIndex(Value: Integer); begin if IsGroupIndexLinked then TCustomSpeedButton(FClient).GroupIndex := Value; end; procedure TSpeedButtonActionLink.SetChecked(Value: Boolean); begin if IsCheckedLinked then TCustomSpeedButton(FClient).Down := Value; end; {$IFDEF ASSERT_IS_ON} {$UNDEF ASSERT_IS_ON} {$C-} {$ENDIF} // included by buttons.pp