⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 suibutton.pas

📁 suipack ver5控件 suipack ver5控件 suipack ver5控件 suipack ver5控件 suipack ver5控件
💻 PAS
📖 第 1 页 / 共 4 页
字号:
begin
    Result := inherited TabStop;
end;

procedure TsuiCustomButton.SetTabStop(Value: Boolean);
begin
    inherited TabStop := Value;
end;

procedure TsuiCustomButton.SetFileTheme(const Value: TsuiFileTheme);
begin
    m_FileTheme := Value;
    SetUIStyle(m_UIStyle);
end;

procedure TsuiCustomButton.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
    inherited;

    if (
        (Operation = opRemove) and
        (AComponent = m_FileTheme)
    )then
    begin
        m_FileTheme := nil;
        SetUIStyle(SUI_THEME_DEFAULT);
    end;
end;

procedure TsuiCustomButton.PaintButton(ThemeIndex, Count, Index : Integer; const Buf : TBitmap);
var
    OutUIStyle : TsuiUIStyle;
begin
    if UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
        m_FileTheme.GetBitmap(ThemeIndex, Buf, Count, Index)
    else
        GetInsideThemeBitmap(OutUIStyle, ThemeIndex, Buf, Count, Index);
end;


procedure TsuiCustomButton.CMTextChanged(var Msg: TMessage);
begin
    Caption := inherited Caption;
end;

procedure TsuiCustomButton.SetFocusedRectMargin(const Value: Integer);
begin
    m_FocusedRectMargin := Value;
    Repaint();
end;

procedure TsuiCustomButton.CreateWnd;
begin
    inherited;
    m_Active := m_Default;
end;

{ TsuiButton }

procedure TsuiButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
    inherited;

    if Sender is TCustomAction then
        with TCustomAction(Sender) do
        begin
            if (
                (Glyph.Empty) and
                (ActionList <> nil) and
                (ActionList.Images <> nil) and
                (ImageIndex >= 0) and
                (ImageIndex < ActionList.Images.Count)
            ) then
            begin
                ActionList.Images.GetBitmap(ImageIndex, m_Glyph);
                Repaint();
            end;
        end;
end;

constructor TsuiButton.Create(AOwner: TComponent);
begin
    inherited;

    Height := 27;
    Width := 80;
    m_Spacing := 4;
    m_Glyph := TBitmap.Create();
end;

destructor TsuiButton.Destroy;
begin
    m_Glyph.Free();
    m_Glyph := nil;

    inherited;
end;

function TsuiButton.GetResHandle: Cardinal;
begin
    Result := 0;
end;

procedure TsuiButton.PaintFocus(ACanvas: TCanvas);
begin
    if {$IFDEF RES_MACOS} (UIStyle = MacOS) {$ELSE} false {$ENDIF} or
        {$IFDEF RES_BLUEGLASS} (UIStyle = BlueGlass) {$ELSE} false {$ENDIF} then
    begin
        m_BoldFont := true;
        Exit;
    end;

    inherited
end;

procedure TsuiButton.PaintPic(ACanvas: TCanvas; Bitmap: TBitmap);
var
    CapWidth : Integer;
    CapHeight : Integer;
    GlyphLeft : Integer;
    GlyphTop : Integer;
    GlyphWidth : Integer;
    GlyphHeight : Integer;
    ImageList : TImageList;
    IncludedDisable : Boolean;
