sbuttoncontrol.pas

AlphaControls是一个Delphi标准控件的集合

              sStyle.FFocused := False;
              sStyle.FMouseAbove := False;
            end;
            MenuVisible := False;
          end;
          DroppedDown := False;
          if not RestrictDrawing then sStyle.BGChanged := True;
          Repaint;
        end
        else begin
          if not DroppedDown then begin
            if not Down then begin
              Down := True;
              if not RestrictDrawing then sStyle.BGChanged := True;
              Repaint;
              inherited MouseDown(Button, Shift, X, Y);
            end;
          end;
        end;
      end;
      tbsCheck : begin
        if not Down then begin
          if not RestrictDrawing then sStyle.BGChanged := True;
          Repaint;
          if FGroupIndex > -1 then begin
            for i := 0 to Parent.ControlCount - 1 do begin
              if Parent.Controls[i] is TsButtonControl and
                 TsButtonControl(Parent.Controls[i]).Down and
                 (Parent.Controls[i] <> Self) and
                 (TsButtonControl(Parent.Controls[i]).GroupIndex = FGroupIndex) then begin
                TsButtonControl(Parent.Controls[i]).FadeLevel := TsButtonControl(Parent.Controls[i]).sStyle.ActualFadingIter - 1;
                TsButtonControl(Parent.Controls[i]).FadeTimer.Enabled := False;
                TsButtonControl(Parent.Controls[i]).Down := False;
                TsButtonControl(Parent.Controls[i]).sStyle.Invalidate; 
              end;
            end;
          end;
          Down := True;
          FCheck := True;
          inherited MouseDown(Button, Shift, X, Y);
        end;
      end;
      tbsButton: begin
        if not Down then begin
          Down := True;
          if not RestrictDrawing then sStyle.BGChanged := True;
          Repaint;
          inherited MouseDown(Button, Shift, X, Y);
        end;
      end
      else begin
      end;
    end;
  end;
end;

procedure TsButtonControl.MouseUp(Button: TMouseButton; Shift: TShiftState;  X, Y: Integer);
begin
  inherited;
  FadeLevel := sStyle.ActualFadingIter - 1;
  FadeTimer.Enabled := False;
  if (Button = mbLeft) and Enabled then begin
    if not RestrictDrawing then sStyle.BGChanged := True;
    case ButtonStyle of
      tbsDropDown : begin
        if PtInRect(ClientRect, Point(x, y)) then Click;
        Down := False;
        Repaint;
      end;
      tbsCheck : begin
        if PtInRect(ClientRect, Point(x, y)) then begin
          if not Down then begin
            Click;
          end
          else if AllowAllup and not FCheck then begin
            Down := False;
          end;
        end
        else begin
        end;
        Repaint;
        inherited;
        FCheck := False;
        if PtInRect(ClientRect, Point(x, y)) then Click;
      end;
      tbsButton: begin
        Down := False;
        if PtInRect(ClientRect, Point(x, y)) then Click;
        try
          Repaint;
        except
        end;
      end
      else begin
        inherited;
      end;
    end;
  end;
end;

procedure TsButtonControl.SetBevelWidth(const Value: integer);
begin
  FBevelWidth := Value;
  sStyle.Invalidate;
end;

procedure TsButtonControl.SetLayout(const Value: TButtonLayout);
begin
  FLayout := Value;
  sStyle.Invalidate;
end;

procedure TsButtonControl.SetSpacing(const Value: integer);
begin
  if FSpacing <> Value then begin
    FSpacing := Value;
    sStyle.Invalidate;
  end;
end;

procedure TsButtonControl.WMEraseBkGND(var Message: TWMPaint);
begin
  Message.Result := 1;
end;

procedure TsButtonControl.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    CM_TEXTCHANGED : begin
      if not RestrictDrawing then sStyle.BGChanged := True;
      sStyle.Invalidate;
    end;
    CM_EXIT : begin
      case ButtonStyle of
        tbsDropDown : begin
          Down := False;
        end;
        tbsCheck : begin
          if not Down then begin
            Click;
          end
          else if AllowAllup and not FCheck then begin
            Down := False;
          end;
        end;
        tbsButton: begin
          Down := False;
        end;
      end;
    end;
  end;
  if Assigned(FsStyle) then FsStyle.WndProc(Message);
  inherited;
end;

procedure TsButtonControl.AdjustSize;
var
  IWidth, IHeight, NewWidth, NewHeight, NewTop, NewLeft : integer;
