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