suiform.pas

Delphi界面控件修饰

    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
    if m_Form.FormStyle <> fsMDIChild then
    begin
        m_MenuBar.Free();
        m_MenuBar := nil;
    end;
    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;
    OutUIStyle : TsuiUIStyle;
    CanSetFont : Boolean;
    AFileTheme : TsuiFileTheme;
    bUseFileTheme : Boolean;
begin
    Style := m_UIStyle;
    AFileTheme := m_FileTheme;
    CanSetFont := false;

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

    if Menu <> nil then
    begin
        if Menu is TsuiMainMenu then
        begin
            Style := (Menu as TsuiMainMenu).UIStyle;
            AFileTheme := (Menu as TsuiMainMenu).FileTheme;
            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
        {$IFDEF RES_MACOS} (Style = MacOS) {$ELSE} false {$ENDIF}
    ) 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
        else
        begin
            Buf.Canvas.Font.Name := ACanvas.Font.Name;
            Buf.Canvas.Font.Size := ACanvas.Font.Size;
            Buf.Canvas.Font.Charset := ACanvas.Font.Charset;
        end;

        if UsingFileTheme(AFileTheme, Style, OutUIStyle) then
            Buf.Canvas.Font.Color := AFileTheme.GetColor(SUI_THEME_MENU_SELECTED_FONT_COLOR)
        else
            Buf.Canvas.Font.Color := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_SELECTED_FONT_COLOR);
            
        R.Bottom := R.Bottom + 2;
        DrawText(Buf.Canvas.Handle, PChar(Button.Caption), -1, R, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
        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;
        if UsingFileTheme(AFileTheme, Style, OutUIStyle) then
        begin
            ACanvas.Brush.Color := AFileTheme.GetColor(SUI_THEME_MENU_SELECTED_BACKGROUND_COLOR);
            bUseFileTheme := true
        end
        else
        begin
            ACanvas.Brush.Color := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_SELECTED_BACKGROUND_COLOR);
            bUseFileTheme := false            
        end;
        ACanvas.FillRect(ARect);

        // draw border
        if bUseFileTheme then
            ACanvas.Brush.Color := AFileTheme.GetColor(SUI_THEME_MENU_SELECTED_BORDER_COLOR)
        else
            ACanvas.Brush.Color := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_SELECTED_BORDER_COLOR);
        ACanvas.FrameRect(ARect);

        // draw text
        if cdsSelected in State then
            ARect.Left := ARect.Left + 2;
        ARect.Top := ARect.Top + 2;

        if bUseFileTheme then
            ACanvas.Font.Color := AFileTheme.GetColor(SUI_THEME_MENU_SELECTED_FONT_COLOR)
        else
            ACanvas.Font.Color := GetInsideThemeColor(OutUIStyle, SUI_THEME_MENU_SELECTED_FONT_COLOR);

        DrawText(ACanvas.Handle, PChar(Button.Caption), -1, ARect, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
        
//        // 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;

{$IFDEF RES_MACOS}
    if (Style = MacOS) then
    begin
        ACanvas := Sender.Canvas;
        Buf := TBitmap.Create();
        Buf.LoadFromResourceName(hInstance, 'MACOS_MENU_BAR');
        ACanvas.StretchDraw(ARect, Buf);
        Buf.Free();
    end;
{$ENDIF}
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.GetFormBorderStyle: TFormBorderStyle;
begin
    Result := m_BorderStyle;
end;

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

function TsuiForm.GetMDIChild: Boolean;
begin
    Result := (m_Form.FormStyle = fsMDIChild);
end;

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

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

function TsuiForm.GetRoundCorner: Integer;
begin
    Result := m_TitleBar.RoundCorner;
end;

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

function TsuiForm.GetTitleBarCustom: Boolean;
begin
    Result := m_TitleBar.Custom;
end;

function TsuiForm.GetTitleBarHeight: Integer;
begin
    Result := m_TitleBar.Height;
end;

function TsuiForm.GetTitleBarVisible: Boolean;
begin
    Result := m_TitleBar.Visible;
end;

function TsuiForm.GetVersion: String;
begin
    Result := '4.20';
end;

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

var
    l_InFlag : Integer = 0;
    l_MaxFlag : Boolean = false;

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

    if Msg.Msg = WM_MDIACTIVATE then
    begin
        if TWMMDIActivate(Msg).ActiveWnd = m_Form.Handle then
        begin
            SendMessage(Application.MainForm.ClientHandle, SUIM_UPDATEMDIMENU, 0, 0);
            m_TitleBar.FormActive := true;
        end
        else
            m_TitleBar.FormActive := false
    end;

    if Msg.Msg = WM_KEYDOWN then
        ProcessKeyPress(Msg);

    if Msg.Msg = WM_SHOWWINDOW then
    begin
        m_Form.Menu := nil;
    end;

    if Msg.Msg = WM_DESTROY then
    begin
        if m_Form.FormStyle = fsMDIChild then
        begin
            SendMessage(Application.MainForm.ClientHandle, SUIM_UPDATEMDIMENU, 0, 0);
            if m_Form.WindowState = wsMaximized then
                SendMessage(Application.MainForm.ClientHandle, SUIM_MDICHILDNOMAX, 0, 0);
        end;
    end;

   if Msg.Msg = WM_ACTIVATE then
    begin
        if Msg.WParamLo = WA_INACTIVE then
            m_TitleBar.FormActive := false
        else
            m_TitleBar.FormActive := true;
    end;

    if Msg.Msg = WM_SIZE then
    begin
        if m_FormInitMax then
        begin
            if m_Form.WindowState <> wsMaximized then
            begin
                PlaceControl(m_Form, m_FormInitRect);
                m_FormInitMax := false;
            end
            else if l_InFlag = 2 then
            begin
                m_Form.WindowState := wsMaximized;
            end
            else
                Inc(l_InFlag);
            l_MaxFlag := true;
        end;
        if (m_Form.WindowState = wsMaximized) and (m_Form.FormStyle <> fsMDIChild) then
        begin
            if m_BorderStyle <> bsNone then
            begin
                Rect := GetWorkAreaRect();
                PlaceControl(m_Form, Rect);
            end;
        end;
        AlignSelf();
        PaintFormBorder();
        m_TitleBar.ProcessMaxBtn();
        if m_Form.FormStyle = fsMDIChild then
        begin
            if m_Form.WindowState = wsMaximized then
            begin
                TitleBarVisible := false;
                if not l_MaxFlag then
                begin
                    Self.ScrollBy(0, m_TitleBar.Height * -1);
                    l_MaxFlag := true;
                    SendMessage(Application.MainForm.ClientHandle, SUIM_MDICHILDMAX, m_Form.Handle, 0);
                end;
            end
            else
            begin
                TitleBarVisible := true;
                if l_MaxFlag then
                begin
                    Self.ScrollBy(0, m_TitleBar.Height);
                    l_MaxFlag := false;
                    m_TitleBar.ProcessMaxBtn();
                    SendMessage(Application.MainForm.ClientHandle, SUIM_MDICHILDNOMAX, 0, 0);                    
                end;
            end;
        end;
        m_TitleBar.OnFormReSize();
    end;

    if Msg.Msg = WM_ERASEBKGND then
        PaintFormBorder();

    if Msg.Msg = WM_NCHITTEST then
    begin
        if m_Form.WindowState = wsMaximized then
            Exit;

        if m_Form.FormStyle = fsMDIForm then
        begin
            if Msg.Result = HTCLIENT then
                Msg.Result := HTTRANSPARENT;
        end;

        with m_Form do
        begin
            if m_BorderStyle <> bsSizeable then
                Exit;
            Pt := Point(Msg.LParamLo, Msg.LParamHi);
            Pt := ScreenToClient(Pt);
            if (Pt.X < 5) and (Pt.Y < 5) then
                Msg.Result := htTopLeft
            else if (Pt.X > ClientWidth - 5) and (Pt.y < 5) then
                Msg.Result := htTopRight
            else if (Pt.X > ClientWidth - 5) and (Pt.Y > ClientHeight - 5) then
                Msg.Result := htBottomRight
            else if (Pt.X < 5) and (Pt.Y > ClientHeight - 5) then
                Msg.Result := htBottomLeft
            else if (Pt.X < 5) then
                Msg.Result := htLeft
            else if (Pt.Y < 5) then
                Msg.Result := htTop
            else if (Pt.X > ClientWidth - 5) then
                Msg.Result := htRight
            else if (Pt.Y > ClientHeight - 5) then
                Msg.Result := htBottom;
        end; // with
    end;
end;

procedure TsuiForm.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
    inherited;

    if AComponent = nil then
        Exit;

    if (
        (Operation = opInsert) and
        (csDesigning in ComponentState) and
        (not (csLoading in ComponentState)) and
        (AComponent.ClassName <> 'TsuiMainMenu') and
        (AComponent is TMainMenu)
    ) then
    begin
        MessageDlg(
            'Strongly recommend you to use "TsuiMainMenu" instead of "TMainMenu".'
                + SUI_2ENTER +  'If you still want to use TMainForm, '
                + SUI_2ENTER + 'set ' + m_Form.Name + '''s MENU property to NIL please.'
                + SUI_2ENTER + 'And set ' + Name + '''s MENU property to this Menu when you finished designing the menu.',
            mtInformation,
            [mbOK],
            0