秋·风

  博客园 :: 首页 :: 博问 :: 闪存 :: 新随笔 :: 联系 :: 订阅 订阅 :: 管理 ::
Lazarus 使用QT5的深色style完整代码
Lazarus 使用QT5的深色style完整代码，QT5研究暂告一段落。
unit Unit1;

{$mode objfpc}{$H+}
{$macro on}
interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls,
  FileUtil, DateTimePicker, ExtCtrls, Buttons, DBGrids, Grids
  {$ifdef lclqt5},
  qtobjects, qt5{$endif};

type

  { TForm1 }

  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    CheckBox1: TCheckBox;
    CheckGroup1: TCheckGroup;
    ComboBox1: TComboBox;
    DateTimePicker1: TDateTimePicker;
    DateTimePicker2: TDateTimePicker;
    DBGrid1: TDBGrid;
    Edit1: TEdit;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
    ProgressBar1: TProgressBar;
    RadioButton1: TRadioButton;
    SpeedButton1: TSpeedButton;
    TrackBar1: TTrackBar;
procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure GetQtStyle(ComboBox:TComboBox);
    procedure CreateCustomTitleBar;
  private
    Draggings: Boolean;
    DragStartPos: TPoint;
    TitleBar: TPanel; // 声明为窗体变量
    procedure TitleBarMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TitleBarMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TitleBarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure CloseButtonClick(Sender: TObject);
    procedure MinimizeButtonClick(Sender: TObject);
    procedure MaximizeButtonClick(Sender: TObject);
    procedure AdjustControlsPosition;
  public

  end;

var
  Form1: TForm1;

implementation
uses
  LCLVersion, InterfaceBase, LCLPlatformDef;

{$R *.lfm}

{ TForm1 }

procedure TForm1.ComboBox1Change(Sender: TObject);
{$ifdef lclqt5}
var
  style:PWideString;
{$endif}
begin
  {$ifdef lclqt5}
  new(style);
  try
    style^:=ComboBox1.Text;
    QApplication_setStyle(style);
  finally
    Dispose(style);
  end;
  {$endif}
end;

procedure TForm1.Button2Click(Sender: TObject);
{$ifdef lclqt5}
var
  style:PWideString;
{$endif}
begin
  {$ifdef lclqt5}
  new(style);
  Label1.Font.Color:=clWhite;
  style^:='QPushButton { background-color: blue; color: white; } '+//TButtion
      'QProgressBar::chunk {background-color: qlineargradient(x1:0, y1:0, x2:1, y2:0, stop:0 #FF0000, stop:1 #00FF00); }'+
      'QLineEdit  { background: gray; color: white; } '+  //TEdit
      'QTextEdit  { background: gray; color: white; } '+  //TMemo
      'QMainWindow  { background-color: gray; color: white; } ';
  QApplication_setStyleSheet(QApplicationH(self),style);
  Dispose(style);
{$endif}
end;

//调整控件位置
procedure TForm1.AdjustControlsPosition;
var
  i: Integer;
  TitleBarHeight: Integer;
begin
  TitleBarHeight := TitleBar.Height;

  for i := 0 to ControlCount - 1 do
  begin
    // 跳过标题栏及其子控件
    if (Controls[i] <> TitleBar) and (Controls[i].Parent <> TitleBar) then
    begin
      // 移动控件到标题栏下方
      Controls[i].Top := Controls[i].Top + TitleBarHeight;
    end;
  end;

  // 增加窗体高度以补偿标题栏
  Height := Height + TitleBarHeight;
end;