begin
  if Down then exit;
  if (csLoading in ComponentState) then exit;

  NewLeft   := Left;
  NewTop    := Top;
  NewHeight := Height;
  NewWidth  := Width;
  if AutoSize and not ((GlyphHeight = 0) and not ShowCaption) then begin
    Case ButtonStyle of
      tbsSeparator: begin
        NewHeight := GlyphHeight + FMargin * 2 + BevelWidth * 2;
        NewWidth  := Height + FMargin * 2 + BevelWidth * 2;
      end;
      tbsDivider: begin
        NewHeight := GlyphHeight + FMargin * 2 + BevelWidth * 2;
        NewWidth  := BevelWidth * 2 + 4;
      end;
      else begin
        // Calc constraints
        IHeight := GlyphHeight;
        Inc(IHeight, BevelWidth * 2);

        IWidth := GlyphWidth;
        Inc(IWidth, BevelWidth * 2);

        // With text
        if ShowCaption then begin
          Case Layout of
            blGlyphLeft, blGlyphRight : begin
              NewWidth := IWidth + Spacing * integer((IWidth > 0) and (Caption <> '')) + Canvas.TextWidth(Caption) + FMargin * 2;
              NewHeight := Maxi(IHeight, Canvas.TextHeight('W')) + FMargin * 2;
            end;
            blGlyphTop, blGlyphBottom : begin
              NewWidth := Maxi(IWidth, Canvas.TextWidth(Caption)) + FMargin * 2;
              NewHeight := IHeight + Spacing * integer((IWidth > 0) and (Caption <> '')) + Canvas.TextHeight('W') + FMargin * 2;
            end;
          end;
        end //without text
        else begin
          NewWidth := IWidth + FMargin * 2;
          NewHeight := IHeight + FMargin * 2;
        end;

        // Added width - for DropDown button, etc.
        Inc(NewWidth, AddedWidth);

{$IFNDEF ALITE}
        if (Parent is TsToolBar) then begin
//          ToolBar := TsToolBar(Parent);
          case Align of
            alNone: begin
            end;
            alLeft, alRight: begin
            end;
            alTop, alBottom: begin
            end;
          end;
        end
{$ENDIF}
      end;
    end;
  end;
  SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
end;

procedure TsButtonControl.SetDown(const Value: boolean);
begin
  if FDown <> Value then begin
    FDown := Value;
    sStyle.Invalidate;
{$IFNDEF ALITE}
    if (Self is TsSpeedButton) and
         (TsSpeedButton(Self).ButtonStyle = tbsCheck) and
         Assigned(TsSpeedButton(Self).OnStateChange) then begin
      TsSpeedButton(Self).OnStateChange(Self);
    end;
{$ENDIF}    
  end;
end;

procedure TsButtonControl.SetAutoSize(Value: boolean);
begin
  if FAutoSize <> Value then begin
    FAutoSize := Value;
    sStyle.invalidate;
  end;
end;

procedure TsButtonControl.SetShowCaption(const Value: boolean);
begin
  if FShowCaption <> Value then begin
    FShowCaption := Value;
    sStyle.Invalidate;
  end;
end;

procedure TsButtonControl.SetButtonStyle(const Value: TToolButtonStyle);
begin
  if FButtonStyle <> Value then begin
    FButtonStyle := Value;
    sStyle.Invalidate;
  end;
end;

procedure TsButtonControl.SetDropdownMenu(const Value: TPopupMenu);
begin
  if Value <> FDropdownMenu then begin
    FDropdownMenu := Value;
    if Value <> nil then Value.FreeNotification(Self);
  end;
end;

function TsButtonControl.AddedWidth: integer;
begin
  Result := 0;
end;

procedure TsButtonControl.AddedPainting;
  var
    Offset : integer;
    ArrowColor : TColor;
  procedure PaintButton(R : TRect);
  var
    x, y{, i}: Integer;
    procedure PolyDown;
    begin
      sStyle.FCacheBmp.Canvas.Polygon([Point(x + 3, y + 3), Point(x + 9, y + 3), Point(x + 6, y)])
    end;
    procedure PolyUp;
    begin
      sStyle.FCacheBmp.Canvas.Polygon([Point(x + 3, y), Point(x + 9, y), Point(x + 6, y + 3)]);
    end;
  begin
//    i := 1;
    x := (R.Right - R.Left) div 2 - 6 + R.Left + Offset;
    y := (R.Bottom - R.Top) div 2 - 1 + R.Top + Offset;

    if not IsValidSkinIndex(sStyle.SkinIndex) then begin
      if DroppedDown then begin
        if not sStyle.BtnEffects.MaskedBorders.Enabled then begin
          BeveledBorder(sStyle.FCacheBmp.Canvas.Handle, clWhite,
                        clBlack,
                        sStyle.ActiveColor, R,
                        sStyle.ActualBevelWidth div 4 + 1,
                        sConst.bsLowered, sStyle.SoftControl);
        end
      end
      else begin
        if not sStyle.BtnEffects.MaskedBorders.Enabled then begin
          sStyle.PaintBorder(sStyle.FCacheBmp.Canvas.Handle, R);
        end;
      end;
    end;

    if Enabled then begin
      sStyle.FCacheBmp.Canvas.Brush.Color := ArrowColor;
      sStyle.FCacheBmp.Canvas.Pen.Color := ArrowColor;
      PolyUp;
    end
    else begin
      sStyle.FCacheBmp.Canvas.Brush.Color := clWhite;
      sStyle.FCacheBmp.Canvas.Pen.Color := clWhite;
      Inc(x); Inc(y);
      PolyUp;

      Dec(x); Dec(y);
      sStyle.FCacheBmp.Canvas.Brush.Color := clGray;
      sStyle.FCacheBmp.Canvas.Pen.Color := clGray;
      PolyUp;
    end;
  end;
