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

📄 suiform.pas

📁 一套还不错的DELPHI皮肤控件!
💻 PAS
📖 第 1 页 / 共 5 页
字号:
        (AComponent = m_FileTheme)
    )then
    begin
        m_FileTheme := nil;
        ContainerApplyUIStyle(self, SUI_THEME_DEFAULT, nil);
        SetUIStyle(SUI_THEME_DEFAULT);
    end;
end;

procedure TsuiForm.OnApplicationMessage(var Msg: TMsg;
  var Handled: Boolean);
var
    AMsg : TMessage;
begin
    if Msg.message = 262 then
        if LOWORD(Msg.wParam) = 32 then
        begin
            m_TitleBar.DefPopupMenu.Popup(Application.MainForm.Left, Application.MainForm.Top + m_TitleBar.Height);
            Handled := true;
        end;

    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_Destroyed then
        Exit;
    if {$IFDEF RES_MACOS} (m_UIStyle = MacOS) {$ELSE} false {$ENDIF} or
        {$IFDEF RES_PROTEIN} (m_UIStyle = Protein) {$ELSE} false {$ENDIF} then
    begin
        Buf := TBitmap.Create();
        Bmp := TBitmap.Create();
        try
            Buf.Width := Width;
            Buf.Height := Height;
{$IFDEF RES_MACOS}
            if m_UIStyle = MacOS then
                Bmp.LoadFromResourceName(hInstance, 'MACOS_FORM_BACKGROUND')
            else
{$ENDIF}            
                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;

    PaintFormBorder();
end;

procedure TsuiForm.PaintFormBorder();
var
    R : TRect;
    ACanvas : TCanvas;
    Bmp : TBitmap;
    nLeft, nRight : Integer;
    Tmp : TBitmap;    
begin
    if m_Destroyed then
        Exit;

    if (m_Form = nil) or (not m_Form.HandleAllocated) then
    begin
        inherited;
        Exit;
    end;
    if (m_Form.WindowState = wsMinimized) and (not (csDesigning in ComponentState)) then
        Exit;

    ACanvas := TCanvas.Create();
    ACanvas.Handle := GetWindowDC(m_Form.Handle);

    ACanvas.Brush.Color := m_Color;
    R := Rect(0, 0, m_Width, m_Form.Height);
    ACanvas.FillRect(R);
    R := Rect(0, m_Form.Height - m_Width, m_Form.Width, m_Form.Height);
    ACanvas.FillRect(R);
    R := Rect(m_Form.Width - m_Width, m_Form.Height, m_Form.Width, 0);
    ACanvas.FillRect(R);

    if m_Width < 4 then
    begin
        ACanvas.Brush.Color := Color;
        R := Rect(m_Width, TitleBarHeight, 3, m_Form.Height - m_Width);
        ACanvas.FillRect(R);
        R := Rect(m_Width, m_Form.Height - 3, m_Form.Width - m_Width, m_Form.Height - m_Width);
        ACanvas.FillRect(R);
        R := Rect(m_Form.Width - 3, m_Form.Height - m_Width, m_Form.Width - m_Width, TitleBarHeight);
        ACanvas.FillRect(R);

        if (m_MenuBar <> nil) and (m_MenuBar.Visible) then
        begin
            ACanvas.Brush.Color := m_MenuBar.Color;
            R := Rect(m_Width, 3 + m_TitleBar.Height, 3, 3 + m_TitleBar.Height + m_MenuBar.Height);
            ACanvas.FillRect(R);
            R := Rect(m_Form.Width - 3, 3 + m_TitleBar.Height, m_Form.Width - m_Width, 3 + m_TitleBar.Height + m_MenuBar.Height);
            ACanvas.FillRect(R);
        end;
    end;

    if TitleBarVisible and m_TitleBar.CanPaint() and (m_Width < 4) then
    begin
        Tmp := TBitmap.Create();

        m_TitleBar.GetLeftImage(Bmp);
        Tmp.Width := 3 - m_Width;
        Tmp.Height := Bmp.Height;
        Tmp.Canvas.Draw(0, 0, Bmp);
        ACanvas.Draw(m_Width, 0, Tmp);

        m_TitleBar.GetRightImage(Bmp);
        if Bmp.Width < 3 then
            Tmp.Canvas.StretchDraw(Rect(0, 0, Tmp.Width, Tmp.Height), Bmp)
        else
            Tmp.Canvas.Draw(2 - Bmp.Width, 0, Bmp);
        ACanvas.Draw(m_Form.Width - 3, 0, Tmp);

        Tmp.Width := m_Form.Width - 5;
        Tmp.Height := 3;
        m_TitleBar.GetLeftImage(Bmp);
        Tmp.Canvas.Draw(-2, 0, Bmp);
        nLeft := Bmp.Width - 2;
        m_TitleBar.GetRightImage(Bmp);
        nRight := Tmp.Width - Bmp.Width + 3;
        Tmp.Canvas.Draw(nRight, 0, Bmp);
        m_TitleBar.GetCenterImage(Bmp);
        Tmp.Canvas.StretchDraw(Rect(nLeft, 0, nRight, Bmp.Height), Bmp);
        ACanvas.Draw(2, 0, Tmp);

        if (m_Width = 1) and (RoundCorner = 11) and not (csDesigning in ComponentState) then
        begin
            ACanvas.Pen.Color := m_Color;
            ACanvas.Arc(m_Form.Width - RoundCorner * 2 + 1, -1, m_Form.Width + 1, RoundCorner * 2 - 1, m_Form.Width + 1, RoundCorner - 1, m_Form.Width - RoundCorner + 1, -1);
            ACanvas.Arc(-1, -1, RoundCorner * 2 - 1, RoundCorner * 2 - 1, RoundCorner - 1, -1, - 1, RoundCorner - 1);
        end;

        Tmp.Free();
    end
    else if not TitleBarVisible then
    begin
        ACanvas.Brush.Color := m_Color;
        R := Rect(0, 0, m_Form.Width, 1);
        ACanvas.FillRect(R);
        ACanvas.Brush.Color := Color;
        R := Rect(m_Width, 1, m_Form.Width - m_Width, 3);
        ACanvas.FillRect(R);
    end;

    ReleaseDC(m_Form.Handle, ACanvas.Handle);
    ACanvas.Free();