procedure TForm1.CreateCustomTitleBar;
begin
  // 隐藏原生边框
  BorderStyle := bsNone;

  // 创建自定义标题栏
  TitleBar := TPanel.Create(Self);
  TitleBar.Parent := Self;
  TitleBar.Align := alTop;
  TitleBar.Height := 60;
  TitleBar.Color := $00333333; // 深灰色
  TitleBar.Caption := '';
  TitleBar.BevelOuter := bvNone;

  // 标题文本
  with TLabel.Create(Self) do
  begin
    Parent := TitleBar;
    Align := alClient;
    Alignment := taCenter;
    Layout := tlCenter;
    Caption := Self.Caption;
    Font.Color := clWhite;
  end;

  // 标题文本
  with TLabel.Create(Self) do
  begin
    Parent := TitleBar;
    Align := alClient;
    Alignment := taCenter;
    Layout := tlCenter;
    Caption := Self.Caption;
    Font.Color := clWhite;
    // 允许标题文本也触发拖动
    OnMouseDown := @TitleBarMouseDown;
    OnMouseMove := @TitleBarMouseMove;
    OnMouseUp := @TitleBarMouseUp;
  end;

  // 最小化按钮
  with TSpeedButton.Create(Self) do
  begin
    Parent := TitleBar;
    Align := alRight;
    Width := 45;
    Caption := '_';
    Font.Color := clWhite;
    Flat := True;
    OnClick := @MinimizeButtonClick;
  end;

  // 最大化按钮
  with TSpeedButton.Create(Self) do
  begin
    Parent := TitleBar;
    Align := alRight;
    Width := 45;
    Caption := '□';
    Font.Color := clWhite;
    Flat := True;
    OnClick := @MaximizeButtonClick;
  end;

  // 关闭按钮
  with TSpeedButton.Create(Self) do
  begin
    Parent := TitleBar;
    Align := alRight;
    Width := 45;
    Caption := 'X';
    Font.Color := clWhite;
    Flat := True;
    OnClick := @CloseButtonClick;
  end;

  // 添加拖动支持
  TitleBar.OnMouseDown := @TitleBarMouseDown;
  TitleBar.OnMouseMove := @TitleBarMouseMove;
  TitleBar.OnMouseUp := @TitleBarMouseUp;
end;

procedure TForm1.TitleBarMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    Draggings := True;
    DragStartPos := Point(X, Y);
  end;
end;

procedure TForm1.TitleBarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if Draggings then
  begin
    Left := Left + (X - DragStartPos.X);
    Top := Top + (Y - DragStartPos.Y);
  end;
end;

procedure TForm1.TitleBarMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Draggings := False;
end;

procedure TForm1.CloseButtonClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.MinimizeButtonClick(Sender: TObject);
begin
  WindowState := wsMinimized;
end;

procedure TForm1.MaximizeButtonClick(Sender: TObject);
begin
  if WindowState = wsMaximized then
    WindowState := wsNormal
  else
    WindowState := wsMaximized;
end;