begin
    ACanvas.Font := Font;
    SpitDraw(Bitmap, ACanvas, ClientRect, PicTransparent);

    if m_Glyph.Empty then
        Exit;

    CapWidth := ACanvas.TextWidth(Caption);
    CapHeight := ACanvas.TextHeight(Caption);

    GlyphLeft := 0;
    GlyphTop := 0;
    GlyphWidth := m_Glyph.Width;
    GlyphHeight := m_Glyph.Height;
    IncludedDisable := false;

    if GlyphWidth = GlyphHeight * 2 then
    begin
        GlyphWidth := GlyphHeight;
        IncludedDisable := true;
    end;

    case m_Layout of

    blGlyphLeft :
    begin
        GlyphLeft := (Width - (CapWidth + GlyphWidth + m_Spacing)) div 2;
        GlyphTop := (Height - GlyphHeight) div 2;
        m_TextPoint := Point(GlyphLeft + GlyphWidth + m_Spacing, (Height - CapHeight) div 2);
    end;

    blGlyphRight :
    begin
        GlyphLeft := (Width + CapWidth + m_Spacing - GlyphWidth) div 2;
                  // (Width - (CapWidth + GlyphWidth + GLYPH_TEXT)) div 2 + CapWidth + GLYPH_TEXT;
        GlyphTop := (Height - GlyphHeight) div 2;
        m_TextPoint := Point(GlyphLeft - CapWidth - m_Spacing, (Height - CapHeight) div 2);
    end;

    blGlyphTop :
    begin
        GlyphLeft := (Width - GlyphWidth) div 2;
        GlyphTop := (Height - (CapHeight + GlyphHeight + m_Spacing)) div 2;
        m_TextPoint := Point((Width - CapWidth) div 2, GlyphTop + GlyphHeight + m_Spacing);
    end;

    blGlyphBottom :
    begin
        GlyphLeft := (Width - GlyphWidth) div 2;
        GlyphTop := (Height + CapHeight + m_Spacing - GlyphHeight) div 2;
        m_TextPoint := Point((Width - CapWidth) div 2, GlyphTop - CapHeight - m_Spacing);
    end;

    end; // case

    if m_MouseDown then
    begin
        Inc(GlyphLeft);
        Inc(GlyphTop);
    end;

    ImageList := TImageList.CreateSize(GlyphWidth, GlyphHeight);

    try
        ImageList.AddMasked(m_Glyph, m_Glyph.Canvas.Pixels[0, 0]);

        if not IncludedDisable then
            ImageList.Draw(ACanvas, GlyphLeft, GlyphTop, 0, Enabled)
        else
            ImageList.Draw(ACanvas, GlyphLeft, GlyphTop, Integer(not Enabled));
    finally
        ImageList.Free();
    end;
end;

procedure TsuiButton.PaintText(ACanvas: TCanvas; Text: String);
var
    R : TRect;
begin
    if m_Glyph.Empty then
    begin
        inherited;
        Exit;
    end;

    ACanvas.Brush.Style := bsClear;
    ACanvas.Font := Font;

    if not Enabled then
    begin
        ACanvas.Font.Color := clWhite;
        R := Rect(m_TextPoint.X + 1,  m_TextPoint.Y + 1, Width, Height);
        DrawText(ACanvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_TOP or DT_SINGLELINE);
        ACanvas.Font.Color := clGray;
    end
    else
    begin
        if m_MouseDown then
        begin
            Inc(m_TextPoint.X);
            Inc(m_TextPoint.Y);
        end;
    end;

    R := Rect(m_TextPoint.X, m_TextPoint.Y, Width, Height);
    DrawText(ACanvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_TOP or DT_SINGLELINE);
end;

procedure TsuiButton.SetGlyph(const Value: TBitmap);
begin
    m_Glyph.Assign(Value);
    Repaint();
end;

procedure TsuiButton.SetLayout(const Value: TButtonLayout);
begin
    m_Layout := Value;
    Repaint();
end;

procedure TsuiButton.SetResHandle(const Value: THandle);
begin
    // do nothing
end;

procedure TsuiButton.SetSpacing(const Value: Integer);
begin
    m_Spacing := Value;
    Repaint();
end;

procedure TsuiButton.UIStyleChanged;
var
    OutUIStyle : TsuiUIStyle;
begin
    if UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
        Transparent := m_FileTheme.GetBool(SUI_THEME_BUTTON_TRANSPARENT_BOOL)
    else
        Transparent := GetInsideThemeBool(OutUIStyle, SUI_THEME_BUTTON_TRANSPARENT_BOOL);
end;

{ TsuiCheckBox }

procedure TsuiCheckBox.CheckStateChanged;
begin
    if csLoading in ComponentState then
        Exit;
    if Assigned(OnClick) then
        OnClick(self);
end;

procedure TsuiCheckBox.Click;
begin
    DoClick();

    inherited;
end;

procedure TsuiCheckBox.CMDialogChar(var Msg: TCMDialogChar);
begin
    inherited;

    if IsAccel(Msg.CharCode, Caption) and Enabled then
    begin
        if CanFocus() and Enabled and Visible then
        try
            SetFocus();
        except end;
        Click();
        Msg.Result := 1;
    end
    else
        Msg.Result := 0;
end;

procedure TsuiCheckBox.CMFocusChanged(var Msg: TCMFocusChanged);
begin
    inherited;

    Repaint();
end;

procedure TsuiCheckBox.CMFONTCHANGED(var Msg: TMessage);
begin
    Repaint();
end;

procedure TsuiCheckBox.CMTextChanged(var Msg: TMessage);
begin
    Repaint();
end;

constructor TsuiCheckBox.Create(AOwner: TComponent);
begin
    inherited;

    Checked := false;
    m_Transparent := false;
    AutoSize := true;
    Height := 17;
    Width := 93;
    ControlStyle := ControlStyle - [csDoubleClicks];
    TabStop := true;

    UIStyle := GetSUIFormStyle(AOwner);
