sspeedbutton.pas

Alpha Controls 界面控件包

  Text:{$IFDEF TNTUNICODE}WideString{$ELSE}string {$ENDIF};
begin
  Text := Caption;
  Flags := DrawTextBiDiModeFlags(Flags) and not DT_SINGLELINE;

  FCommonData.FCacheBMP.Canvas.Font.Assign(Font);
  {$IFDEF TNTUNICODE}
  WriteTextExW(FCommonData.FCacheBMP.Canvas, PWideChar(Text), True, Rect,
              Flags, FCommonData, CurrentState <> 0);
  {$ELSE}
  WriteTextEx(FCommonData.FCacheBMP.Canvas, PChar(Text), True, Rect,
              Flags,
              FCommonData, CurrentState <> 0);
  {$ENDIF}
end;

procedure TsSpeedButton.DrawCaption;
var
  R, CalcRect : TRect;
begin
  if ShowCaption then begin
    FCommonData.FCacheBmp.Canvas.Font.Assign(Font);
    FCommonData.FCacheBMP.Canvas.Brush.Style := bsClear;
    R := CaptionRect;
    { Calculate vertical layout }
    CalcRect := R;
    DoDrawText(R, DT_EXPANDTABS or DT_WORDBREAK or GetStringFlags(Self, FTextAlignment));
  end;
end;

procedure TsSpeedButton.DrawGlyph;
begin
  UpdateGlyph;
  DrawSpeedButtonGlyph(Self);
end;

function TsSpeedButton.GenMargin: integer;
begin
  if Margin < 0 then Result := 0 else Result := Margin + 3;
end;

function TsSpeedButton.GlyphHeight: integer;
begin
  if (Glyph <> nil) and (Glyph.Height > 0) then begin
    Result := Glyph.Height;
  end
  else if (Images <> nil) and (ImageIndex > -1) then begin
    Result := Images.Height;
  end
  else Result := 0;
end;

function TsSpeedButton.GlyphWidth: integer;
begin
  if (Glyph <> nil) and (Glyph.Width > 0) then begin
    Result := Glyph.Width div NumGlyphs;
  end
  else if (Images <> nil) and (ImageIndex > -1) then begin
    Result := Images.Width;
  end
  else Result := 0;
end;

procedure TsSpeedButton.GraphRepaint;
begin
  if (csCreating in ControlState) or (csDestroying in ComponentState) or (csLoading in ComponentState) or not Assigned(Parent) or not Visible then Exit;
  if Parent.HandleAllocated then begin
    SendMessage(Parent.Handle, SM_ALPHACMD, MakeWParam(0, AC_SETGRAPHCONTROL), longint(Self));
    Repaint;
    SendMessage(Parent.Handle, SM_ALPHACMD, MakeWParam(0, AC_SETGRAPHCONTROL), 0);
  end;
end;

function TsSpeedButton.ImgRect: TRect;
var
  x, y : integer;
  dh, dw : integer;
begin
  x := 0;
  y := 0;
  Result := Rect(0, 0, 0, 0);
  dw := (Width - ArrowWidth - GlyphWidth - Spacing * integer(ShowCaption and (GlyphWidth > 0) and (Caption <> '')) - TextRectSize.cx) div 2 - GenMargin;
  dh := (Height - GlyphHeight - Spacing * integer(ShowCaption and (GlyphWidth > 0) and (Caption <> '')) - TextRectSize.cy) div 2 - GenMargin;
  case Layout of
    blGlyphLeft : begin
      case Alignment of
        taLeftJustify : begin
          x := GenMargin;
          y := (Height - GlyphHeight) div 2;
        end;
        taCenter : begin
          x := GenMargin + dw;
          y := (Height - GlyphHeight) div 2;
        end;
        taRightJustify : begin
          x := GenMargin + 2 * dw;
          y := (Height - GlyphHeight) div 2;
        end;
      end;
    end;
    blGlyphRight : begin
      case Alignment of
        taLeftJustify : begin
          x := Width - ArrowWidth - GenMargin - 2 * dw - Spacing * integer(ShowCaption and (GlyphWidth > 0) and (Caption <> '')) - GlyphWidth;
          y := (Height - GlyphHeight) div 2;
        end;
        taCenter : begin
          x := (Width - ArrowWidth - GlyphWidth + Spacing * integer(ShowCaption and (GlyphWidth > 0) and (Caption <> '')) + TextRectSize.cx) div 2;
          y := (Height - GlyphHeight) div 2;
        end;
        taRightJustify : begin
          x := Width - ArrowWidth - GlyphWidth - GenMargin;
          y := (Height - GlyphHeight) div 2;
        end;
      end;
    end;
    blGlyphTop : begin
      x := (Width - ArrowWidth - GlyphWidth) div 2 + 1;
      y := GenMargin + dh;
    end;
    blGlyphBottom : begin
      x := (Width - ArrowWidth - GlyphWidth) div 2 + 1;
      y := Height - GenMargin - dh - GlyphHeight;
    end;
  end;
  if CurrentState = 2 then begin
    inc(x);
    inc(y);
  end;
