您现在的位置：程式碼之家 >> 編程語言 > >> 更多程式語言 >> Delphi

用 Delphi 7 實現漢字造型視窗：SetWindowRgn 非矩形視窗技術

編輯：Delphi

核心原理：路徑 → 區域 → 視窗形狀

Windows 允許視窗擁有任意非矩形區域。三步驟：

BeginPath / EndPath：在 DC 上定義繪圖路徑 (文字、幾何圖形)
PathToRegion：將路徑轉換為 HRGN 區域物件
SetWindowRgn：將區域套用到視窗，系統按區域裁剪繪製與點擊測試

完整實現代碼

unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  end;
var Form1: TForm1;
implementation {$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var Rgn: HRGN;
begin
  // 1. 設定視窗背景色 (路徑繪製時可見)
  Color := clRed;

  // 2. 開始路徑定義
  BeginPath(Canvas.Handle);

  // 3. 設定透明背景模式，避免文字周圍白框
  SetBkMode(Canvas.Handle, TRANSPARENT);

  // 4. 設定字體
  Canvas.Font.Name := '新細明體';  // 繁體中文常用字體
  Canvas.Font.Size := 100;
  Canvas.Font.Style := [fsBold];

  // 5. 繪製文字到路徑 (座標需微調置中)
  Canvas.TextOut(15, 15, '電腦報');

  // 6. 結束路徑
  EndPath(Canvas.Handle);

  // 7. 路徑轉區域
  Rgn := PathToRegion(Canvas.Handle);

  // 8. 套用區域到視窗 (True = 重繪)
  SetWindowRgn(Handle, Rgn, True);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  // 無標題列/系統選單，滑鼠右鍵關閉
  if Button = mbRight then Close;
end;
end.

關鍵 API 速查

API	用途	關鍵參數
BeginPath	開啟路徑括號	HDC
EndPath	關閉路徑括號	HDC
PathToRegion	路徑轉 HRGN	HDC → HRGN
SetWindowRgn	設定視窗裁剪區域	HWND, HRGN, bRedraw
SetBkMode	設定背景模式	HDC, TRANSPARENT/OPAQUE

進階技巧與變化

多文字組合 / 圖形混合

BeginPath(Canvas.Handle);
Canvas.TextOut(10, 10, 'Delphi');
Canvas.Ellipse(50, 50, 150, 150); // 圓形
Canvas.Rectangle(200, 10, 300, 100); // 矩形
EndPath(Canvas.Handle);
Rgn := PathToRegion(Canvas.Handle);
SetWindowRgn(Handle, Rgn, True);

從位圖建立區域 (複雜造型)

function CreateRegionFromBitmap(Bmp: TBitmap; TransColor: TColor): HRGN;
var X, Y: Integer; Rgn, TmpRgn: HRGN;
begin
  Result := 0;
  for Y := 0 to Bmp.Height-1 do
  begin
    X := 0;
    while X < Bmp.Width do
    begin
      // 跳過透明色
      while (X < Bmp.Width) and (Bmp.Canvas.Pixels[X, Y] = TransColor) do Inc(X);
      if X >= Bmp.Width then Break;
      // 記錄非透明區間起點
      var StartX := X;
      while (X < Bmp.Width) and (Bmp.Canvas.Pixels[X, Y] <> TransColor) do Inc(X);
      // 建立矩形區域並合併
      TmpRgn := CreateRectRgn(StartX, Y, X, Y+1);
      if Result = 0 then Result := TmpRgn
      else CombineRgn(Result, Result, TmpRgn, RGN_OR);
      DeleteObject(TmpRgn);
    end;
  end;
end;

拖曳無標題列視窗

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    ReleaseCapture;
    SendMessage(Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0); // 模擬標題列拖曳
  end
  else if Button = mbRight then Close;
end;