end;

procedure TsuiCheckBox.DoClick;
begin
    Toggle();
    Checked := not Checked;
end;

function TsuiCheckBox.GetPicThemeIndex: Integer;
begin
    Result := SUI_THEME_CHECKBOX_IMAGE;
end;

function TsuiCheckBox.GetPicTransparent: Boolean;
begin
    Result := false;
end;

function TsuiCheckBox.GetState: TCheckBoxState;
begin
    if Checked then
        Result := cbChecked
    else
        Result := cbUnchecked
end;

procedure TsuiCheckBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
    inherited;

    if (Button = mbLeft) and CanFocus() and Enabled and Visible then
    try
        SetFocus();
    except end;
end;

function TsuiCheckBox.NeedDrawFocus: Boolean;
begin
    Result := TabStop and Focused;
end;

procedure TsuiCheckBox.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
    inherited;

    if AComponent = nil then
        Exit;
    if (
        (Operation = opRemove) and
        (AComponent = m_FileTheme)
    )then
    begin
        m_FileTheme := nil;
        SetUIStyle(SUI_THEME_DEFAULT);
    end;
end;

procedure TsuiCheckBox.Paint;
var
    Buf, Bmp : TBitmap;
    OutUIStyle : TsuiUIStyle;
    Index : Integer;
    R : TRect;
    X, Y : Integer;
begin
    Buf := TBitmap.Create();
    Bmp := TBitmap.Create();
    Bmp.Transparent := GetPicTransparent();

    if m_Checked then
    begin
        if Enabled then
            Index := 1
        else
            Index := 3;
    end
    else
    begin
        if Enabled then
            Index := 2
        else
            Index := 4;
    end;
    
    Buf.Canvas.Font.Assign(Font);
    if UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
        m_FileTheme.GetBitmap(GetPicThemeIndex(), Bmp, 4, Index)
    else
        GetInsideThemeBitmap(OutUIStyle, GetPicThemeIndex(), Bmp, 4, Index);

    if m_AutoSize then
    begin
        Height := Max(Buf.Canvas.TextHeight('W') + 2, Bmp.Height) + 4;
        Width := Bmp.Width + 8 + Buf.Canvas.TextWidth(Caption);
    end;

    Buf.Height := Height;
    Buf.Width := Width;

    if Transparent then
    begin
        if Parent <> nil then
        begin
            if Parent is TTabSheet then
                DoTrans(Buf.Canvas, Parent)
            else
                DoTrans(Buf.Canvas, self);            
        end
        else
            DoTrans(Buf.Canvas, self);
    end
    else
    begin
        Buf.Canvas.Brush.Color := Color;
        Buf.Canvas.FillRect(ClientRect);
    end;

    Buf.Canvas.Brush.Style := bsClear;
    Y := (ClientHeight - Buf.Canvas.TextHeight('W')) div 2;
    if (BidiMode = bdRightToLeft) and SysLocale.MiddleEast then
    begin
        Buf.Canvas.Draw(Width - Bmp.Width - 1, (ClientHeight - Bmp.Height) div 2, Bmp);
        X := Bmp.Width + 4;
        R := Rect(0, Y, Width - X, Height);
        DrawText(Buf.Canvas.Handle, PChar(Caption), -1, R, DT_RIGHT or DT_TOP or DT_SINGLELINE);
    end
    else
    begin
        Buf.Canvas.Draw(1, (ClientHeight - Bmp.Height) div 2, Bmp);
        X := Bmp.Width + 4;
        R := Rect(X, Y, Width, Height);
        DrawText(Buf.Canvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_TOP or DT_SINGLELINE);
    end;

    if NeedDrawFocus() then
    begin
        if (BidiMode = bdRightToLeft) and SysLocale.MiddleEast then
            R := Rect(0, Y, Width - X + 2, Y + Buf.Canvas.TextHeight('W') + 2)
        else
            R := Rect(X - 1, Y, Width, Y + Buf.Canvas.TextHeight('W') + 2);
        Buf.Canvas.Brush.Style := bsSolid;
        Buf.Canvas.DrawFocusRect(R);
    end;

    Canvas.Draw(0, 0, Buf);
    Bmp.Free();
    Buf.Free();
end;

procedure TsuiCheckBox.SetAutoSize2(const Value: Boolean);
begin
    m_AutoSize := Value;
    Repaint();
end;

procedure TsuiCheckBox.SetChecked(const Value: Boolean);
begin
    if m_Checked = Value then
        Exit;
    m_Checked := Value;
    Repaint();    

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -