📄 suitabcontrol.pas
字号:
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 + -