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

📄 suiform.pas

📁 Delphi界面控件修饰
💻 PAS
📖 第 1 页 / 共 5 页
字号:
////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUIForm.pas
//  Creator     :   Shen Min
//  Date        :   2002-05-21 V1-V3
//                  2003-06-19 V4
//  Comment     :
//
//  Copyright (c) 2002-2003 Sunisoft
//  http://www.sunisoft.com
//  Email: support@sunisoft.com
//
//  V3 Some code portions by Artyom Kamshilin (artyom@softadvance.com)
//
////////////////////////////////////////////////////////////////////////////////

unit SUIForm;

interface

{$I SUIPack.inc}

uses Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Graphics, Forms,
     ComCtrls, Menus, Dialogs, Buttons,
     SUITitleBar, SUIThemes, SUIMgr, SUIButton, SUIScrollBar, frmMSNPop;

type
    TsuiForm = class(TCustomPanel)
    private
        m_TitleBar : TsuiTitleBar;
        m_MenuBar : TToolBar;
        m_Menu : TMainMenu;
        m_PrevParentWndProc: Pointer;

        m_Form : TForm;
        m_BorderStyle : TFormBorderStyle;
        m_Color : TColor;
        m_Panel : TCustomPanel;
        m_Width : Integer;
        m_UIStyle : TsuiUIStyle;
        m_FileTheme : TsuiFileTheme;        
        m_MenuBarColor : TColor;
        m_MenuBarHeight : Integer;
        m_AppOnMsgAssigned : Boolean;
        m_UIStyleAutoUpdateSub : Boolean;

        m_FormInitRect : TRect;
        m_FormInitMax : Boolean;

        // AK - two new vars to calculate the client area difference
        // this difference will be later used to adjust for size changes
        // in design time - since in run time, m_Form.BorderStyle is bsNone,
        // and when adjusting the size in runtime, we have to count on this

        m_ClientAreaHeightDiff : integer;
        m_ClientAreaWidthDiff : integer;

        procedure NewParentWndProc(var Msg: TMessage);
        procedure ProcessKeyPress(var Msg : TMessage);
        procedure AlignSelf();
        procedure WMCREATE(var Msg : TMessage); message WM_CREATE;
        procedure WMERASEBKGND(var Msg : TMessage); message WM_ERASEBKGND;
        procedure SetButtons(const Value : TsuiTitleBarButtons);
        function GetButtons() : TsuiTitleBarButtons;

        function GetOnBtnClick() : TsuiTitleBarButtonClickEvent;
        procedure SetOnBtnClick(const Value : TsuiTitleBarButtonClickEvent);
        function GetOnHelpBtnClick() : TsuiTitleBarButtonClickEvent;
        procedure SetOnHelpBtnClick(const Value : TsuiTitleBarButtonClickEvent);

        function GetFont() : TFont;
        procedure SetFont(const Value : TFont);
        function GetCaption() : TCaption;
        procedure SetCaption(const Value : TCaption);

        procedure SetMenu(const Value : TMainMenu);
        procedure SetMenuBarColor(const Value : TColor);
        function GetSections: TsuiTitleBarSections;
        procedure SetSections(const Value: TsuiTitleBarSections);
        procedure SetColor(const Value: TColor);
        procedure SetHeight(const Value : Integer);
        function GetHeight() : Integer;
        procedure SetWidth(const Value : Integer);
        function GetWidth() : Integer;
        function GetDrawAppIcon: Boolean;
        procedure SetDrawAppIcon(const Value: Boolean);
        procedure SetMenuBarHeight(const Value: Integer);
        procedure SetTitleBarVisible(const Value: Boolean);
        function GetTitleBarVisible: Boolean;
        function GetMDIChild: Boolean;
        function GetRoundCorner: Integer;
        procedure SetRoundCorner(const Value: Integer);
        procedure SetFileTheme(const Value: TsuiFileTheme);

        procedure DrawButton(Sender: TToolBar; Button: TToolButton; State: TCustomDrawState; var DefaultDraw: Boolean);
        procedure DrawMenuBar(Sender: TToolBar; const ARect: TRect; var DefaultDraw: Boolean);

        procedure OnApplicationMessage(var Msg: TMsg; var Handled: Boolean);
        function GetTitleBarHeight: Integer;
        function GetTitleBarCustom: Boolean;
        procedure SetTitleBarCustom(const Value: Boolean);
        function GetVersion: String;
        procedure SetVersion(const Value: String);

    protected
        procedure SetPanel(const Value : TCustomPanel);
        procedure SetBorderWidth(const Value : Integer);
        procedure SetUIStyle(const Value : TsuiUIStyle);
        procedure Notification(AComponent: TComponent; Operation: TOperation); override;
        procedure PaintFormBorder();
        procedure Paint(); override;

        procedure CreateMenuBar();
        procedure DestroyMenuBar();

    public
        constructor Create(AOwner : TComponent); override;
        destructor Destroy(); override;

        procedure UpdateMenu();
        procedure UpdateTopMenu();
        procedure RepaintMenuBar();
        function GetFormBorderStyle() : TFormBorderStyle;        

        property MDIChild : Boolean read GetMDIChild;
        property TitleBarHeight : Integer read GetTitleBarHeight;

    published
        property TitleBarCustom : Boolean read GetTitleBarCustom write SetTitleBarCustom;
        property FileTheme : TsuiFileTheme read m_FileTheme write SetFileTheme;
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
        property UIStyleAutoUpdateSub : Boolean read m_UIStyleAutoUpdateSub write m_UIStyleAutoUpdateSub;
        property BorderColor : TColor read m_Color write SetColor;
        property BorderWidth : Integer read m_Width write SetBorderWidth;
        property TitleBarVisible : Boolean read GetTitleBarVisible write SetTitleBarVisible default True;
        property BiDiMode;
        property Color;
        property Caption : TCaption read GetCaption write SetCaption;
        property FormPanel : TCustomPanel read m_Panel write SetPanel;
        property TitleBarButtons : TsuiTitleBarButtons read GetButtons write SetButtons;
        property TitleBarSections : TsuiTitleBarSections read GetSections write SetSections;
        property TitleBarDrawAppIcon : Boolean read GetDrawAppIcon write SetDrawAppIcon;
        property Font : TFont read GetFont write SetFont;
        property Menu : TMainMenu read m_Menu write SetMenu;
        property MenuBarColor : TColor read m_MenuBarColor write SetMenuBarColor;
        property MenuBarHeight : Integer read m_MenuBarHeight write SetMenuBarHeight;
        property Height read GetHeight write SetHeight;
        property Width read GetWidth write SetWidth;
        property RoundCorner : Integer read GetRoundCorner write SetRoundCorner;        
        property PopupMenu;
        property Version : String read GetVersion write SetVersion;

        property OnTitleBarCustomBtnsClick : TsuiTitleBarButtonClickEvent read GetOnBtnClick write SetOnBtnClick;
        property OnTitleBarHelpBtnClick : TsuiTitleBarButtonClickEvent read GetOnHelpBtnClick write SetOnHelpBtnClick;
        property OnMouseDown;
        property OnClick;
        property OnMouseUp;

    end;

    TsuiMDIForm = class(TComponent)
    private
        m_Form : TForm;
        m_PrevParentWndProc: Pointer;
        m_PrevClientWndProc: Pointer;
        m_TopPanel : TPanel;
        m_TitleBar : TsuiTitleBar;
        m_MenuBar : TToolBar;
        m_AppOnMsgAssigned : Boolean;
        m_ControlBtns : array [1..3] of TsuiToolBarSpeedButton;
        m_DrawChildCaptions : Boolean;
        m_DrawChildMenus : Boolean;

        m_Menu : TMainMenu;
        m_TopMenu : TMainMenu;
        m_UIStyle : TsuiUIStyle;
        m_FileTheme : TsuiFileTheme;
        m_MenuBarColor : TColor;
        m_BorderColor : TColor;

        m_ChildMaxed : Boolean;

        procedure NewParentWndProc(var Msg: TMessage);
        procedure NewClientWndProc(var Msg : TMessage);
        procedure ProcessKeyPress(var Msg : TMessage);
        procedure OnControlButtonClick(Sender : TObject);
        procedure OnApplicationMessage(var Msg: TMsg; var Handled: Boolean);
        procedure SetMenu(const Value: TMainMenu);
        procedure SetMenuBarColor(const Value : TColor);
        procedure SetUIStyle(const Value : TsuiUIStyle);
        procedure SetFileTheme(const Value: TsuiFileTheme);
        procedure SetBorderColor(const Value: TColor);
        function GetCaption: TCaption;
        procedure SetCaption(const Value: TCaption);

        procedure PaintBorder();
        procedure GetNextTopLeft(var nTop, nLeft : Integer);
        function GetActiveChildSUIForm() : TsuiForm;

        procedure CreateMenuBar();
        procedure DestroyMenuBar();
        procedure ShowMenuBar();
        procedure HideMenuBar();
        procedure ShowControlButtons();
        procedure HideControlButtons();
        function GetMainMenu() : TMainMenu;
        function GetTitleBarCaption(): String;

        procedure SetDrawAppIcon(const Value: Boolean);
        function GetDrawAppIcon: Boolean;
        function GetTitleBarCustom: Boolean;
        procedure SetTitleBarCustom(const Value: Boolean);
        procedure SetTitleBarVisible(const Value: Boolean);
        function GetTitleBarVisible: Boolean;
        function GetSections: TsuiTitleBarSections;
        procedure SetSections(const Value: TsuiTitleBarSections);
        procedure SetButtons(const Value : TsuiTitleBarButtons);
        function GetButtons() : TsuiTitleBarButtons;

    protected
        procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    public
        constructor Create(AOwner : TComponent); override;
        destructor Destroy(); override;

        procedure UpdateMenu();
        procedure Cascade();
        procedure Tile();

        function GetTitleBarHeight: integer;
    published
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
        property FileTheme : TsuiFileTheme read m_FileTheme write SetFileTheme;
        property Menu : TMainMenu read m_Menu write SetMenu;
        property MenuBarColor : TColor read m_MenuBarColor write SetMenuBarColor;
        property BorderColor : TColor read m_BorderColor write SetBorderColor;
        property Caption : TCaption read GetCaption write SetCaption;
        property TitleBarDrawAppIcon : Boolean read GetDrawAppIcon write SetDrawAppIcon default False;
        property TitleBarCustom : Boolean read GetTitleBarCustom write SetTitleBarCustom default False;
        property TitleBarVisible : Boolean read GetTitleBarVisible write SetTitleBarVisible default True;
        property TitleBarButtons : TsuiTitleBarButtons read GetButtons write SetButtons;
        property TitleBarSections : TsuiTitleBarSections read GetSections write SetSections;
        property TitleBarDrawChildCaptions : Boolean read m_DrawChildCaptions write m_DrawChildCaptions default True;
        property TitleBarDrawChildMenus : Boolean read m_DrawChildMenus write m_DrawChildMenus default True;
    end;

