suiform.pas

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

        m_Form.Menu := nil;
    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
                Rect := GetWorkAreaRect();
                m_Form.WindowState := wsMaximized;
                m_Form.Left := Rect.Left;
                m_Form.Top := Rect.Top;
            end
            else
                Inc(l_InFlag);
        end;
        AlignSelf();
        PaintFormBorder();
        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 > Width - 5) and (Pt.y < 5) then
                Msg.Result := htTopRight
            else if (Pt.X > Width - 5) and (Pt.Y > Height - 5) then
                Msg.Result := htBottomRight
            else if (Pt.X < 5) and (Pt.Y > Height - 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 > Width - 5) then
                Msg.Result := htRight
            else if (Pt.Y > Height - 5) then
                Msg.Result := htBottom;
        end; // with
    end;
end;

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

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

    if (
        (Operation = opRemove) and
        (AComponent = m_Panel)
    )then
        m_Panel := nil;

    if (
        (Operation = opRemove) and
        (AComponent = m_Menu)
    ) then
        DestroyMenuBar();

    if (
        (Operation = opRemove) and
        (AComponent = self)
    )then
    begin
        m_Form.Repaint();

        if m_Menu <> nil then
        begin
            if m_Menu is TsuiMainMenu then
                (m_Menu as TsuiMainMenu).Form := nil;
        end;
    end;
end;

procedure TsuiForm.OnApplicationMessage(var Msg: TMsg;
  var Handled: Boolean);
var
    AMsg : TMessage;
begin
    if Msg.message = WM_KEYDOWN then
    begin
        AMsg.Msg := Msg.message;
        AMsg.WParam := Msg.wParam;
        AMsg.LParam := Msg.lParam;
        ProcessKeyPress(AMsg);
        Handled := Boolean(AMsg.Result);
    end;
end;

procedure TsuiForm.Paint;
var
    Buf : TBitmap;
    Bmp : TBitmap;
begin
    if (m_UIStyle = MacOS) or (m_UIStyle = Protein) then
    begin
        Buf := TBitmap.Create();
        Bmp := TBitmap.Create();
        try
            Buf.Width := Width;
            Buf.Height := Height;
            if m_UIStyle = MacOS then
                Bmp.LoadFromResourceName(hInstance, 'MACOS_FORM_BACKGROUND')
            else
                Bmp.LoadFromResourceName(hInstance, 'PROTEIN_FORM_BACKGROUND');
            Buf.Canvas.Brush.Bitmap := Bmp;
            Buf.Canvas.FillRect(ClientRect);
            BitBlt(Canvas.Handle, 0, 0, Width, Height, Buf.Canvas.Handle, 0, 0, SRCCOPY);
        finally
            Bmp.Free();
            Buf.Free();
        end;
    end
    else
    begin
        Canvas.Brush.Color := Color;
        Canvas.FillRect(ClientRect);
    end;

    if csDesigning in ComponentState then
    begin
        AlignSelf();
        PaintFormBorder();
    end;
end;

procedure TsuiForm.PaintFormBorder();
var
    R : TRect;
begin
    m_Form.Canvas.Pen.Color := m_Color;
    m_Form.Canvas.Pen.Width := m_Width;
    m_Form.Canvas.Pen.Style := psSolid;

    m_Form.Canvas.Brush.Color := m_Color;
    R := Rect(0, 0, m_Width, m_Form.ClientHeight);
    m_Form.Canvas.FillRect(R);
    R := Rect(0, m_Form.ClientHeight - m_Width, m_Form.ClientWidth, m_Form.ClientHeight);
    m_Form.Canvas.FillRect(R);
    R := Rect(m_Form.ClientWidth - m_Width, m_Form.ClientHeight, m_Form.ClientWidth, 0);
    m_Form.Canvas.FillRect(R);
    m_Form.Canvas.Pen.Width := 1;
    m_Form.Canvas.MoveTo(0, 0);
    m_Form.Canvas.LineTo(m_Form.ClientWidth, 0);
end;

procedure TsuiForm.ProcessKeyPress(var Msg: TMessage);
begin
    if not Assigned(Menu) then
        Msg.Result := 0
    else if m_Menu.IsShortCut(TWMKEY(Msg)) then
        Msg.Result := 1
    else
        Msg.Result := 0;
end;

procedure TsuiForm.RepaintMenuBar;
begin
    if (m_MenuBar = nil) or (m_Menu = nil) then
        Exit;
    if m_Menu is TsuiMainMenu then
        if (m_Menu as TsuiMainMenu).UseSystemFont then
            Menu_GetSystemFont(m_MenuBar.Font)
        else
        begin
            m_MenuBar.Font.Name := (m_Menu as TsuiMainMenu).FontName;
            m_MenuBar.Font.Size := (m_Menu as TsuiMainMenu).FontSize;
            m_MenuBar.Font.Charset := (m_Menu as TsuiMainMenu).FontCharset;
        end;
    m_MenuBar.Repaint();
end;

procedure TsuiForm.SetBorderWidth(const Value: Integer);
begin
    m_Width := Value;

    AlignSelf();
    PaintFormBorder();
end;

procedure TsuiForm.SetButtons(const Value: TsuiTitleBarButtons);
begin
    m_TitleBar.Buttons.Assign(Value);
end;

procedure TsuiForm.SetCaption(const Value: TCaption);
begin
    m_TitleBar.Caption := Value;
    m_Form.Caption := Value;
end;

procedure TsuiForm.SetColor(const Value: TColor);
begin
    m_Color := Value;

    AlignSelf();
    PaintFormBorder();
