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

📄 suitabcontrol.pas

📁 suipack ver5控件 suipack ver5控件 suipack ver5控件 suipack ver5控件 suipack ver5控件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
    end
    else
    begin
        Buf.Canvas.StretchDraw(
            Rect(1, 0, Width - 1, m_Line.Height),
            m_Line
        );

        Buf.Canvas.Pen.Color := m_TabControl.BorderColor;
        Buf.Canvas.MoveTo(0, 0);
        Buf.Canvas.LineTo(0, m_Line.Height);
        Buf.Canvas.MoveTo(Width - 1, 0);
        Buf.Canvas.LineTo(Width - 1, m_Line.Height);
        T1 := Height - m_InactiveTab.Height;
        T2 := Height;
        T3 := T1 - 1;
        T4 := T2 - 1;
    end;

    nLeft := m_LeftMargin;

    Buf.Canvas.Font := m_TabControl.Font;

    nShowed := 0;

    OverRightBorder := false;
    Result := m_Tabs.Count - 1;
    for i := 0 to m_Tabs.Count - 1 do
    begin
        if i = m_Tabs.Count - 1 then
            RightBorder := RightBorder2
        else
            RightBorder := RightBorder1;

        if not m_TabVisible[i] then
        begin
            m_TabPos[i] := 0;
            continue;
        end;

        if OverRightBorder then
            break;
            
        if m_Tabs[i] <> '' then
            nWidth := Buf.Canvas.TextWidth(m_Tabs[i]) + 20
        else
            nWidth := 80;
        if nWidth < 15 then
            nWidth := 15;
        if i < SUI_TABCONTROL_MAXTABS - 1 then
            m_TabPos[i] := nWidth;

        Inc(nShowed);
        if nShowed <= m_Passed then
            continue;

        if m_TabIndex = i then
        begin
            R := Rect(nLeft, T3, nWidth + nLeft, T4);
            if R.Right > RightBorder then
            begin
                R.Right := RightBorder1;
                OverRightBorder := true;
                Result := i - 1;
            end;
            SpitDrawHorizontal(m_ActiveTab, Buf.Canvas, R, ATrans, ASampleTop);
        end
        else
        begin
            R := Rect(nLeft, T1, nWidth + nLeft, T2);
            if R.Right > RightBorder then
            begin
                R.Right := RightBorder1;
                m_TabPos[i] := R.Right - R.Left;
                OverRightBorder := true;
                Result := i - 1;
            end;
            SpitDrawHorizontal(m_InactiveTab, Buf.Canvas, R, ITrans, ISampleTop);
        end;

        Inc(nLeft, nWidth);
        Buf.Canvas.Brush.Style := bsClear;
        if OverRightBorder then
        begin
            R.Left := R.Left + 10;
            R.Right := R.Right - 4;
            DrawText(Buf.Canvas.Handle, PAnsiChar(m_Tabs[i]), -1, R, DT_SINGLELINE or DT_VCENTER);
        end
        else
            DrawText(Buf.Canvas.Handle, PAnsiChar(m_Tabs[i]), -1, R, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
    end;

    if ((nLeft > RightBorder) or OverRightBorder) and (m_Tabs.Count <> 0) then
        m_ShowButton := true
    else
        m_ShowButton := false;
end;

procedure TsuiTabControlTopPanel.RequestAlign;
var
    R : TRect;
begin
    if m_TabControl <> nil then
    begin
        if m_TabPosition = suiTop then
            R := Rect(0, 0, m_TabControl.Width, Height)
        else
            R := Rect(0, m_TabControl.Height - Height, m_TabControl.Width, m_TabControl.Height);
        PlaceControl(self, R);
    end
    else
        inherited;
end;

procedure TsuiTabControlTopPanel.Resize;
begin
    inherited;

    if m_TabControl <> nil then
    begin
        if m_TabPosition = suiTop then
            SetBounds(0, 0, m_TabControl.Width, Height)
        else
        begin
            Top := m_TabControl.Height - Height;
            Left := 0;
            Width := m_TabControl.Width;
        end;
    end;
end;

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

procedure TsuiTabControlTopPanel.SetLeftMargin(const Value: Integer);
begin
    m_LeftMargin := Value;

    Repaint();
end;

procedure TsuiTabControlTopPanel.SetTabIndex(const Value: Integer);
var
    bAllow : Boolean;
begin
    if m_TabIndex = Value then
        Exit;
    if m_Tabs.Count = 0 then
    begin
        m_TabIndex := -1;
        Repaint();
        Exit;
    end;

    if (
        (Value < -1) or
        (Value > m_Tabs.Count -1)
    ) then
    begin
        Repaint();
        Exit;
    end;

    if m_UserChanging then
    begin
        bAllow := true;
        if Assigned(m_TabControl.m_OnChanging) then
            m_TabControl.m_OnChanging(m_TabControl, bAllow);
        if not bAllow then
            Exit;
    end;
    m_TabIndex := Value;
    m_AutoFit := true;
    Repaint();
    m_AutoFit := false;
    m_TabControl.TabActive(m_TabIndex);
end;

procedure TsuiTabControlTopPanel.SetTabPosition(const Value: TsuiTabPosition);
begin
    if m_TabPosition = Value then
        Exit;
    m_TabPosition := Value;
    RoundPicture2(m_ActiveTab);
    RoundPicture2(m_InactiveTab);
    RoundPicture2(m_Line);
    Repaint();
end;

procedure TsuiTabControlTopPanel.SetTabs(const Value: TStrings);
begin
    m_Tabs.Assign(Value);
end;

procedure TsuiTabControlTopPanel.SetUIStyle(const Value: TsuiUIStyle);
var
    BtnBitmap : TBitmap;
    OutUIStyle : TsuiUIStyle;
begin
    m_UIStyle := Value;

    BtnBitmap := TBitmap.Create();

    if UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
    begin
        m_FileTheme.GetBitmap(SUI_THEME_TABCONTROL_TAB_IMAGE, m_ActiveTab, 2, 1);
        m_FileTheme.GetBitmap(SUI_THEME_TABCONTROL_TAB_IMAGE, m_InactiveTab, 2, 2);
        m_FileTheme.GetBitmap(SUI_THEME_TABCONTROL_BAR_IMAGE, m_Line);
        m_FileTheme.GetBitmap(SUI_THEME_SCROLLBUTTON_IMAGE, BtnBitmap, 4, 1);
    end
    else
    begin
        GetInsideThemeBitmap(OutUIStyle, SUI_THEME_TABCONTROL_TAB_IMAGE, m_ActiveTab, 2, 1);
        GetInsideThemeBitmap(OutUIStyle, SUI_THEME_TABCONTROL_TAB_IMAGE, m_InactiveTab, 2, 2);
        GetInsideThemeBitmap(OutUIStyle, SUI_THEME_TABCONTROL_BAR_IMAGE, m_Line);
        GetInsideThemeBitmap(OutUIStyle, SUI_THEME_SCROLLBUTTON_IMAGE, BtnBitmap, 4, 1);
    end;

    if m_TabPosition = suiBottom then
    begin
        RoundPicture2(m_ActiveTab);
        RoundPicture2(m_InactiveTab);
        RoundPicture2(m_Line);
    end;

    Height := m_ActiveTab.Height + m_Line.Height;
    m_BtnSize.X := BtnBitmap.Width;
    m_BtnSize.Y := BtnBitmap.Height;

    BtnBitmap.Free();
    Repaint();
end;

procedure TsuiTabControlTopPanel.WMERASEBKGND(var Msg: TMessage);
begin
    // do nothing
end;

function TsuiTab.GetLeftMargin: Integer;
begin
    Result := m_TopPanel.LeftMargin;
end;

function TsuiTab.GetTabIndex: Integer;
begin
    Result := m_TopPanel.TabIndex;
end;

function TsuiTab.GetTabs: TStrings;
begin
    Result := m_TopPanel.Tabs;
end;

procedure TsuiTab.Paint;
var
    R : TRect;
begin
    Canvas.Brush.Color := Color;
    if m_TabPosition = suiTop then
        R := Rect(ClientRect.Left, m_TopPanel.Height, ClientRect.Right, ClientRect.Bottom)
    else
        R := Rect(ClientRect.Left, 0, ClientRect.Right, ClientRect.Bottom - m_TopPanel.Height);
    Canvas.FillRect(R);
    Canvas.Pen.Color := m_BorderColor;
    if m_TabPosition = suiTop then
    begin
        Canvas.MoveTo(0, R.Top - 1);
        Canvas.LineTo(0, R.Bottom - 1);
        Canvas.LineTo(R.Right - 1, R.Bottom - 1);
        Canvas.LineTo(R.Right - 1, R.Top - 1);
    end
    else
    begin
        Canvas.MoveTo(R.Right - 1, R.Bottom - 1);
        Canvas.LineTo(R.Right - 1, R.Top);
        Canvas.LineTo(0, R.Top);
        Canvas.LineTo(0, R.Bottom);
    end;
end;

procedure TsuiTab.SetBorderColor(const Value: TColor);
begin
    m_BorderColor := Value;

    BorderColorChanged();
    Repaint();
    m_TopPanel.Repaint();
end;

procedure TsuiTab.SetFont(const Value: TFont);
begin
    m_Font.Assign(Value);
    m_TopPanel.Repaint();
end;

procedure TsuiTab.SetLeftMargin(const Value: Integer);
begin
    m_TopPanel.LeftMargin := Value;
end;

procedure TsuiTab.SetTabIndex(const Value: Integer);
begin
    m_TopPanel.TabIndex := Value;
end;

procedure TsuiTab.SetTabs(const Value: TStrings);
begin
    m_TopPanel.Tabs := Value;
end;

procedure TsuiTab.SetUIStyle(const Value: TsuiUIStyle);
var
    OutUIStyle : TsuiUIStyle;
begin
    m_UIStyle := Value;
    m_TopPanel.FileTheme := m_FileTheme;
    m_TopPanel.UIStyle := m_UIStyle;
    m_TopPanel.Repaint();

    UpdateUIStyle(m_UIStyle, m_FileTheme);
    
    if UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
    begin
        m_TopPanel.Color := m_FileTheme.GetColor(SUI_THEME_CONTROL_BACKGROUND_COLOR);
        m_BorderColor := m_FileTheme.GetColor(SUI_THEME_CONTROL_BORDER_COLOR);
        Color := m_FileTheme.GetColor(SUI_THEME_CONTROL_BACKGROUND_COLOR);
    end
    else
    begin
        m_TopPanel.Color := GetInsideThemeColor(OutUIStyle, SUI_THEME_CONTROL_BACKGROUND_COLOR);
        m_BorderColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_CONTROL_BORDER_COLOR);
        if {$IFDEF RES_WINXP}m_UIStyle <> WinXP{$ELSE} True {$ENDIF} then
            Color := GetInsideThemeColor(OutUIStyle, SUI_THEME_CONTROL_BACKGROUND_COLOR)
        else
            Color := clWhite;
    end;

    Repaint();