//    TsuiScrollBox = class(TWinControl)
//    private
//        // scroll bar
//        m_VScrollBar : TsuiScrollBar;
//        m_HScrollBar : TsuiScrollBar;
//        m_MouseDown : Boolean;
//        m_SelfChanging : Boolean;
//        procedure SetVScrollBar(const Value: TsuiScrollBar);
//        procedure SetHScrollBar(const Value: TsuiScrollBar);
//        procedure OnVScrollBarChange(Sender : TObject);
//        procedure OnHScrollBarChange(Sender : TObject);
//        procedure UpdateScrollBars();
//        procedure UpdateScrollBarsPos();
//
//        procedure CMEnabledChanged(var Msg : TMessage); message CM_ENABLEDCHANGED;
//        procedure WMSIZE(var Msg : TMessage); message WM_SIZE;
//        procedure WMMOVE(var Msg : TMessage); message WM_MOVE;
//        procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
//        procedure WMLBUTTONDOWN(var Message: TMessage); message WM_LBUTTONDOWN;
//        procedure WMLButtonUp(var Message: TMessage); message WM_LBUTTONUP;
//        procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
//        procedure WMMOUSEMOVE(var Message: TMessage); message WM_MOUSEMOVE;
//        procedure WMVSCROLL(var Message: TWMVScroll); message WM_VSCROLL;
//        procedure WMHSCROLL(var Message: TWMHScroll); message WM_HSCROLL;
//
//    protected
//        procedure Notification(AComponent: TComponent; Operation: TOperation); override;
//
//    public
//        constructor Create(AOwner: TComponent); override;
//
//    published
//        // scroll bar
//        property VScrollBar : TsuiScrollBar read m_VScrollBar write SetVScrollBar;
//        property HScrollBar : TsuiScrollBar read m_HScrollBar write SetHScrollBar;
//    
//    end;

    TsuiMSNPopForm = class(TComponent)
    private
        m_Form : TfrmMSNPopForm;
        m_AnimateTime : Integer;
        m_StayTime : Integer;
        m_X : Integer;
        m_Y : Integer;
        m_AutoPosition : Boolean;
        m_ClickHide : Boolean;
        m_Title : TCaption;
        m_Text : String;
        m_TextFont : TFont;
        m_TitleFont : TFont;

        procedure SetTextFont(const Value: TFont);
        procedure SetTitleFont(const Value: TFont);

    public
        constructor Create(AOwner : TComponent); override;
        destructor Destroy(); override;

        procedure Popup();
        procedure Close();

    published
        property AnimateTime : Integer read m_AnimateTime write m_AnimateTime;
        property StayTime : Integer read m_StayTime write m_StayTime;
        property PositionX : Integer read m_X write m_X;
        property PositionY : Integer read m_Y write m_Y;
        property AutoPosition : Boolean read m_AutoPosition write m_AutoPosition;
        property ClickHide : Boolean read m_ClickHide write m_ClickHide;
        property Title : TCaption read m_Title write m_Title;
        property MessageText : String read m_Text write m_Text;

        property TitleFont : TFont read m_TitleFont write SetTitleFont;
        property MessageFont : TFont read m_TextFont write SetTextFont;
    end;


