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