我想死你了

最新推荐文章于 2023-05-17 18:31:30 发布

最新推荐文章于 2023-05-17 18:31:30 发布 · 265 阅读

博客展示了在窗体上实现镂空文字“我想死你了”的代码。通过声明多个 API 函数，在 Form_Load 事件中设置窗体状态、字体、背景色等，利用路径和区域操作实现文字镂空效果，还使用 StretchBlt 函数进行图像复制。

在窗体上镂空文字: 我想死你了

Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function PathToRegion Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function StretchBlt& Lib "gdi32" (ByVal hdc&, ByVal x&, ByVal y&, ByVal nWidth&, ByVal nHeight&, ByVal hSrcDC&, ByVal XSrc&, ByVal YSrc&, ByVal nSrcWidth&, ByVal nSrcHeight&, ByVal dwRop&)
Private Const SRCCOPY = &HCC0020

Private Sub Form_Load()
Dim hRgn As Long
Me.WindowState = 2
Me.FontName = "arial"
Me.FontSize = 110
Me.BackColor = vbRed
BeginPath Me.hdc
TextOut Me.hdc, 0, 0, "我想死你了！", 12

EndPath Me.hdc
    hRgn = PathToRegion(Me.hdc)
    SetWindowRgn Me.hWnd, hRgn, True
    DeleteObject hRgn
     StretchBlt Me.hdc, Me.ScaleWidth, 0, -Me.ScaleWidth, Me.ScaleHeight / 2, Me.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight / 2, SRCCOPY
End Sub