flatbtns.pas

相信大家已经找很长时间了

procedure TFlatButton.SetNumGlyphs (value: TNumGlyphs);
begin
  if value <> FNumGlyphs then
  begin
    FNumGlyphs := value;
    Invalidate;
  end;
end;

procedure TFlatButton.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 TFlatButton.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 TFlatButton.SetGroupIndex (Value: Integer);
begin
  if FGroupIndex <> Value then
  begin
    FGroupIndex := Value;
    UpdateExclusive;
  end;
end;

procedure TFlatButton.SetLayout (Value: TButtonLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    Invalidate;
  end;
end;

procedure TFlatButton.SetMargin (Value: Integer);
begin
  if (Value <> FMargin) and (Value >= -1) then
  begin
    FMargin := Value;
    Invalidate;
  end;
end;

procedure TFlatButton.SetSpacing (Value: Integer);
begin
  if Value <> FSpacing then
  begin
    FSpacing := Value;
    Invalidate;
  end;
end;

procedure TFlatButton.SetAllowAllUp (Value: Boolean);
begin
  if FAllowAllUp <> Value then
  begin
    FAllowAllUp := Value;
    UpdateExclusive;
  end;
end;

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

procedure TFlatButton.CMEnabledChanged (var Message: TMessage);
begin
  inherited;
  if not Enabled then begin
    FMouseInButtonControl := False;
    FState := bsDisabled;
    RemoveMouseTimer;
  end;
  UpdateTracking;
  Invalidate;
end;

procedure TFlatButton.CMButtonPressed (var Message: TMessage);
var
  Sender: TFlatButton;
begin
  if Message.WParam = FGroupIndex then
  begin
    Sender := TFlatButton(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 TFlatButton.CMDialogKey(var Message: TCMDialogKey);
begin
  with Message do
    if ((CharCode = VK_RETURN) and FMouseInButtonControl) and
       (KeyDataToShiftState(Message.KeyData) = []) and Enabled then
    begin
      Click;
      Result := 1;
    end else
      inherited;
end;

procedure TFlatButton.CMDialogChar (var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, Caption) and Enabled then begin
      if GroupIndex <> 0 then
         SetDown(true);
      Click;
      Result := 1;
    end;
end;

procedure TFlatButton.CMFontChanged (var Message: TMessage);
begin
  Invalidate;
end;

procedure TFlatButton.CMTextChanged (var Message: TMessage);
begin
  Invalidate;
end;

procedure TFlatButton.CMSysColorChange (var Message: TMessage);
begin
  if FUseAdvColors then
  begin
    ParentColor := True;
    CalcAdvColors;
  end;
  Invalidate;
end;

procedure TFlatButton.CMParentColorChanged (var Message: TWMNoParams);
begin
  inherited;
  if FUseAdvColors then begin
    ParentColor := True;
    CalcAdvColors;
  end;
  Invalidate;
end;

procedure TFlatButton.MouseEnter;
begin
  if Enabled and not FMouseInButtonControl then begin
    FMouseInButtonControl := True;
    Invalidate;
  end;
end;

procedure TFlatButton.MouseLeave;
begin
  if Enabled and FMouseInButtonControl and not FDragging then begin
    FMouseInButtonControl := False;
    RemoveMouseTimer;
    Invalidate;
  end;
end;

procedure TFlatButton.MouseTimerHandler (Sender: TObject);
var
  P: TPoint;
begin
  GetCursorPos (P);
  if FindDragTarget(P, True) <> Self then
    MouseLeave;
end;

procedure TFlatButton.RemoveMouseTimer;
begin
  if MouseInButtonControl = Self then
  begin
    MouseTimer.Enabled := False;
    MouseInButtonControl := nil;
  end;
end;

procedure TFlatButton.SetDefault(const Value: Boolean);
var
 {$IFDEF DFS_COMPILER_2}
  Form: TForm;
 {$ELSE}
  Form: TCustomForm;
 {$ENDIF}
begin
  FDefault := Value;
  if HandleAllocated then
  begin
    Form := GetParentForm(Self);
    if Form <> nil then
      Form.Perform(CM_FOCUSCHANGED, 0, Longint(Form.ActiveControl));
  end;
  Invalidate;
end;

procedure TFlatButton.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  MouseLeave;
end;

procedure TFlatButton.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  if Enabled then begin
     FMouseInButtonControl := True;
     Invalidate;
  end;
end;

procedure TFlatButton.WMKeyDown(var Message: TWMKeyDown);
var CharCode:Word;
begin
  CharCode := Message.CharCode;
  if CharCode = VK_SPACE then begin
    if GroupIndex = 0 then
       FState := bsDown
    else
       SetDown(true);
    Invalidate;
  end;
end;

procedure TFlatButton.WMKeyUp(var Message: TWMKeyUp);
var CharCode:Word;
begin
  CharCode := Message.CharCode;
  if  CharCode = VK_SPACE then  begin
    if GroupIndex = 0 then
       FState := bsUp
    else
       SetDown(false);
    Click;
    Invalidate;
  end;
end;

procedure TFlatButton.SetTransparent(const Value: TTransparentMode);
begin
  FTransparent := Value;
  Invalidate;
end;

procedure TFlatButton.WMMove(var Message: TWMMove);
begin
  inherited;
  if not (FTransparent = tmNone) then
    Invalidate;
end;

procedure TFlatButton.WMSize(var Message: TWMSize);
begin
  inherited;
  if not (FTransparent = tmNone) then
    Invalidate;
end;

procedure TFlatButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
end;

procedure TFlatButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);
end;

{ TFlatRadioButton }

procedure TFlatRadioButton.CMDesignHitTest(var Message: TCMDesignHitTest);
begin
  case FLayout of
    radioLeft:
      if PtInRect(Rect(ClientRect.Left + 1, ClientRect.Top + 3, ClientRect.Left + 11, ClientRect.Top + 13), Point(message.XPos, message.YPos)) then
        Message.Result := 1
      else
        Message.Result := 0;
    radioRight:
      if PtInRect(Rect(ClientRect.Right - 11, ClientRect.Top + 3, ClientRect.Right - 1, ClientRect.Top + 13), Point(message.XPos, message.YPos)) then
        Message.Result := 1
      else
        Message.Result := 0;
  end;
end;

constructor TFlatRadioButton.Create (AOwner: TComponent);
begin
  inherited Create(AOwner);
  if MouseTimer = nil then
  begin
    MouseTimer := TTimer.Create(nil);
    MouseTimer.Enabled := False;
    MouseTimer.Interval := 100; // 8 times a second
  end;
  ParentColor := True;
  ParentFont := True;
  FFocusedColor := clWhite;
  FDownColor := $00C5D6D9;
  FDotColor := clBlack;
  FBorderColor := $004080FF;
  FLayout := radioLeft;
  FChecked := false;
  FGroupIndex := 0;
  Enabled := true;
  Visible := true;
  SetBounds(0, 0, 121, 17);
  FUseAdvColors := false;
  FAdvColorFocused := 10;
  FAdvColorDown := 10;
  FAdvColorBorder := 50;
  Inc(ControlCounter);
end;

destructor TFlatRadioButton.Destroy;
begin
  RemoveMouseTimer;
  Dec(ControlCounter);
  if ControlCounter = 0 then
  begin
    MouseTimer.Free;
    MouseTimer := nil;
  end;
  inherited;
end;

procedure TFlatRadioButton.SetColors (Index: Integer; Value: TColor);
begin
  case Index of
    0: FFocusedColor := Value;
    1: FDownColor := Value;
    2: FDotColor := Value;
    3: FBorderColor := Value;
  end;
  Invalidate;
end;

procedure TFlatRadioButton.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 TFlatRadioButton.SetAdvColors (Index: Integer; Value: TAdvColors);
begin
  case Index of
    0: FAdvColorFocused := Value;
    1: FAdvColorDown := Value;
    2: FAdvColorBorder := Value;
  end;
  CalcAdvColors;
  Invalidate;
end;

procedure TFlatRadioButton.SetUseAdvColors (Value: Boolean);
begin
  if Value <> FUseAdvColors then
  begin
    FUseAdvColors := Value;
    ParentColor := Value;
    CalcAdvColors;
    Invalidate;
  end;
end;

procedure TFlatRadioButton.SetLayout (Value: TRadioButtonLayout);
begin
  FLayout := Value;
  Invalidate;
end;

procedure TFlatRadioButton.SetChecked (Value: Boolean);
var
  I: Integer;
  Sibling: TFlatRadioButton;
begin
  if FChecked <> Value then
  begin
    TabStop := Value;
    FChecked := Value;
    if Value then
    begin
      if Parent <> nil then
        for i := 0 to Parent.ControlCount-1 do
          if Parent.Controls[i] is TFlatRadioButton then
          begin
            Sibling := TFlatRadioButton(Parent.Controls[i]);
            if (Sibling <> Self) and (Sibling.GroupIndex = GroupIndex) then
              Sibling.SetChecked(False);
          end;
      Click;
      if csDesigning in Compone