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

📄 suitabcontrol.pas

📁 Delphi界面控件修饰
💻 PAS
📖 第 1 页 / 共 2 页
字号:
        m_FileTheme.GetBitmap(SUI_THEME_TABCONTROL_TAB_IMAGE, InactiveBitmap, 2, 2);
        m_FileTheme.GetBitmap(SUI_THEME_TABCONTROL_BAR_IMAGE, LineBitmap);
    end
    else
    begin
        GetInsideThemeBitmap(OutUIStyle, SUI_THEME_TABCONTROL_TAB_IMAGE, ActiveBitmap, 2, 1);
        GetInsideThemeBitmap(OutUIStyle, SUI_THEME_TABCONTROL_TAB_IMAGE, InactiveBitmap, 2, 2);
        GetInsideThemeBitmap(OutUIStyle, SUI_THEME_TABCONTROL_BAR_IMAGE, LineBitmap);
    end;

    if ActiveBitmap.Canvas.Pixels[0, 0] = clFuchsia then
        ATrans := true
    else
        ATrans := false;
    if InactiveBitmap.Canvas.Pixels[0, 0] = clFuchsia then
        ITrans := true
    else
        ITrans := false;

    m_TabHeight := ActiveBitmap.Height;

    Buf.Canvas.StretchDraw(
        Rect(1, InactiveBitmap.Height, Width - 1, InactiveBitmap.Height + LineBitmap.Height),
        LineBitmap
    );

    Buf.Canvas.Pen.Color := m_TabControl.BorderColor;
    Buf.Canvas.MoveTo(0, InactiveBitmap.Height);
    Buf.Canvas.LineTo(0, InactiveBitmap.Height + LineBitmap.Height);
    Buf.Canvas.MoveTo(Width - 1, InactiveBitmap.Height);
    Buf.Canvas.LineTo(Width - 1, InactiveBitmap.Height + LineBitmap.Height);

    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, 1, nWidth + nLeft, InactiveBitmap.Height + 1);
            if R.Right > RightBorder then
            begin
                R.Right := RightBorder1;
                OverRightBorder := true;
                Result := i - 1;
            end;
            SpitDrawHorizontal(ActiveBitmap, Buf.Canvas, R, ATrans);
        end
        else
        begin
            R := Rect(nLeft, 0, nWidth + nLeft, InactiveBitmap.Height);
            if R.Right > RightBorder then
            begin
                R.Right := RightBorder1;
                m_TabPos[i] := R.Right - R.Left;
                OverRightBorder := true;
                Result := i - 1;
            end;
            SpitDrawHorizontal(InactiveBitmap, Buf.Canvas, R, ITrans);
        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 then
        m_ShowButton := true
    else
        m_ShowButton := false;

    LineBitmap.Free();
    InactiveBitmap.Free();
    ActiveBitmap.Free();
end;

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

procedure TsuiTabControlTopPanel.Resize;
begin
    inherited;

    if m_TabControl <> nil then
        SetBounds(0, 0, m_TabControl.Width, Height);
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.SetTabs(const Value: TStrings);
begin
    m_Tabs.Assign(Value);
end;

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

    ActiveBitmap := TBitmap.Create();
    LineBitmap := TBitmap.Create();
    BtnBitmap := TBitmap.Create();

    if UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
    begin
        m_FileTheme.GetBitmap(SUI_THEME_TABCONTROL_TAB_IMAGE, ActiveBitmap);
        m_FileTheme.GetBitmap(SUI_THEME_TABCONTROL_BAR_IMAGE, LineBitmap);
        m_FileTheme.GetBitmap(SUI_THEME_SCROLLBUTTON_IMAGE, BtnBitmap, 4, 1);
    end
    else
    begin
        GetInsideThemeBitmap(OutUIStyle, SUI_THEME_TABCONTROL_TAB_IMAGE, ActiveBitmap);
        GetInsideThemeBitmap(OutUIStyle, SUI_THEME_TABCONTROL_BAR_IMAGE, LineBitmap);
        GetInsideThemeBitmap(OutUIStyle, SUI_THEME_SCROLLBUTTON_IMAGE, BtnBitmap, 4, 1);
    end;

    Height := ActiveBitmap.Height + LineBitmap.Height;
    m_BtnSize.X := BtnBitmap.Width;
    m_BtnSize.Y := BtnBitmap.Height;

    BtnBitmap.Free();
    LineBitmap.Free();
    ActiveBitmap.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;
    R := Rect(ClientRect.Left, m_TopPanel.Height, ClientRect.Right, ClientRect.Bottom);
    Canvas.FillRect(R);
    Canvas.Pen.Color := m_BorderColor;
    Canvas.MoveTo(0, m_TopPanel.Height);
    Canvas.LineTo(0, Height - 1);
    Canvas.LineTo(Width - 1, Height - 1);
    Canvas.LineTo(Width - 1, m_TopPanel.Height - 1);
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_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
    Rect.Left := Rect.Left + 3;
    Rect.Right := Rect.Right - 3;
    Rect.Bottom := Rect.Bottom - 3;
    Rect.Top := m_TopPanel.Height + 3;
    inherited AlignControls(AControl, Rect);
end;

procedure TsuiTab.Resize;
begin
    inherited;

    m_TopPanel.SetBounds(0, 0, Width, m_TopPanel.Height);
end;

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

end.

⌨️ 快捷键说明

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