end;

procedure TsuiForm.SetDrawAppIcon(const Value: Boolean);
begin
    m_TitleBar.DrawAppIcon := Value;
end;

procedure TsuiForm.SetFont(const Value: TFont);
begin
    m_TitleBar.Font := Value;
end;

procedure TsuiForm.SetHeight(const Value: Integer);
begin
    m_Form.Height := Value + m_Width + 27;
    AlignSelf();
end;

procedure TsuiForm.SetMenu(const Value: TMainMenu);
begin
    if m_Menu <> nil then
    begin
        if m_Menu is TsuiMainMenu then
            (m_Menu as TsuiMainMenu).Form := nil;
    end;

    m_Menu := Value;

    if m_Menu is TsuiMainMenu then
        (m_Menu as TsuiMainMenu).Form := self;

    if m_Menu <> nil then
    begin
        if m_MenuBar = nil then
            CreateMenuBar();
        UpdateMenu();
    end
    else
        DestroyMenuBar();
end;

procedure TsuiForm.SetMenuBarColor(const Value: TColor);
begin
    m_MenuBarColor := Value;

    if m_MenuBar <> nil then
        m_MenuBar.Color := Value;
end;

procedure TsuiForm.SetMenuBarHeight(const Value: Integer);
var
    i : Integer;
begin
    m_MenuBarHeight := Value;

    if m_MenuBar <> nil then
    begin
        m_MenuBar.Height := m_MenuBarHeight;
        for i := 0 to m_MenuBar.ButtonCount - 1 do
            m_MenuBar.Buttons[i].Height := m_MenuBarHeight;
    end;
end;

procedure TsuiForm.SetOnBtnClick(
  const Value: TsuiTitleBarButtonClickEvent);
begin
    m_TitleBar.OnCustomBtnsClick := Value;
end;

procedure TsuiForm.SetOnHelpBtnClick(
  const Value: TsuiTitleBarButtonClickEvent);
begin
    m_TitleBar.OnHelpBtnClick := Value;
end;

procedure TsuiForm.SetPanel(const Value: TCustomPanel);
begin
    if Value = self then
    begin
        MessageDlg('Sorry, you can''t select the Form assign to FormPanel property', mtError, [mbOK], 0);	 
        Exit;
    end;

    m_Panel := Value;

    if m_Panel = nil then
        Exit;

    m_Panel.Align := alClient;

    if m_Panel is TPanel then
    begin
        TPanel(m_Panel).BevelOuter := bvNone;
        TPanel(m_Panel).BevelInner := bvNone;
        TPanel(m_Panel).BorderStyle := bsNone;
        TPanel(m_Panel).Caption := '';
    end
    else if m_Panel is TsuiImagePanel then
        TsuiImagePanel(m_Panel).Caption := '';
end;

procedure TsuiForm.SetSections(const Value: TsuiTitleBarSections);
begin
    m_TitleBar.Sections.Assign(Value);
end;

procedure TsuiForm.SetUIStyle(const Value: TsuiUIStyle);
begin
    m_UIStyle := Value;

    if m_UIStyle = Custom then
        Exit;

    BorderColor := GetThemeColor(m_UIStyle, SUI_FORM_BORDER_COLOR);
    BorderWidth := GetThemeInt(m_UIStyle, SUI_FORM_BORDER_WIDTH);
    Color := GetThemeColor(m_UIStyle, SUI_FORM_BACKGROUND_COLOR);
    MenuBarColor := Color;

    m_TitleBar.UIStyle := m_UIStyle;

    if m_Menu <> nil then
    begin
        if m_Menu is TsuiMainMenu then
            if (m_Menu as TsuiMainMenu).UIStyle <> Custom then
                (m_Menu as TsuiMainMenu).UIStyle := m_UIStyle;
    end;

    SubContainerApplyUIStyle(self, m_UIStyle);
    ContainerApplyUIStyle(self, m_UIStyle);

    AlignSelf();
    Repaint();
    PaintFormBorder();
end;

procedure TsuiForm.SetWidth(const Value: Integer);
begin
    m_Form.Width := Value + m_Width * 2 + 8;
    AlignSelf();
end;

procedure TsuiForm.UpdateMenu;
var
    i : Integer;
    Button : TToolButton;
begin
    if m_MenuBar = nil then
        Exit;

    if m_Menu = nil then
    begin
        DestroyMenuBar();
        Exit;
    end;

    for i := 0 to m_MenuBar.ButtonCount - 1 do
        m_MenuBar.Buttons[0].Free();

    for i := m_Menu.Items.Count - 1 downto 0 do
    begin
        if m_Menu.Items[i].Parent <> m_Menu.Items then
            continue;
        Button := TToolButton.Create(self);
        Button.Parent := m_MenuBar;
        Button.Grouped := true;
        Button.MenuItem := m_Menu.Items[i];
        Button.AutoSize := true;
    end;
end;

procedure TsuiForm.UpdateTopMenu;
var
    i : Integer;
begin
    if m_MenuBar = nil then
        Exit;
    for i := 0 to m_MenuBar.ButtonCount - 1 do
    begin
        if m_MenuBar.Buttons[i].MenuItem <> nil then
            m_MenuBar.Buttons[i].Caption := m_MenuBar.Buttons[i].MenuItem.Caption;
    end;
end;

procedure TsuiForm.WMCREATE(var Msg: TMessage);
begin
    AlignSelf();
    PaintFormBorder();
end;

procedure TsuiForm.WMERASEBKGND(var Msg: TMessage);
begin
    PaintFormBorder();
end;

end.