//  inc(x, integer(FState in [bsDown, bsExclusive]));
//  inc(y, integer(FState in [bsDown, bsExclusive]));
  Result := Rect(x, y, x + GlyphWidth, y + GlyphHeight);
end;

procedure TsSpeedButton.Loaded;
begin
  inherited;
  FCommonData.Loaded;
  if FCommonData.Skinned then ControlStyle := ControlStyle + [csOpaque];
end;

procedure TsSpeedButton.Paint;
begin
  if Assigned(FCommonData.SkinManager) and FCommonData.SkinManager.Active and (FCommonData.SkinIndex < 1) then FCommonData.UpdateIndexes; // v4.84
  if (not FCommonData.Skinned) or not (Visible or (csDesigning in ComponentState)) then inherited else begin
    if (width < 1) or (height < 1) or SkinData.Updating then Exit;
    if Assigned(FadeTimer) and FadeTimer.Enabled and Assigned(FadeTimer.TmpBmp) and (FadeTimer.TmpBmp.Width = Width) then begin
      BitBlt(Canvas.Handle, 0, 0, Width, Height, FadeTimer.TmpBmp.Canvas.Handle, 0, 0, SRCCOPY);
    end
    else begin
      FCommonData.BGChanged := (FStoredDown <> Down) or FCommonData.BGChanged or FCommonData.HalfVisible;
      FStoredDown := Down;
      FCommonData.HalfVisible := {not RectInRect(Parent.ClientRect, BoundsRect) optimize - in WM_MOVE set BGChanged if needed !!!} SkinData.RepaintIfMoved;
      if not FCommonData.BGChanged then begin
        if (FOldNumGlyphs <> NumGlyphs) then begin
          FCommonData.BGChanged := True;
          FOldNumGlyphs := NumGlyphs;
        end
        else if (FOldSpacing <> Spacing) then begin
          FCommonData.BGChanged := True;
          FOldSpacing := Spacing;
        end;
      end
      else begin
        FOldNumGlyphs := NumGlyphs;
        FOldSpacing := Spacing;
      end;
      if FCommonData.BGChanged and not FCommonData.UrgentPainting then PrepareCache;
      UpdateCorners(FCommonData, 0);
      BitBlt(Canvas.Handle, 0, 0, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
    end;
  end;
end;

procedure TsSpeedButton.PrepareCache;
var
  CI : TCacheInfo;
  si, mi, w : integer;
  Mode, x, y : integer;
  R : TRect;
begin
  if Self = nil then Exit;
  FCommonData.InitCacheBmp;
  FCommonData.FCacheBmp.Canvas.Font.Assign(Font);

  CI := GetParentCache(FCommonData);
  if CI.Ready and (CI.Bmp.Width = 0) then Exit;

  case FButtonStyle of
    tbsDivider: begin
      if CI.Ready
        then BitBlt(FCommonData.FCacheBMP.Canvas.Handle, 0, 0, Width, Height, CI.Bmp.Canvas.Handle, Left, Top, SRCCOPY)
        else FillDC(FCommonData.FCacheBMP.Canvas.Handle, ClientRect, TsHackedControl(Parent).Color);
      si := FCommonData.SkinManager.GetSkinIndex(s_Divider);
      if FCommonData.SkinManager.IsValidSkinIndex(si) then begin
        mi := FCommonData.SkinManager.GetMaskIndex(si, s_Divider, s_BordersMask);
        if Assigned(FCommonData.SkinManager) and FCommonData.SkinManager.IsValidImgIndex(mi) then begin
          w := FCommonData.SkinManager.MaskSize(mi).cx;
          DrawSkinRect(FCommonData.FCacheBmp,
                       Rect((Width - w) div 2, 1, (Width + w) div 2, Height - 2),
                       True, CI, FCommonData.SkinManager.ma[mi], 0, False);
        end;
      end
      else begin
      end;
    end;
    tbsSeparator: begin
      if CI.Ready
        then BitBlt(FCommonData.FCacheBMP.Canvas.Handle, 0, 0, Width, Height, CI.Bmp.Canvas.Handle, Left, Top, SRCCOPY)
        else FillDC(FCommonData.FCacheBMP.Canvas.Handle, ClientRect, TsHackedControl(Parent).Color);
    end
    else begin
      if not CI.Ready then ParentCenterColor := TsHackedControl(Parent).Color else {v4.61} ParentCenterColor := clFuchsia;
      if not FDrawOverBorder then begin
        PaintItemBG(FCommonData, ci, CurrentState, Rect(0, 0, Width - ArrowWidth, Height), Point(Left, Top), FCommonData.FCacheBMP, integer(Down), integer(Down));
        DrawCaption;
        DrawGlyph;
        Mode := FCommonData.SkinManager.GetMaskIndex(FCommonData.SkinIndex, FCommonData.SkinSection, s_BordersMask);
        inc(ci.X, Left);
        inc(ci.Y, Top);
        if FCommonData.SkinManager.IsValidImgIndex(Mode) then DrawSkinRect(FCommonData.FCacheBMP, Rect(0, 0, Width - ArrowWidth, Height), True, ci, FCommonData.SkinManager.ma[Mode], CurrentState, False);
      end
      else begin
        PaintItem(FCommonData, CI, True, CurrentState, Rect(0, 0, Width - ArrowWidth, Height), Point(Left, Top), FCommonData.FCacheBMP, False, integer(Down), integer(Down));
        DrawCaption;
        DrawGlyph;
      end;
      if FButtonStyle = tbsDropDown then begin
        if ((Assigned(DropDownMenu) and DroppedDown) or Down or (FState in [bsDown, bsExclusive])) then Mode := 2 else if ControlIsActive(FCommonData) then Mode := 1 else Mode := 0;
        CI := GetParentCache(FCommonData);
        if not FDrawOverBorder then begin
          PaintItemBG(FCommonData, ci, Mode, Rect(Width - ArrowWidth, 0, Width, Height), Point(Left + Width - ArrowWidth, Top), FCommonData.FCacheBMP, integer(Down), integer(Down));
          inc(ci.X, Left);
          inc(ci.Y, Top);
          w := FCommonData.SkinManager.GetMaskIndex(FCommonData.SkinIndex, FCommonData.SkinSection, s_BordersMask);
          if FCommonData.SkinManager.IsValidImgIndex(Mode) then DrawSkinRect(FCommonData.FCacheBMP, Rect(Width - ArrowWidth, 0, Width, Height), True, ci, FCommonData.SkinManager.ma[w], Mode, False);
        end
        else begin
          PaintItem(FCommonData, CI, True, Mode, Rect(Width - ArrowWidth, 0, Width, Height), Point(Left + Width - ArrowWidth, Top), FCommonData.FCacheBMP, False, integer(Down), integer(Down));
        end;
        if FCommonData.SkinManager.ConstData.MaskArrowBottom > -1 then with FCommonData.SkinManager do begin

          R.Left := Width - ArrowWidth;
          R.Right := Width;

          x := R.Left + (ArrowWidth - WidthOf(FCommonData.SkinManager.ma[ConstData.MaskArrowBottom].R) div FCommonData.SkinManager.ma[ConstData.MaskArrowBottom].ImageCount) div 2 + 1;// + 2;
          y := (Height - HeightOf(ma[ConstData.MaskArrowBottom].R) div (1 + ma[ConstData.MaskArrowBottom].MaskType)) div 2;

          CtrlParentColor := clFuchsia;
          DrawSkinGlyph(FCommonData.FCacheBmp, Point(x, y), Mode, 1, ma[ConstData.MaskArrowBottom]);
        end;
      end;
      CtrlParentColor := clFuchsia;
      if not Enabled then begin
        CI := GetParentCache(FCommonData); // v4.61
        if CI.Ready and not SkinData.RepaintIfMoved and not FCommonData.UrgentPainting then begin
          ParentCenterColor := CI.Bmp.Canvas.Pixels[CI.Bmp.Width div 2, CI.Bmp.Height div 2];
        end;
        BmpDisabledKind(FCommonData.FCacheBmp, FDisabledKind, Parent, CI, Point(Left, Top));
        ParentCenterColor := clFuchsia;
      end;
      if Assigned(FOnPaint) then FOnPaint(Self, FCommonData.FCacheBmp);
    end;
  end;
  FCommonData.BGChanged := False;
end;

procedure TsSpeedButton.SetAlignment(const Value: TAlignment);
begin
  if FAlignment <> Value then begin
    FAlignment := Value;
    if Visible then FCommonData.BGChanged := True;
    GraphRepaint;
  end;
end;

procedure TsSpeedButton.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;
    if Visible then FCommonData.BGChanged := True;
    GraphRepaint;
  end;
end;

procedure TsSpeedButton.SetButtonStyle(const Value: TToolButtonStyle);
begin
  if FButtonStyle <> Value then begin
    if not (csLoading in ComponentState) then begin
      if Value = tbsDropDown then Width := Width + AddedWidth else if FButtonStyle = tbsDropdown then Width := Width - AddedWidth;
    end;
    FButtonStyle := Value;
    if Visible then FCommonData.BGChanged := True;
    GraphRepaint;
  end;
end;

procedure TsSpeedButton.SetDisabledGlyphKind(const Value: TsDisabledGlyphKind);
var
  n : integer;
begin
  if FDisabledGlyphKind <> Value then begin
    FDisabledGlyphKind := Value;
    if not FCommonData.Skinned 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;
    if Visible then FCommonData.BGChanged := True;
    GraphRepaint;
  end;
end;

procedure TsSpeedButton.SetDisabledKind(const Value: TsDisabledKind);
begin
  if FDisabledKind <> Value then begin
    FDisabledKind := Value;
    if Visible then FCommonData.BGChanged := True;
//    if not Enabled then
    GraphRepaint;
  end;
end;

procedure TsSpeedButton.SetGrayed(const Value: boolean);