implementation

uses SUIResDef, SUIPublic, SUIImagePanel, SUIMainMenu, SUIMenu, SUIProgressBar;

const
    SUIM_UPDATEMDIMENU  = WM_USER + 3888;
    SUIM_MDICHILDMAX    = WM_USER + 3889;
    SUIM_MDICHILDNOMAX  = WM_USER + 3890;

{ TsuiForm }

procedure TsuiForm.AlignSelf();
var
    nTop : Integer;
begin
    if m_TitleBar.Visible then
        nTop := 0
    else
        nTop := m_Width;
    if m_Form.FormStyle = fsMDIChild then
        SetBounds(m_Width, nTop, m_Form.ClientWidth - (m_Width + 1) * 2 - 1, m_Form.ClientHeight - m_Width - nTop - 3)
    else
        SetBounds(m_Width, nTop, m_Form.ClientWidth - m_Width * 2, m_Form.ClientHeight - m_Width - nTop);
end;

constructor TsuiForm.Create(AOwner: TComponent);
var
{$WARNINGS OFF}
    P : Pointer;
{$WARNINGS ON}
    i : Integer;
begin
    inherited;

    if not (AOwner is TForm) then
        Exit;

    m_Form := AOwner as TForm;

    if not (csDesigning in ComponentState) then
    begin
        m_Form.Constraints.MinHeight := 50;
        m_Form.Constraints.MinWidth := 125;
    end;
    m_Form.BorderWidth := 0;
    m_FormInitRect := Classes.Rect(m_Form.Left, m_Form.Top, m_Form.Width + m_Form.Left, m_Form.Height + m_Form.Top);
    m_FormInitMax := (m_Form.WindowState = wsMaximized);

    m_TitleBar := TsuiTitleBar.Create(self);
    m_TitleBar.Parent := self;

    m_MenuBar := nil;
    m_MenuBarColor := Color;
    m_MenuBarHeight := 22;

    m_BorderStyle := m_Form.BorderStyle;
    UIStyle := SUI_THEME_DEFAULT;
    m_UIStyleAutoUpdateSub := false;

    // AK - calculate the client area difference in next two lines
    m_ClientAreaHeightDiff := m_Form.Height - m_Form.ClientHeight;
    m_ClientAreaWidthDiff := m_Form.Width - m_Form.ClientWidth;

    BevelOuter := bvNone;
    BevelInner := bvNone;
    BorderStyle := bsNone;
    Align := alNone;
    Caption := m_Form.Caption;
    TitleBarVisible := true;
    inherited Caption := ' ';
    m_AppOnMsgAssigned := false;

    for i := 0 to m_Form.ControlCount - 1 do
    begin
        if m_Form.Controls[i] is TsuiForm then
            raise Exception.Create('Sorry, You can create only one TsuiForm component in one form!');
    end;

    m_Form.Scaled := false;

    if not (csDesigning in ComponentState) then
    begin
        if (m_Form.FormStyle <> fsMDIChild) and (m_Form.FormStyle <> fsMDIForm) then
            m_Form.BorderStyle := bsNone;

        m_Form.AutoScroll := false;

        m_PrevParentWndProc := Pointer(GetWindowLong(TForm(Owner).Handle, GWL_WNDPROC));
        P := MakeObjectInstance(NewParentWndProc);
        SetWindowLong(TForm(AOwner).Handle, GWL_WNDPROC, LongInt(P));
        SetWindowLong(m_Form.Handle, GWL_STYLE, GETWINDOWLONG(m_Form.Handle, GWL_STYLE) and (not WS_CAPTION));

        if not Assigned(Application.OnMessage) then
        begin
            m_AppOnMsgAssigned := true;
            Application.OnMessage := OnApplicationMessage;
        end;
    end
//    else
//    begin
//        Height := Height + 27;
//        Width := Width + 6;
//    end;
end;

procedure TsuiForm.CreateMenuBar;
begin
    if m_MenuBar <> nil then
        Exit;
    if m_Form.FormStyle = fsMDIChild then
        Exit;
    m_MenuBar := TToolBar.Create(self);
    m_MenuBar.Parent := self;
    m_MenuBar.Flat := true;
    m_MenuBar.EdgeBorders := [];
    m_MenuBar.ShowCaptions := true;
    m_MenuBar.Height := m_MenuBarHeight;

⌨️ 快捷键说明

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