sspeedbutton.pas

Alpha Controls 界面控件包

begin
  if FGrayed <> Value then begin
    FGrayed := Value;
    if Visible then FCommonData.BGChanged := True;
    GraphRepaint;
  end;
end;

procedure TsSpeedButton.SetImageIndex(const Value: integer);
var
  n : integer;
begin
  if FImageIndex <> Value then begin
    FImageIndex := Value;
    if Assigned(Images) then begin
      n := NumGlyphs;
      CopyGlyph(Self, FCommonData, FImageIndex, Images, Glyph, DisabledGlyphKind, n);
      NumGlyphs := n;
    end;
    if Visible then FCommonData.BGChanged := True;
    GraphRepaint
  end;
end;

procedure TsSpeedButton.SetImages(const Value: TCustomImageList);
var
  n : integer;
begin
  if Images <> Value then begin
    FImages := Value;
    if Visible then FCommonData.BGChanged := True;
    if Assigned(Images) then begin
      n := NumGlyphs;
      CopyGlyph(Self, FCommonData, FImageIndex, Images, Glyph, DisabledGlyphKind, n);
      NumGlyphs := n;
    end;
    FCommonData.BGChanged := True;
    GraphRepaint
  end;
end;

procedure TsSpeedButton.SetOffset(const Value: Integer);
begin
  if (FOffset <> Value) then begin
    FOffset := Value;
    if Visible then FCommonData.BGChanged := True;
    GraphRepaint
  end;
end;

procedure TsSpeedButton.SetShowCaption(const Value: boolean);
begin
  if FShowCaption <> Value then begin
    FShowCaption := Value;
    if Visible then FCommonData.BGChanged := True;
    GraphRepaint
  end;
end;

function TsSpeedButton.TextRectSize: TSize;
var
  R : TRect;
begin
  R := Rect(0, 0, MaxCaptionWidth(Self), 0);
  acDrawText(FCommonData.FCacheBMP.Canvas.Handle, Caption, R, DT_EXPANDTABS or DT_WORDBREAK or DT_CALCRECT);
  Result.cy := HeightOf(R);
  Result.cx := WidthOf(R);
end;

procedure TsSpeedButton.WndProc(var Message: TMessage);
var
  n : integer;
begin
//  if Message.Msg = WM_SIZE then Alert;
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_CTRLHANDLED : begin Message.LParam := 1; Exit end;
    AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
    AC_SETNEWSKIN : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      if Assigned(Images) and (GetImageCount(Images) > 0) then Glyph.Assign(nil);
      CommonWndProc(Message, FCommonData);
      if FCommonData.Skinned then ControlStyle := ControlStyle + [csOpaque];
      Exit;
    end;
    AC_REMOVESKIN : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) and not (csDestroying in ComponentState) then begin
      CommonWndProc(Message, FCommonData);
      if Assigned(Images) and (GetImageCount(Images) > 0) then begin
        n := NumGlyphs;
        CopyGlyph(Self, FCommonData, FImageIndex, Images, Glyph, DisabledGlyphKind, n);
        NumGlyphs := n;
      end;
      Repaint;
//      if not Flat then v4.43
      ControlStyle := ControlStyle - [csOpaque];
    end;
    AC_ENDPARENTUPDATE : Exit;
    AC_REFRESH : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      CommonWndProc(Message, FCommonData);
      if Visible then RePaint;
      exit
    end
  end;
  if not ControlIsReady(Self) or not FCommonData.Skinned then begin
    case Message.Msg of
      CM_MOUSEENTER : if Enabled and not (csDesigning in ComponentState) then begin
        if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
      end;
      CM_MOUSELEAVE : if Enabled and not (csDesigning in ComponentState) then begin
        if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
      end;
    end;
    inherited
  end else begin
    if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
      AC_UPDATESECTION : begin GraphRepaint; Exit end;
      AC_STOPFADING : begin StopFading(Self); Exit end;
      AC_URGENTPAINT : begin // v4.08
        CommonWndProc(Message, FCommonData);
        if FCommonData.UrgentPainting
          then PrepareCache;
        Exit
      end;
      AC_PREPARING : if FCommonData.Updating then
        Message.LParam := integer(FCommonData.Updating);
    end
    else case Message.Msg of
      CM_MOUSEENTER : if Enabled and not MouseInControl and not (csDesigning in ComponentState) then begin
        Ac_CMMouseEnter(Message);
      end;
      CM_MOUSELEAVE : if Enabled then begin
        Ac_CMMouseLeave(Message);
      end;
      WM_ERASEBKGND : Exit;
{$IFNDEF DYNAMICCACHE}
      CM_TEXTCHANGED : if ShowCaption then begin
        FCommonData.Invalidate;
        Exit;
      end;
{$ENDIF}
      WM_WINDOWPOSCHANGED, WM_SIZE : {if not SkinData.Updating then }begin
        if Visible then FCommonData.BGChanged := True;
      end;
      WM_LBUTTONUP : if not (csDesigning in ComponentState) then begin
        if Assigned(FadeTimer) and FadeTimer.Enabled and Assigned(FadeTimer.TmpBmp) and (FadeTimer.TmpBmp.Width = Width) then begin
          StopFading(Self);
          PrepareCache;
          GraphRepaint; // Fast repainting if fast click
        end;
      end;
    end;
    CommonWndProc(Message, FCommonData);
    inherited;
    case Message.Msg of
      CM_VISIBLECHANGED : begin
