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

📄 suititlebar.pas

📁 新颖按钮控件
💻 PAS
📖 第 1 页 / 共 3 页
字号:
    if Buf.Canvas.TextWidth(Caption) > nLeft - nLeft2 then
        Cap := Copy(Caption, 1, 2) + '...'
    else
        Cap := Caption;

    if m_UIStyle = DeepBlue then
        Buf.Canvas.TextOut(nLeft2, 4, Cap)
    else
        Buf.Canvas.TextOut(nLeft2, (Buf.Height - Buf.Canvas.TextHeight(Cap)) div 2, Cap);

    BtnBuf.Free();
end;

function TsuiTitleBar.InForm: Boolean;
begin
    if (
        (Parent is TsuiForm) and
        (Parent <> nil)
    ) then
        Result := true
    else
        Result := false;
end;

procedure TsuiTitleBar.SetDrawAppIcon(const Value: Boolean);
begin
    m_DrawAppIcon := Value;

    Repaint();
end;

procedure TsuiTitleBar.DrawSectionsTo(Buf: TBitmap);
var
    i : Integer;
    nLeft, nRight : Integer;
    Sec : TsuiTitleBarSection;
    R : TRect;
    nClient : Integer;
begin
    nLeft := -1;
    nRight := Buf.Width + 1;
    nClient := -1;

    for i := 0 to m_Sections.Count - 1 do
    begin
        Sec := m_Sections.Items[i];

        case Sec.Align of

        suiLeft :
        begin

            if Sec.Stretch then
            begin
                if Sec.Picture <> nil then
                begin
                    R := Rect(nLeft + 1, 0, nLeft + 1 + Sec.Width, Buf.Height);
                    Buf.Canvas.StretchDraw(R, Sec.Picture.Graphic);
                end
            end
            else
            begin
                if Sec.Picture <> nil then
                    BitBlt(Buf.Canvas.Handle, nLeft + 1, 0, nLeft + 1 + Sec.Width, Buf.Height, Sec.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
            end;
            Inc(nLeft, Sec.Width);
        end; // suiLeft

        suiRight :
        begin
            if Buf.Width - nLeft < Sec.Width then
                continue;

            if Sec.Stretch then
            begin
                if Sec.Picture <> nil then
                begin
                    R := Rect(nRight - 1 - Sec.Width, 0, nRight - 1, Buf.Height);
                    Buf.Canvas.StretchDraw(R, Sec.Picture.Graphic);
                end;
            end
            else
            begin
                if Sec.Picture <> nil then
                    BitBlt(Buf.Canvas.Handle, nRight - 1 - Sec.Width, 0, nRight - 1, Buf.Height, Sec.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
            end;
            Dec(nRight, Sec.Width);
        end; // suiRight

        suiClient :
        begin
            nClient := i;
        end; // suiClient

        end; // case
    end; // for

    if nClient = -1 then
        Exit;

    Sec := m_Sections.Items[nClient];
    if Sec.Picture <> nil then
    begin
        R := Rect(nLeft + 1, 0, nRight - 1, Buf.Height);
        Buf.Canvas.StretchDraw(R, Sec.Picture.Graphic);
    end;
end;

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

    if Button <> mbLeft then
        Exit;

    m_MouseDown := true;
    Repaint();

    if (
        (m_InButtons = -1) and
        (GetParentForm(self).WindowState <> wsMaximized)
    ) then
    begin
        ReleaseCapture();
        SendMessage(GetParentForm(self).Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);
        m_MouseDown := false;
    end;
end;

procedure TsuiTitleBar.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
    inherited;

    Repaint();
end;

procedure TsuiTitleBar.MouseOut(var Msg: TMessage);
begin
    inherited;

    Repaint();
end;

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

    if Button <> mbLeft then
        Exit;

    if m_InButtons <> -1 then
    begin
        m_Buttons.Items[m_InButtons].DoClick();
        if (
            Assigned(m_OnBtnClick) and
            (m_Buttons.Items[m_InButtons].ButtonType = suiCustom)
        ) then
            m_OnBtnClick(self, m_InButtons)

        else if(
            Assigned(m_OnHelpBtnClick) and
            (m_Buttons.Items[m_InButtons].ButtonType = suiHelp)
        ) then
            m_OnHelpBtnClick(self, m_InButtons);
    end;
    m_MouseDown := false;
    Repaint();
end;

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

procedure TsuiTitleBar.Paint;
var
    Buf : TBitmap;
begin
    Buf := TBitmap.Create();
    Buf.Canvas.Brush.Style := bsClear;
    Buf.Canvas.Font := Font;

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

        DrawSectionsTo(Buf);
        DrawButtons(Buf);

        BitBlt(Canvas.Handle, 0, 0, Buf.Width, Buf.Height, Buf.Canvas.Handle, 0, 0, SRCCOPY);

    finally
        Buf.Free();
    end;
end;

procedure TsuiTitleBar.OnFormReSize;
begin
    if InForm() then
        SetFormRoundCorner(m_RoundCorner);
end;

procedure TsuiTitleBar.SetActive(const Value: Boolean);
begin
    m_Active := Value;

    Repaint();
end;

procedure TsuiTitleBar.FSetAutoSize(Value: Boolean);
begin
    m_AutoSize := Value;

    if Sections.Count > 0 then
        Height := Sections.Items[0].Picture.Height
    else
        m_AutoSize := false;
end;

procedure TsuiTitleBar.SetButtonInterval(const Value: Integer);
begin
    m_ButtonInterval := Value;

    Repaint();
end;

procedure TsuiTitleBar.SetButtons(const Value: TsuiTitleBarButtons);
begin
    m_Buttons.Assign(Value);
end;

procedure TsuiTitleBar.SetCaption(const Value: TCaption);
begin
    m_Caption := Value;

    Repaint();
end;

procedure TsuiTitleBar.SetSections(const Value: TsuiTitleBarSections);
begin
    m_Sections.Assign(Value);
end;

procedure TsuiTitleBar.SetUIStyle(const Value: TsuiUIStyle);
var
    Sec : TsuiTitleBarSection;
    i : Integer;
    Form : TCustomForm;
begin
    m_UIStyle := Value;

    Sections.Clear();

    if m_UIStyle = Custom then
    begin
        Repaint();
        Exit;
    end;

    Sec := Sections.Add();
    Sec.Picture.Bitmap.LoadFromResourceName(
        hInstance,
        GetThemeString(m_UIStyle, SUI_TITLEBAR_LEFT_IMAGE)
    );
    Sec.AutoSize := true;

    Sec := Sections.Add();
    Sec.Picture.Bitmap.LoadFromResourceName(
        hInstance,
        GetThemeString(m_UIStyle, SUI_TITLEBAR_RIGHT_IMAGE)
    );
    Sec.AutoSize := true;
    Sec.Align := suiRight;

    Sec := Sections.Add();
    Sec.Picture.Bitmap.LoadFromResourceName(
        hInstance,
        GetThemeString(m_UIStyle, SUI_TITLEBAR_CLIENT_IMAGE)
    );
    Sec.Align := suiClient;

    LeftBtnXOffset := GetThemeInt(m_UIStyle, SUI_TITLEBUTTON_LEFTXOFFSET);
    RightBtnXOffset := GetThemeInt(m_UIStyle, SUI_TITLEBUTTON_RIGHTXOFFSET);

    Form := GetParentForm(self);
    if Form <> nil then
        Form.Constraints.MinWidth := GetThemeInt(m_UIStyle, SUI_FORM_MIN_WIDTH);

    m_RoundCorner := GetThemeInt(m_UIStyle, SUI_FORM_ROUND_CORNER);

    if InForm() then
        SetFormRoundCorner(m_RoundCorner);

    for i := 0 to m_Buttons.Count - 1 do
        m_Buttons.Items[i].UIStyle := m_UIStyle;

    AutoSize := true;
    Repaint();
end;

procedure TsuiTitleBar.SetFormRoundCorner(Round: Integer);
var
    R : TRect;
    Rgn : HRGN;
    TempRgn: HRGN;
    Form : TCustomForm;
begin
    Form := GetParentForm(self);
    if Form = nil then
        Exit;

    R := Form.ClientRect;
    Rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right + 1, R.Bottom + 1, Round, Round);

    TempRgn := CreateRectRgn(
        Form.ClientRect.Left,
        Form.ClientRect.Bottom,
        Form.ClientRect.Left + Round * 2,
        Form.ClientRect.Bottom - Round * 2
    );
    CombineRgn(Rgn, Rgn, TempRgn, RGN_OR);
    DeleteObject(TempRgn);

    TempRgn := CreateRectRgn(
        Form.ClientRect.Right,
        Form.ClientRect.Bottom,
        Form.ClientRect.Right - Round * 2,
        Form.ClientRect.Bottom - Round * 2
    );
    CombineRgn(Rgn, Rgn, TempRgn, RGN_OR );
    DeleteObject(TempRgn);

    if not (csDesigning in ComponentState) then
        SetWindowRgn(Form.Handle, Rgn, true);

    DeleteObject(Rgn);
end;

{ TsuiTitleBarSection }

constructor TsuiTitleBarSection.Create(Collection: TCollection);
begin
    inherited;

    m_Picture := TPicture.Create();
    m_Width := 10;
    m_Align := suiLeft;
    m_Stretch := false;
    m_AutoSize := false;
end;

destructor TsuiTitleBarSection.Destroy;
begin
    m_Picture.Free();
    m_Picture := nil;

    inherited;
end;

procedure TsuiTitleBarSection.SetAlign(const Value: TsuiTitleBarAlign);
var
    i : Integer;
begin
    if Value = suiClient then
    begin
        for i := 0 to (Collection as TsuiTitleBarSections).Count - 1 do
        begin
            if (Collection as TsuiTitleBarSections).Items[i].Align = suiClient then
            begin
                MessageDlg('Sorry, only one section''s Align property can be "suiClient"', mtError, [mbOK], 0);
                Exit;
            end;
        end;

        m_Stretch := true;
    end;

    m_Align := Value;

    (Collection as TsuiTitleBarSections).m_TitleBar.Repaint();
end;

procedure TsuiTitleBarSection.SetAutoSize(const Value: Boolean);
begin
    m_AutoSize := Value;

    if m_Picture.Graphic <> nil then
        m_Width := m_Picture.Width;
    (Collection as TsuiTitleBarSections).m_TitleBar.Repaint();
end;

procedure TsuiTitleBarSection.SetPicture(const Value: TPicture);
begin
    m_Picture.Assign(Value);

    if Value <> nil then
        if m_AutoSize then
            m_Width := m_Picture.Width;

    (Collection as TsuiTitleBarSections).m_TitleBar.Repaint();
end;

procedure TsuiTitleBarSection.SetStretch(const Value: Boolean);
begin
    m_Stretch := Value;

    if m_Align = suiClient then

⌨️ 快捷键说明

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