end;

procedure TsuiTab.UpdateUIStyle(UIStyle: TsuiUIStyle; FileTheme : TsuiFileTheme);
begin
    ContainerApplyUIStyle(self, UIStyle, FileTheme);
end;

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

    m_TopPanel := CreateTopPanel();
    m_TopPanel.Parent := self;
    m_TopPanel.OnClick := TopPanelClick;
    m_TopPanel.OnDblClick := TopPanelDblClick;
    m_TabPosition := suiTop;

    m_Font := TFont.Create();

    Caption := ' ';
    BevelInner := bvNone;
    BevelOuter := bvNone;
    BorderWidth := 0;
    Height := 80;

    UIStyle := GetSUIFormStyle(AOwner);
    m_TopPanel.SetBounds(0, 0, Width, m_TopPanel.Height);    
end;

destructor TsuiTab.Destroy;
begin
    m_Font.Free();
    m_Font := nil;

    m_TopPanel.Free();
    m_TopPanel := nil;

    inherited;
end;

{ TsuiTabControl }

function TsuiTabControl.CreateTopPanel: TsuiTabControlTopPanel;
begin
    Result := TsuiTabControlTopPanel.Create(self, self);
end;

procedure TsuiTab.TabActive(TabIndex : Integer);
begin
    if not (csLoading in ComponentState) then
    begin
        if Assigned(m_OnTabActive) then
            m_OnTabActive(self, TabIndex);
        if Assigned(m_OnChange) then
            m_OnChange(self);
    end;