procedure TForm1.Button3Click(Sender: TObject);
{$ifdef LCLQT5}
var
  styleStr:PWideString;
  Style: QStyleH;
  StyleName:WideString;
  Palette: QPaletteH;
  c1:TColor;
   DarkColor, WhiteColor, BlackColor, LinkColor,color1,redcolor: TQColor;
{$endif}
begin
  {$ifdef lclqt5}
   //// 创建深色调色板
  Palette := QPalette_create();
  try
    // 基础深灰色背景
    ColorRefToTQColor(ColorToRGB(rgbtoColor(53,53,53)), DarkColor);
    ColorRefToTQColor(ColorToRGB(rgbtoColor(255,255,255)), WhiteColor);
    ColorRefToTQColor(ColorToRGB(rgbtoColor(0,0,0)), BlackColor);
    ColorRefToTQColor(ColorToRGB(rgbtoColor(42,130,218)), LinkColor);
    ColorRefToTQColor(ColorToRGB(rgbtoColor(44,45,45)), Color1);
    ColorRefToTQColor(ColorToRGB(rgbtoColor(255,0,0)), redcolor);

    // 设置调色板角色
    QPalette_setColor(Palette, QPaletteWindow, @DarkColor);
    QPalette_setColor(Palette, QPaletteWindowText, @WhiteColor);
    QPalette_setColor(Palette, QPaletteBase, @color1);
    QPalette_setColor(Palette, QPaletteText, @WhiteColor);
    QPalette_setColor(Palette, QPaletteButton, @DarkColor);
    QPalette_setColor(Palette, QPaletteButtonText, @WhiteColor);
    QPalette_setColor(Palette, QPaletteHighlight, @LinkColor);
    QPalette_setColor(Palette, QPaletteHighlightedText, @BlackColor);
    QPalette_setColor(Palette, QPaletteBase, @DarkColor);
    QPalette_setColor(Palette, QPaletteAlternateBase,@color1);// QColor(45, 45, 45));
    QPalette_setColor(Palette, QPaletteToolTipBase, @DarkColor);
    QPalette_setColor(Palette, QPaletteToolTipText, @WhiteColor);
    QPalette_setColor(Palette, QPaletteText, @WhiteColor);
    QPalette_setColor(Palette, QPaletteButton, @DarkColor);
    QPalette_setColor(Palette, QPaletteButtonText, @WhiteColor);
    QPalette_setColor(Palette, QPaletteBrightText, @redcolor); // 红色
    QPalette_setColor(Palette, QPaletteLink, @LinkColor);
    QPalette_setColor(Palette, QPaletteHighlight, @LinkColor);
    QPalette_setColor(Palette, QPaletteHighlightedText, @BlackColor);

    // 应用调色板
    QApplication_setPalette(Palette);
  finally
    QPalette_destroy(Palette);
  end;
 {$endif}
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  OpenDialog1.Execute;
end;

procedure TForm1.GetQtStyle(ComboBox:TComboBox);
{$ifdef LCLQT5}
var
  Style: QStyleH;
  StyleName:WideString;
  StyleList:QStringListH;
  i:Integer;
{$endif}
begin
  {$ifdef lclqt5}

  StyleList:=QStringList_Create;
  QStyleFactory_keys(StyleList);//取当前QT5所有Sttyle
  ComboBox.Items.Clear;
  StyleName:='';
  for i:=0 to QStringList_size(StyleList)-1 do
  begin
    QStringList_at(StyleList,@StyleName,i);
    ComboBox.Items.Add(StyleName);
  end;
  QStringList_destroy(StyleList);
{$endif}
end;

procedure TForm1.FormCreate(Sender: TObject);
{$ifdef LCLQT5}
var
  Style: QStyleH;
  StyleName:WideString;
  Palette: QPaletteH;
{$endif}
begin
  CreateCustomTitleBar;
  AdjustControlsPosition;

  Memo1.Lines.Clear;
  {$ifdef LCLQT5}
  Label1.Enabled:=True;
  ComboBox1.Enabled:=True;

  //取当前Style
  Style:=QApplication_style;
  QObject_objectName(Style, @StyleName); //将style转为字符串
  Memo1.Lines.Add(StyleName);

  GetQtStyle(ComboBox1);

  ComboBox1.ItemIndex:=ComboBox1.Items.IndexOf('Fusion');
  {$else}
  Label1.Enabled:=False;
  ComboBox1.Enabled:=False;
  {$endif}

  Memo1.Lines.Add(Format('Free Pascal version: %d.%d.%d for %s-%s', [FPC_VERSION, FPC_RELEASE, FPC_PATCH,
   lowercase({$i %FPCTARGETOS%}), lowercase({$i %FPCTARGETCPU%})])
   );
  Memo1.Lines.Add( Format('LCL version: %s', [lcl_version]));
  Memo1.Lines.Add( Format('LCL widgetset: %s', [LCLPlatformDisplayNames[WidgetSet.LCLPlatform]]));
end;

end.

在riscv64使用gtk2默认的样式：
Screenshot_2025-07-30_01-41-52
使用Qt5后的样式：

Screenshot_2025-07-30_01-33-05

Screenshot_2025-07-30_01-33-33

Screenshot_2025-07-30_01-34-25

posted on 2025-07-30 10:42  秋·风  阅读(157)  评论(0)    收藏  举报