suiform.pas

来自「新颖按钮控件」· PAS 代码 · 共 889 行 · 第 1/2 页

////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUIForm.pas
//  Creator     :   Shen Min
//  Date        :   2002-05-21
//  Comment     :
//
//  Copyright (c) 2002-2003 Sunisoft
//  http://www.sunisoft.com
//  Email: [e-mail]
//
////////////////////////////////////////////////////////////////////////////////

unit SUIForm;

interface

uses Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Graphics, Forms,
     ComCtrls, Menus, Dialogs,
     SUITitleBar, SUIThemes;

type
    TsuiForm = class(TCustomPanel)
    private
        m_TitleBar : TsuiTitleBar;
        m_MenuBar : TToolBar;
        m_Menu : TMainMenu;
{$WARNINGS OFF}
        m_PrevParentWndProc: Pointer;
{$WARNINGS ON}
        m_Form : TForm;
        m_BorderStyle : TFormBorderStyle;
        m_Color : TColor;
        m_Panel : TCustomPanel;
        m_Width : Integer;
        m_UIStyle : TsuiUIStyle;
        m_MenuBarColor : TColor;
        m_MenuBarHeight : Integer;
        m_AppOnMsgAssigned : Boolean;

        m_FormInitRect : TRect;
        m_FormInitMax : Boolean;

        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 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);

    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();

    published
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
        property BorderColor : TColor read m_Color write SetColor;
        property BorderWidth : Integer read m_Width write SetBorderWidth;
        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 PopupMenu;

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

    end;


implementation

uses SUIResDef, SUIProgressBar, SUIImagePanel, SUIButton, SUIListBox, SUIGroupBox,
     SUIMemo, SUIEdit, SUISideChannel, SUIMainMenu, SUIPublic, SUIMenu;


{ TsuiForm }

procedure TsuiForm.AlignSelf();
begin
    SetBounds(m_Width, 0, m_Form.ClientWidth - m_Width * 2, m_Form.ClientHeight - m_Width);
end;

constructor TsuiForm.Create(AOwner: TComponent);
var
{$WARNINGS OFF}
    P : Pointer;
{$WARNINGS ON}
    i : Integer;
    Rect : TRect;
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_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;

    BevelOuter := bvNone;
    BevelInner := bvNone;
    BorderStyle := bsNone;
    Align := alNone;
    Caption := m_Form.Caption;
    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;

    Rect := GetWorkAreaRect();
    if not (csDesigning in ComponentState) then
    begin
        m_Form.Constraints.MaxHeight := Rect.Bottom - Rect.Top;
        m_Form.Constraints.MaxWidth := Rect.Right - Rect.Left;
    end;

    if not (csDesigning in ComponentState) then
    begin
        m_Form.BorderStyle := bsNone;
{$WARNINGS OFF}
        m_PrevParentWndProc := Pointer(GetWindowLong(TForm(Owner).Handle, GWL_WNDPROC));
        P := MakeObjectInstance(NewParentWndProc);
        SetWindowLong(TForm(AOwner).Handle, GWL_WNDPROC, LongInt(P));
{$WARNINGS ON}

        if not Assigned(Application.OnMessage) then
        begin
            m_AppOnMsgAssigned := true;
            Application.OnMessage := OnApplicationMessage;
        end;
    end;
end;

procedure TsuiForm.CreateMenuBar;
begin
    if m_MenuBar <> nil 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;
    m_MenuBar.Color := m_MenuBarColor;
    if not (csDesigning in ComponentState) then
        m_MenuBar.OnCustomDrawButton := DrawButton;
    m_MenuBar.OnCustomDraw := DrawMenuBar;
    m_TitleBar.Top := 0;
end;

destructor TsuiForm.Destroy;
begin
    if m_AppOnMsgAssigned then
        Application.OnMessage := nil;

    m_MenuBar.Free();
    m_MenuBar := nil;

    m_TitleBar.Free();
    m_TitleBar := nil;

    inherited;
end;

procedure TsuiForm.DestroyMenuBar;
begin
    m_MenuBar.Free();
    m_MenuBar := nil;

    m_Menu := nil;
end;

procedure TsuiForm.DrawButton(Sender: TToolBar; Button: TToolButton;
  State: TCustomDrawState; var DefaultDraw: Boolean);
var
    ACanvas : TCanvas;
    ARect : TRect;
    R : TRect;
    Bmp : TBitmap;
    Buf : TBitmap;
    Style : TsuiUIStyle;
    CanSetFont : Boolean;