//        if FCommonData.FMouseAbove then begin
          Perform(CM_MOUSELEAVE, 0, 0);
//          FCommonData.FMouseAbove := False;
//        end;
      end;
      WM_LBUTTONDBLCLK, WM_LBUTTONDOWN : if not (csDesigning in ComponentState) then begin
        DoChangePaint(Self, True, EventEnabled(aeMouseDown, FAnimatEvents));
      end;
      WM_LBUTTONUP : if not (csDesigning in ComponentState) and not (csDestroying in ComponentState) then begin
        DoChangePaint(Self, True, EventEnabled(aeMouseUp, FAnimatEvents));
      end
      else begin
//        StopFading(Self);
        Message.Result := 1;
      end;
      CM_ENABLEDCHANGED : if (Visible or (csDesigning in ComponentState)) then begin
        if Visible then FCommonData.BGChanged := True;
        GraphRepaint;
        Exit;
      end;
      WM_MOVE : begin
        if (csDesigning in ComponentState) and not SkinData.Updating then Repaint
      end;
      WM_SIZE, WM_WINDOWPOSCHANGED : if (csDesigning in ComponentState) and not SkinData.Updating then begin
        GraphRepaint;
      end;
    end;
  end;
end;

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

procedure TsSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  p : TPoint;
  c : TMouse;
begin
  if not ShowHintStored then begin
    AppShowHint := Application.ShowHint;
    Application.ShowHint := False;
    ShowHintStored := True;
  end;

  if (Button = mbLeft) and Enabled then begin
    if (ButtonStyle = tbsDropDown) and Assigned(DropDownMenu) and ((X > Width - AddedWidth) or not Assigned(OnCLick) { v4.65 }) then begin
      TempControl := pointer(Self);

      c := nil;
      StopFading(Self);

      if not MenuVisible then begin
        MenuVisible := True;
        DroppedDown := True;
// v4.35        Down := True;
        FCommonData.BGChanged := True;
        if not Assigned(OnCLick) then FState := bsDown; // v4.65
        GraphRepaint;
        p := ClientToScreen(Point(0, Height + 1));
        DropDownMenu.PopupComponent := Self;
        DropDownMenu.Popup(p.X, p.Y);
        DroppedDown := False;
        MenuVisible := False;
        TempControl := nil;
        if not PtInRect(Rect(p.x, p.y - Height - 1, p.x + Width, p.y - 1), c.CursorPos) then begin
          Perform(CM_MOUSELEAVE, 0, 0);
        end;
        if not Assigned(OnCLick) then FState := bsUp;
      end;
    end
    else inherited;
  end else inherited;
end;

procedure TsSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Application.ShowHint := AppShowHint;
  ShowHintStored := False;
  if (Button = mbLeft)  and Enabled and (ButtonStyle = tbsDropDown) then begin
    DroppedDown := False;
    TempControl := nil;
    inherited;
  end
  else inherited;
end;

procedure TsSpeedButton.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = Images) then Images := nil;
end;

procedure TsSpeedButton.SetDrawOverBorder(const Value: boolean);
begin
  if FDrawOverBorder <> Value then begin
    FDrawOverBorder := Value;
    if Visible then FCommonData.BGChanged := True;
    GraphRepaint;
  end;
end;

procedure TsSpeedButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  if Glyph.Empty and (TCustomAction(Sender).ActionList.Images <> nil) and (TCustomAction(Sender).ImageIndex > -1) then Glyph.Assign(nil); // v4.44
  inherited ActionChange(Sender, CheckDefaults);
  if Sender is TCustomAction then DoActionChanging(Self, TCustomAction(Sender));
  FCommonData.Invalidate;
end;

procedure TsSpeedButton.GlyphChanged(Sender: TObject);
begin
  if Assigned(OldOnChange) then OldOnChange(Glyph); // v4.52
  if not (csLoading in ComponentState) and not (csDestroying in ComponentState) and not (csCreating in ControlState)
    then FCommonData.Invalidate;
end;

procedure TsSpeedButton.SetTextAlignment(const Value: TAlignment);
begin
  if FTextAlignment <> Value then begin
    FTextAlignment := Value;
    Repaint
  end;
end;

procedure TsSpeedButton.Ac_CMMouseEnter(var Message: TMessage);
begin
  if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
  if not FCommonData.FMouseAbove then begin
    FCommonData.FMouseAbove := True;
    DoChangePaint(Self, False, EventEnabled(aeMouseEnter, FAnimatEvents));
  end;
end;

procedure TsSpeedButton.Ac_CMMouseLeave(var Message: TMessage);
begin
  if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
  FCommonData.FMouseAbove := False;
  if bsDown = FState then FState := bsUp;
  DoChangePaint(Self, False, EventEnabled(aeMouseLeave, FAnimatEvents));
end;

procedure TsSpeedButton.UpdateGlyph;
var
  n : integer;
begin
  if not FCommonData.Skinned and Glyph.Empty and not (csLoading in ComponentState) then begin
    if Assigned(Images) and (GetImageCount(Images) > 0) then begin
      n := NumGlyphs;
      CopyGlyph(Self, FCommonData, FImageIndex, Images, Glyph, DisabledGlyphKind, n);
      NumGlyphs := n;
    end;
  end;
end;

{ TsTimerSpeedButton }

constructor TsTimerSpeedButton.Create(AOwner: TComponent);
begin
  inherited;
  Width := Height - 4;
end;

end.