秋·風

:: :: :: :: :: ::
:: ::
公告

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默認的樣式：

使用Qt5后的樣式：
posted on 2025-07-30 10:42 秋·風閱讀(162) 評論(0) 收藏舉報
刷新頁面返回頂部