veWindow <> 0) then begin if MouseTimer.Enabled then MouseTimer.Enabled := False; MouseInControl := Self; MouseTimer.OnTimer := MouseTimerHandler; MouseTimer.Enabled := True; MouseEnter; end; end;
if FDragging then begin if not FDown then NewState := bsUp else NewState := bsExclusive; if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then if FDown then NewState := bsExclusive else NewState := bsDown; if NewState <> FState then begin FState := NewState; Invalidate; end; end; end;
procedure TFlatSpeedButton.MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var DoClick: Boolean; begin inherited MouseUp(Button, Shift, X, Y); if FDragging then begin FDragging := False; DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight); if FGroupIndex = 0 then begin // Redraw face in-case mouse is captured FState := bsUp; FMouseInControl := False; if DoClick and not (FState in [bsExclusive, bsDown]) then Invalidate; end else if DoClick then begin SetDown(not FDown); if FDown then Repaint; end else begin if FDown then FState := bsExclusive; Repaint; end; if DoClick then Click else MouseLeave; UpdateTracking; end; end;
procedure TFlatSpeedButton.Click; begin if Parent <> nil then GetParentForm(self).ModalResult := FModalResult; inherited Click; end;
function TFlatSpeedButton.GetPalette: HPALETTE; begin Result := FGlyph.Palette; end;
procedure TFlatSpeedButton.SetColors (Index: Integer; Value: TColor); begin case Index of 0: FFocusedColor := Value; 1: FDownColor := Value; 2: FBorderColor := Value; 3: FColorHighlight := Value; 4: FColorShadow := Value; end; Invalidate; end;
procedure TFlatSpeedButton.CalcAdvColors; begin if FUseAdvColors then begin FFocusedColor := CalcAdvancedColor(Color, FFocusedColor, FAdvColorFocused, lighten); FDownColor := CalcAdvancedColor(Color, FDownColor, FAdvColorDown, darken); FBorderColor := CalcAdvancedColor(Color, FBorderColor, FAdvColorBorder, darken); end; end;
procedure TFlatSpeedButton.SetAdvColors (Index: Integer; Value: TAdvColors); begin case Index of 0: FAdvColorFocused := Value; 1: FAdvColorDown := Value; 2: FAdvColorBorder := Value; end; CalcAdvColors; Invalidate; end;
procedure TFlatSpeedButton.SetUseAdvColors (Value: Boolean); begin if Value <> FUseAdvColors then begin FUseAdvColors := Value; ParentColor := Value; CalcAdvColors; Invalidate; end; end;
procedure TFlatSpeedButton.SetGlyph (value: TBitmap); begin if value <> FGlyph then begin FGlyph.Assign(value); if not FGlyph.Empty then begin if FGlyph.Width mod FGlyph.Height = 0 then begin FNumGlyphs := FGlyph.Width div FGlyph.Height; if FNumGlyphs > 4 then FNumGlyphs := 1; end; end; Invalidate; end; end;
procedure TFlatSpeedButton.SetNumGlyphs (value: TNumGlyphs); begin if value <> FNumGlyphs then begin FNumGlyphs := value; Invalidate; end; end;
procedure TFlatSpeedButton.UpdateExclusive; var Msg: TMessage; begin if (FGroupIndex <> 0) and (Parent <> nil) then begin Msg.Msg := CM_BUTTONPRESSED; Msg.WParam := FGroupIndex; Msg.LParam := Longint(Self); Msg.Result := 0; Parent.Broadcast(Msg); end; end;
procedure TFlatSpeedButton.SetDown (Value: Boolean); begin if FGroupIndex = 0 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; if Value then UpdateExclusive; end; end;
procedure TFlatSpeedButton.SetGroupIndex (Value: Integer); begin if FGroupIndex <> Value then begin FGroupIndex := Value; UpdateExclusive; end; end;
procedure TFlatSpeedButton.SetLayout (Value: TButtonLayout); begin if FLayout <> Value then begin FLayout := Value; Invalidate; end; end;
procedure TFlatSpeedButton.SetMargin (Value: Integer); begin if (Value <> FMargin) and (Value >= -1) then begin FMargin := Value; Invalidate; end; end;
procedure TFlatSpeedButton.SetSpacing (Value: Integer); begin if Value <> FSpacing then begin FSpacing := Value; Invalidate; end; end;
procedure TFlatSpeedButton.SetAllowAllUp (Value: Boolean); begin if FAllowAllUp <> Value then begin FAllowAllUp := Value; UpdateExclusive; end; end;
procedure TFlatSpeedButton.WMLButtonDblClk (var Message: TWMLButtonDown); begin inherited; if FDown then DblClick; end;
procedure TFlatSpeedButton.CMEnabledChanged (var Message: TMessage); begin inherited; if not Enabled then begin FMouseInControl := False; FState := bsDisabled; RemoveMouseTimer; end; UpdateTracking; Invalidate; end;
procedure TFlatSpeedButton.CMButtonPressed (var Message: TMessage); var Sender: TFlatSpeedButton; begin if Message.WParam = FGroupIndex then begin Sender := TFlatSpeedButton(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 TFlatSpeedButton.CMDialogChar (var Message: TCMDialogChar); begin with Message do if IsAccel(CharCode, Caption) and Enabled then begin Click; Result := 1; end else inherited; end;
procedure TFlatSpeedButton.CMFontChanged (var Message: TMessage); begin Invalidate; end;
procedure TFlatSpeedButton.CMTextChanged (var Message: TMessage); begin Invalidate; end;
procedure TFlatSpeedButton.CMSysColorChange (var Message: TMessage); begin if FUseAdvColors then begin ParentColor := True; CalcAdvColors; end; Invalidate; end;
procedure TFla 上一页 [1] [2] [3] [4] 下一页 没有相关教程
|