Tác giả: Nobi
Mô tả: Làm cho form có hình dạng theo 1 ảnh bất kỳ
Thêm vào Form 1 picturebox.
Set thuộc tính BorderStyle của Form = 0 (None)
Thêm vào chương trình đoạn mã sau :
Mã: Chọn hết
- Option Explicit
-
- Private Const HTCAPTION = 2
- Private Const WM_NCLBUTTONDOWN = &HA1
- Private Declare Function ReleaseCapture Lib "user32" () As Long
- Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
-
- Private Const RGN_OR = 2
- Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
- Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y 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 CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
- Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
-
- Private Function MakeRegion(picSkin As PictureBox) As Long
- Dim x As Long, y As Long, StartLineX As Long
- Dim LineRegion As Long
- Dim FullRegion As Long
- Dim TransparentColor As Long
- Dim InFirstRegion As Boolean
- Dim InLine As Boolean
- Dim hdc As Long
- Dim picWidth As Long
- Dim picHeight As Long
-
- hdc = picSkin.hdc
- picWidth = picSkin.ScaleWidth
- picHeight = picSkin.ScaleHeight
-
- InFirstRegion = True: InLine = False
- x = y = StartLineX = 0
- TransparentColor = RGB(255, 0, 255) 'Chọn màu muốn lọai bỏ trong picture, ở đây là màu hồng, hoặc lấy màu ở pixel đầu tiên
- 'TransparentColor = GetPixel(hdc, 0, 0)
-
- For y = 0 To picHeight - 1
- For x = 0 To picWidth - 1
- If GetPixel(hdc, x, y) = TransparentColor Or x = picWidth Then
- If InLine Then
- InLine = False
- LineRegion = CreateRectRgn(StartLineX, y, x, y + 1)
-
- If InFirstRegion Then
- FullRegion = LineRegion
- InFirstRegion = False
- Else
- CombineRgn FullRegion, FullRegion, LineRegion, RGN_OR
- DeleteObject LineRegion
- End If
- End If
- Else
- If Not InLine Then
- InLine = True
- StartLineX = x
- End If
- End If
- Next
- Next
- MakeRegion = FullRegion
- End Function
-
- Private Sub Form_DblClick()
- Unload Me
- End Sub
-
- Private Sub Form_Load()
- Picture1.ScaleMode = 3
- Picture1.AutoSize = True
- Picture1.Visible = False
- 'Picture1.Picture = LoadPicture("C:\skin.bmp") 'Ðường dẩn file ảnh cần thiết
- 'If Picture1.Picture <> 0 Then
- Me.Picture = Picture1.Picture
- SetWindowRgn Me.hwnd, MakeRegion(Picture1), True
- 'End If
- End Sub
-
- Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
- If Button = vbLeftButton Then
- ReleaseCapture
- SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
- End If
- End Sub