end;

procedure TsuiForm.ProcessKeyPress(var Msg: TMessage);
begin
    if m_Destroyed then
        Exit;
    if (not FormHasFocus(m_Form)) or (not m_Form.Active) then
        Msg.Result := 0
    else 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.ReAssign;
var
    P : Pointer;
begin
    m_PrevParentWndProc := Pointer(GetWindowLong(m_Form.Handle, GWL_WNDPROC));
    P := MakeObjectInstance(NewParentWndProc);
    SetWindowLong(m_Form.Handle, GWL_WNDPROC, LongInt(P));
    SetWindowLong(m_Form.Handle, GWL_STYLE, GetWindowLong(m_Form.Handle, GWL_STYLE) and (not WS_CAPTION));
end;

procedure TsuiForm.RegionWindow;
var
    R : TRect;
    Rgn : HRGN;
    C : Integer;
    TempRgn : HRGN;
begin
    if csDesigning in ComponentState then
        Exit;

    R := Rect(0, 0, m_Form.Width, m_Form.Height);
    C := RoundCorner;
    Rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right + 1, R.Bottom + 1, C, C);

    TempRgn := CreateRectRgn(
        R.Left,
        R.Bottom,
        R.Left + C * 2,
        R.Bottom - C * 2
    );
    CombineRgn(Rgn, Rgn, TempRgn, RGN_OR);
    DeleteObject(TempRgn);

    TempRgn := CreateRectRgn(
        R.Right,
        R.Bottom,
        R.Right - C * 2,
        R.Bottom - C * 2
    );
    CombineRgn(Rgn, Rgn, TempRgn, RGN_OR);
    DeleteObject(TempRgn);

    if not (csDesigning in m_Form.ComponentState) then
        SetWindowRgn(m_Form.Handle, Rgn, true);

    DeleteObject(Rgn);
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.Resize;
begin
    inherited;

    m_TitleBar.Align := alTop;
end;

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

    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;

    PaintFormBorder();
end;

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

procedure TsuiForm.SetFileTheme(const Value: TsuiFileTheme);
begin
    if m_FileTheme = Value then
        Exit;
    m_FileTheme := Value;
    SetUIStyle(m_UIStyle);
end;

procedure TsuiForm.SetFont(const Value: TFont);
begin
    m_TitleBar.Font := Value;
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.SetRoundCorner(const Value: Integer);
begin
    m_TitleBar.RoundCorner := Value;
    RegionWindow();
end;

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

procedure TsuiForm.SetTitleBarCustom(const Value: Boolean);
begin
    m_TitleBar.Custom := Value;
end;

procedure TsuiForm.SetTitleBarVisible(const Value: Boolean);
begin
    if m_TitleBar.Visible = Value then
        Exit;
    m_TitleBar.Visible := Value;
    m_TitleBar.Top := 0;
    PaintFormBorder();
end;

procedure TsuiForm.SetUIStyle(const Value: TsuiUIStyle);
var
    OutUIStyle : TsuiUIStyle;
    Rect: TRect;
    Col : TColor;
begin
    Rect := m_Form.BoundsRect;

    m_UIStyle := Value;

    if UsingFileTheme(m_FileTheme, m_UIStyle, OutUIStyle) then
    begin
        BorderColor := m_FileTheme.GetColor(SUI_THEME_FORM_BORDER_COLOR);
        BorderWidth := m_FileTheme.GetInt(SUI_THEME_FORM_BORDERWIDTH_INT);
        Color := m_FileTheme.GetColor(SUI_THEME_FORM_BACKGROUND_COLOR);
        if m_MenuBar <> nil then
        begin
            Col := m_FileTheme.GetColor(SUI_THEME_CONTROL_FONT_COLOR);
            if Col = 131072 then
                m_MenuBar.Color := $00AC5B3B
            else if Col = 196608 then
                m_MenuBar.Color := $00996733
            else
                MenuBarColor := Color;
        end;
        RoundCorner := m_FileTheme.GetInt(SUI_THEME_FORM_ROUNDCORNER_INT);
    end
    else
    begin
        BorderColor := GetInsideThemeColor(OutUIStyle, SUI_THEME_FORM_BORDER_COLOR);
        BorderWidth := GetInsideThemeInt(OutUIStyle, SUI_THEME_FORM_BORDERWIDTH_INT);

⌨️ 快捷键说明

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