end;

procedure TsuiTab.BorderColorChanged;
begin
    // do nothing
end;

procedure TsuiTab.CMCursorChanged(var Message: TMessage);
begin
    m_TopPanel.Cursor := Cursor;
    inherited;
end;

procedure TsuiTab.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 TsuiTab.SetFileTheme(const Value: TsuiFileTheme);
begin
    m_FileTheme := Value;
    SetUIStyle(m_UIStyle);
end;

procedure TsuiTab.AlignControls(AControl: TControl; var Rect: TRect);
begin
    if m_TabPosition = suiTop then
    begin
        Rect.Left := Rect.Left + 3;
        Rect.Right := Rect.Right - 3;
        Rect.Bottom := Rect.Bottom - 3;
        Rect.Top := Rect.Top + m_TopPanel.Height + 3;
    end
    else
    begin
        Rect.Left := Rect.Left + 3;
        Rect.Right := Rect.Right - 3;
        Rect.Top := Rect.Top + 3;
        Rect.Bottom := Rect.Bottom - m_TopPanel.Height - 3;
    end;
    inherited AlignControls(AControl, Rect);
end;

procedure TsuiTab.Resize;
begin
    inherited;

    if m_TabPosition = suiTop then
        m_TopPanel.SetBounds(0, 0, Width, m_TopPanel.Height)
    else
    begin
        m_TopPanel.Top := Height - m_TopPanel.Height;
        m_TopPanel.Left := 0;
        m_TopPanel.Width := Width;
    end;
end;

procedure TsuiTab.WMERASEBKGND(var Message: TMessage);
begin
    // do nothing
end;

procedure TsuiTab.TopPanelClick(Sender: TObject);
begin
    if Assigned(OnClick) then
        OnClick(self);
end;

procedure TsuiTab.TopPanelDblClick(Sender: TObject);
begin
    if Assigned(OnDblClick) then
        OnDblClick(self);
end;

procedure TsuiTab.SetTabPosition(const Value: TsuiTabPosition);
begin
    if m_TabPosition = Value then
        Exit;
    m_TabPosition := Value;
    m_TopPanel.TabPosition := Value;
    m_TopPanel.RequestAlign();
    Realign();
end;

end.

⌨️ 快捷键说明

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