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

📄 suibutton.pas

📁 SUIPack是一款为Delphi和C++Builder开发的所见即所得的界面增强VCL组件
💻 PAS
📖 第 1 页 / 共 4 页
字号:
        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.GetBitmap2(SKIN2_BUTTON, 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;

procedure TsuiCustomButton.CancelMode(var Msg: TMessage);
begin
    inherited;

    m_MouseIn := false;
    m_MouseDown := false;
    if m_Timer <> nil then
    begin
        m_Timer.Free();
        m_Timer := nil;
    end;

    Repaint();
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
    begin
        Transparent := m_FileTheme.GetBool(SKIN2_BUTTONTRANS);
        Font.Color := m_FileTheme.GetColor(SKIN2_BUTTONFONTCOLOR);
    end
    else
    begin
        Transparent := GetInsideThemeBool(OutUIStyle, SUI_THEME_BUTTON_TRANSPARENT_BOOL);
        Font.Color := clBlack;        
    end;
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 and Visible and ((Parent <> nil) and (Parent.Enabled)) then
    begin
        if CanFocus() 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.GetPicThemeIndexOuter: Tsk2SkinBitmapElement;
begin
    Result := SKIN2_CHECKBOX;
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;
    C : Integer;
begin
    Buf := TBitmap.Create();
    Bmp := TBitmap.Create();
    Bmp.Transparent := GetPicTransparent();

    if (GetPicThemeIndex() = SUI_THEME_CHECKBOX_IMAGE) and UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
    begin
        if m_Checked then
        begin
            if Enabled then
                Index := 1
            else
                Index := 4;
        end
        else
        begin
            if Enabled then
                Index := 3
            else
                Index := 6;
        end;
        C := 6;
    end
    else
    begin
        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;
        C := 4;
    end;

    Buf.Canvas.Font.Assign(Font);
    if UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
        m_FileTheme.GetBitmap2(GetPicThemeIndexOuter(), Bmp, C, 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;

⌨️ 快捷键说明

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