begin
    Style := m_UIStyle;
    CanSetFont := false;

    ACanvas := Sender.Canvas;
    ARect := Button.BoundsRect;

    if Menu <> nil then
    begin
        if Menu is TsuiMainMenu then
        begin
            Style := (Menu as TsuiMainMenu).UIStyle;
            if (m_Menu as TsuiMainMenu).UseSystemFont then
                Menu_GetSystemFont(ACanvas.Font)
            else
            begin
                ACanvas.Font.Name := (m_Menu as TsuiMainMenu).FontName;
                ACanvas.Font.Size := (m_Menu as TsuiMainMenu).FontSize;
                ACanvas.Font.Charset := (m_Menu as TsuiMainMenu).FontCharset;
                ACanvas.Font.Color := (m_Menu as TsuiMainMenu).FontColor;
                CanSetFont := true;
            end;
        end;
    end;

    // MacOS
    if (
        ((cdsHot in State) or (cdsSelected in State)) and
        (Style = MacOS)
    ) then
    begin
        DefaultDraw := false;

        Buf := TBitmap.Create();
        Bmp := TBitmap.Create();
        Buf.Width := Button.Width;
        Buf.Height := Button.Height;

        R := Rect(0, 0, Buf.Width, Buf.Height);
        Bmp.LoadFromResourceName(hInstance, 'MACOS_MENU_SELECT');
        Buf.Canvas.StretchDraw(R, Bmp);

        Buf.Canvas.Brush.Style := bsClear;
        if CanSetFont then
        begin
            Buf.Canvas.Font.Name := (m_Menu as TsuiMainMenu).FontName;
            Buf.Canvas.Font.Size := (m_Menu as TsuiMainMenu).FontSize;
            Buf.Canvas.Font.Charset := (m_Menu as TsuiMainMenu).FontCharset;
        end;
        Buf.Canvas.Font.Color := GetThemeColor(Style, SUI_MENU_SELECTED_FONT_COLOR);
{$WARNINGS OFF}
        DrawText(Buf.Canvas.Handle, PChar(Button.Caption), -1, R, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
{$WARNINGS ON}
        ACanvas.Draw(ARect.Left, ARect.Top, Buf);

        Bmp.Free();
        Buf.Free();
    end

    else if (
        (cdsHot in State) or
        (cdsSelected in State)
    ) then
    begin // selected or hot top menu
        DefaultDraw := false;

        // draw client background
        if cdsSelected in State then
            ARect.Right := ARect.Right - 2;
        ACanvas.Brush.Color := GetThemeColor(Style, SUI_MENU_SELECTED_BACKGROUND_COLOR);
        ACanvas.FillRect(ARect);

        // draw border
        ACanvas.Brush.Color := GetThemeColor(Style, SUI_MENU_SELECTED_BORDER_COLOR);
        ACanvas.FrameRect(ARect);

        // draw text
        if cdsSelected in State then
            ARect.Left := ARect.Left + 2;
        ARect.Top := ARect.Top + 2;
        ACanvas.Font.Color := GetThemeColor(Style, SUI_MENU_SELECTED_FONT_COLOR);
        ACanvas.Brush.Style := bsClear;
{$WARNINGS OFF}
        DrawText(ACanvas.Handle, PChar(Button.Caption), -1, ARect, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
{$WARNINGS ON}
        // draw shadow (only selected, no hot)
        if (cdsSelected in State) then
        begin
            ACanvas.Pen.Color := GetThemeColor(Style, SUI_MENU_SHADOW_COLOR);
            ACanvas.Rectangle(ARect.Right, ARect.Top, ARect.Right + 2, ARect.Bottom);
        end;
    end

    // not select and not hot top menu
    else
        DefaultDraw := true;
end;

procedure TsuiForm.DrawMenuBar(Sender: TToolBar; const ARect: TRect;
  var DefaultDraw: Boolean);
var
    ACanvas : TCanvas;
    Buf : TBitmap;
    Style : TsuiUIStyle;
begin
    Style := m_UIStyle;
    if Menu <> nil then
    begin
        if Menu is TsuiMainMenu then
            Style := (Menu as TsuiMainMenu).UIStyle;
    end;

    if (Style = MacOS) then
    begin
        ACanvas := Sender.Canvas;
        Buf := TBitmap.Create();
        Buf.LoadFromResourceName(hInstance, 'MACOS_MENU_BAR');
        ACanvas.StretchDraw(ARect, Buf);
        Buf.Free();
    end;
end;

function TsuiForm.GetButtons: TsuiTitleBarButtons;
begin
    Result := m_TitleBar.Buttons;
end;

function TsuiForm.GetCaption: TCaption;
begin
    Result := m_TitleBar.Caption;
end;

function TsuiForm.GetDrawAppIcon: Boolean;
begin
    Result := m_TitleBar.DrawAppIcon;
end;

function TsuiForm.GetFont: TFont;
begin
    Result := m_TitleBar.Font;
end;

function TsuiForm.GetHeight: Integer;
begin
    Result := inherited Height;
end;

function TsuiForm.GetOnBtnClick: TsuiTitleBarButtonClickEvent;
begin
    Result := m_TitleBar.OnCustomBtnsClick;
end;

function TsuiForm.GetOnHelpBtnClick: TsuiTitleBarButtonClickEvent;
begin
    Result := m_TitleBar.OnHelpBtnClick;
end;

function TsuiForm.GetSections: TsuiTitleBarSections;
begin
    Result := m_TitleBar.Sections;
end;

function TsuiForm.GetWidth: Integer;
begin
    Result := inherited Width;
end;

var
    l_InFlag : Integer = 0;

procedure TsuiForm.NewParentWndProc(var Msg: TMessage);
var
    Pt : TPoint;
    Rect : TRect;
begin
{$WARNINGS OFF}
    Msg.Result := CallWindowProc(m_PrevParentWndProc, TForm(Owner).Handle, Msg.Msg, Msg.WParam, Msg.LParam);

    if Msg.Msg = WM_KEYDOWN then
        ProcessKeyPress(Msg);
{$WARNINGS ON}

    if Msg.Msg = WM_SHOWWINDOW then
    begin