begin
  if (ButtonStyle = tbsDropDown) then begin
    if sStyle.ControlIsActive then begin
      ArrowColor := sStyle.HotStyle.HotPainting.FontColor;
    end
    else begin
      ArrowColor := Font.Color;
    end;

    offset := Integer(DroppedDown) * (BevelWidth);
    PaintButton(Rect(Width - AddedWidth,
                     0,
                     Width,
                     Height));
  end;
end;

procedure TsButtonControl.Paint;
var
  aRect : TRect;
  ci : TCacheInfo;
begin
  if not (csDestroying in ComponentState) and Assigned(Parent) then begin
    if sStyle.BGChanged then begin
      sStyle.InitCacheBmp;
      aRect := ClientRect;
      OffsetRect(aRect, integer(Down), integer(Down));

      ci := sStyle.GetParentCache;
      case ButtonStyle of
        tbsDivider, tbsSeparator : begin
          if ci.Ready then begin
            FadeRect(ci.Bmp.Canvas, Rect(Left + ci.X, Top + ci.Y, Left + Width + ci.X, Top + Height + ci.Y), sStyle.FCacheBmp.Canvas.Handle, Point(0, 0), 100, clNone, 0, ssRectangle);
          end
          else begin
            sStyle.FCacheBmp.Canvas.FillRect(Rect(Left, Top, Left + Width, Top + Height));
          end;
        end;
        else begin
          if not FadeTimer.Enabled then sStyle.PaintBG(sStyle.FCacheBMP);
        end;
      end;

      if not FadeTimer.Enabled then begin
        DrawContents;
        AddedPainting;
      end;
      if not Enabled then begin
        BmpDisabledKind(sStyle.FCacheBmp, FDisabledKind, Parent, CI, Point(Left, Top));
      end;
    end;
    BitBlt(Canvas.Handle, 0, 0, Width, Height, sStyle.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
  end;
end;

procedure TsButtonControl.CreateWnd;
begin
  inherited;
end;

procedure TsButtonControl.SetGrayed(const Value: boolean);
begin
  if FGrayed <> Value then begin
    FGrayed := Value;
    sStyle.Invalidate;
  end;
end;

procedure TsButtonControl.SetBlend(const Value: integer);
begin
  if FBlend <> Value then begin
    if Value < 0 then FBlend := 0
    else if Value > 100 then FBlend := 100
    else FBlend := Value;
    sStyle.invalidate;
  end;
end;

procedure TsButtonControl.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then begin
    if AComponent = DropdownMenu
      then DropdownMenu := nil
      else if AComponent = FImages
        then FImages := nil
        else if AComponent = FImagesGrayed
          then FImagesGrayed := nil
          else if AComponent = FImagesDisabled
          then FImagesDisabled := nil;
  end;                                
end;

procedure TsButtonControl.SetAllowAllUp(const Value: boolean);
begin
  if FAllowAllUp <> Value then begin
    FAllowAllUp := Value;
  end;
end;

procedure TsButtonControl.SetImageIndex(const Value: integer);
begin
  FImageIndex := Value;
  sStyle.Invalidate;
end;

procedure TsButtonControl.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
end;

procedure TsButtonControl.SetCanvasProps;
begin
end;

procedure TsButtonControl.WMMouseEnter(var Message: TWMMouse);
begin
  if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
  inherited;
end;

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

procedure TsButtonControl.PaintNewBmp;
begin
  sStyle.PaintBG(sStyle.FCacheBMP);
  DrawContents;
  AddedPainting;
end;

procedure TsButtonControl.StartFadeIn;
begin
  if sStyle.ActualFadingEnabled then begin
    OldBmp.Assign(sStyle.FCacheBmp);
    PaintNewBmp;
    FadeLevel := 1;
    FadeTimer.Enabled := False;
    FadeTimer.Interval := sStyle.ActualFadingIn;
    FadeTimer.Direction := fdUp;
  end;
end;

procedure TsButtonControl.StartFadeOut;
begin
  if sStyle.ActualFadingEnabled then begin