Ai biết làm skin giúp tôi với

[xeko]

Tôi muốn làm skin kiểu như Vietkar, Ko dung các phần mềm khác mà chỉ dùng các ảnh và tạo ra skin. Giúp tôi nha

[trungnt88]

cả skin là 1 img / nhiều img ?
sao không dùng ocx ?
nếu muốn img tự chế thì dùng win blind -> capture screen -> copy lại skin

[xeko]

Tui ko thích ocx mà ai biết down skinmaker ở đâu ko

[dieuky]

Bạn hãy tạo ra những skin VD hình tròn , vùng ngoài hình tròn bạn hãy để mầu đen , sau đó viết modul xoá mầu đen đó là xong,
hãy liên hệ với tôi bạn sẽ có được modul đó. nguyendangky@hotmail.com, mobile phone : 0912005578

[trungphmx]

bạn thử dùng vbsfc của alex gì đó chỉ việc lên google gỏ vào vbsfc là có ngay kết hợp với các ảnh tạo skin củng khá

[thienancn4]

trungphmx nói đúng đó , tui muốn làm hình nào củng được nhưng làm giống vietkar hơi bị khó đó vì người ta viết bằng delphi cơ mà

[dieuky]

Tôi muốn làm skin kiểu như Vietkar, Ko dung các phần mềm khác mà chỉ dùng các ảnh và tạo ra skin. Giúp tôi nha
================================================== ====
Bạn bản phải tự tạo skin trước phần nào mà bạn muốn xoá thì để mầu đen
VD tạo hình tròn thì bên ngoài hình tròn để mầu đen
Chúc vui.

'Class Modules 1

Option Explicit

Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFOHEADER '40 bytes
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "USER32" () As Long
Private Declare Function CreateDIBSection Lib "gdi32" _
(ByVal hdc As Long, _
pBitmapInfo As BITMAPINFO, _
ByVal un As Long, _
lplpVoid As Long, _
ByVal handle As Long, _
ByVal dw As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Const BI_RGB = 0&
Private Const BI_RLE4 = 2&
Private Const BI_RLE8 = 1&
Private Const DIB_RGB_COLORS = 0

Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Private m_hDIb As Long
Private m_hBmpOld As Long
Private m_hDC As Long
Private m_lPtr As Long
Private m_tBI As BITMAPINFO

Public Function CreateDIB( _
ByVal lhDC As Long, _
ByVal lWidth As Long, _
ByVal lHeight As Long, _
ByRef hDib As Long _
) As Boolean
With m_tBI.bmiHeader
.biSize = Len(m_tBI.bmiHeader)
.biWidth = lWidth
.biHeight = lHeight
.biPlanes = 1
.biBitCount = 24
.biCompression = BI_RGB
.biSizeImage = BytesPerScanLine * .biHeight
End With
hDib = CreateDIBSection( _
lhDC, _
m_tBI, _
DIB_RGB_COLORS, _
m_lPtr, _
0, 0)
CreateDIB = (hDib <> 0)
End Function

Public Function CreateFromPicture( _
ByRef picThis As StdPicture _
)
Dim lhDC As Long
Dim lhDCDesktop As Long
Dim lhBmpOld As Long
Dim tBMP As BITMAP

GetObjectAPI picThis.handle, Len(tBMP), tBMP
If (Create(tBMP.bmWidth, tBMP.bmHeight)) Then
lhDCDesktop = GetDC(GetDesktopWindow())
If (lhDCDesktop <> 0) Then
lhDC = CreateCompatibleDC(lhDCDesktop)
DeleteDC lhDCDesktop
If (lhDC <> 0) Then
lhBmpOld = SelectObject(lhDC, picThis.handle)
LoadPictureBlt lhDC
SelectObject lhDC, lhBmpOld
DeleteObject lhDC
End If
End If
End If
End Function

Public Function Create( _
ByVal lWidth As Long, _
ByVal lHeight As Long _
) As Boolean
ClearUp
m_hDC = CreateCompatibleDC(0)
If (m_hDC <> 0) Then
If (CreateDIB(m_hDC, lWidth, lHeight, m_hDIb)) Then
m_hBmpOld = SelectObject(m_hDC, m_hDIb)
Create = True
Else
DeleteObject m_hDC
m_hDC = 0
End If
End If
End Function

Public Property Get BytesPerScanLine() As Long
BytesPerScanLine = (m_tBI.bmiHeader.biWidth * 3 + 3) And &HFFFFFFFC
End Property

Public Property Get Width() As Long
Width = m_tBI.bmiHeader.biWidth
End Property

Public Property Get Height() As Long
Height = m_tBI.bmiHeader.biHeight
End Property

Public Sub LoadPictureBlt( _
ByVal lhDC As Long, _
Optional ByVal lSrcLeft As Long = 0, _
Optional ByVal lSrcTop As Long = 0, _
Optional ByVal lSrcWidth As Long = -1, _
Optional ByVal lSrcHeight As Long = -1, _
Optional ByVal eRop As RasterOpConstants = vbSrcCopy _
)
If lSrcWidth < 0 Then lSrcWidth = m_tBI.bmiHeader.biWidth
If lSrcHeight < 0 Then lSrcHeight = m_tBI.bmiHeader.biHeight
BitBlt m_hDC, 0, 0, lSrcWidth, lSrcHeight, lhDC, lSrcLeft, lSrcTop, eRop
End Sub

Public Property Get hdc() As Long
hdc = m_hDC
End Property

Public Property Get hDib() As Long
hDib = m_hDIb
End Property

Public Property Get DIBSectionBitsPtr() As Long
DIBSectionBitsPtr = m_lPtr
End Property

Public Sub ClearUp()
If (m_hDC <> 0) Then
If (m_hDIb <> 0) Then
SelectObject m_hDC, m_hBmpOld
DeleteObject m_hDIb
End If
DeleteObject m_hDC
End If
m_hDC = 0: m_hDIb = 0: m_hBmpOld = 0: m_lPtr = 0
End Sub

Private Sub Class_Terminate()
ClearUp
End Sub


'Class Modules 2
Option Explicit

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 Const RGN_AND = 1
Private Const RGN_COPY = 5
Private Const RGN_DIFF = 4
Private Const RGN_OR = 2
Private Const RGN_XOR = 3
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject 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 GetRegionData Lib "gdi32" (ByVal hRgn As Long, ByVal dwCount As Long, lpRgnData As Any) As Long
Private Declare Function ExtCreateRegion Lib "gdi32" (lpXform As Any, ByVal nCount As Long, lpRgnData As Any) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Private Type SAFEARRAY2D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
Bounds(0 To 1) As SAFEARRAYBOUND
End Type
Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (ptr() As Any) As Long

Private m_hRgn As Long
Private m_hWnd() As Long
Private m_iCount As Long

Public Property Get Applied(ByVal hWnd As Long) As Boolean
Applied = Not (plIndex(hWnd) = 0)
End Property

Public Property Let Applied(ByVal hWnd As Long, ByVal bState As Boolean)
Dim i As Long
Dim lIndex As Long
lIndex = plIndex(hWnd)
If bState Then
If (lIndex = 0) Then
m_iCount = m_iCount + 1
ReDim Preserve m_hWnd(1 To m_iCount) As Long
m_hWnd(m_iCount) = hWnd
SetWindowRgn m_hWnd(m_iCount), m_hRgn, True
Else
SetWindowRgn m_hWnd(m_iCount), m_hRgn, True
End If
Else
If (lIndex = 0) Then
SetWindowRgn hWnd, 0, True
Else
SetWindowRgn hWnd, 0, True
If m_iCount > 1 Then
For i = lIndex To m_iCount - 1
m_hWnd(i) = m_hWnd(i + 1)
Next i
m_iCount = m_iCount - 1
ReDim Preserve m_hWnd(1 To m_iCount) As Long
Else
m_iCount = 0
Erase m_hWnd
End If
End If
End If
End Property

Private Property Get plIndex(ByVal hWnd As Long) As Long
Dim i As Long
Dim lIndex As Long
For i = 1 To m_iCount
If hWnd = m_hWnd(i) Then
plIndex = i
Exit For
End If
Next i
End Property

Private Sub UnApply()
Dim i As Long
For i = 1 To m_iCount
If Not m_hWnd(i) = 0 Then
SetWindowRgn m_hWnd(i), 0, True
m_hWnd(i) = 0
End If
Next i
m_iCount = 0
End Sub

Public Sub Destroy()
UnApply
If Not m_hRgn = 0 Then
DeleteObject m_hRgn
End If
m_hRgn = 0
End Sub

Public Sub Create( _
ByRef cDib As cDIBSection, _
Optional ByRef lTransColor As Long = 0 _
)
Dim x As Long, y As Long
Dim lX As Long
Dim yStart As Long
Dim bStart As Boolean
Dim hRgnTemp As Long
Dim bR As Byte, bG As Byte, bB As Byte
Dim lWidth As Long, lHeight As Long
Dim bDib() As Byte
Dim tSA As SAFEARRAY2D

Destroy

bR = (lTransColor And &HFF&)
bG = (lTransColor And &HFF00&) \ &H100&
bB = (lTransColor And &HFF0000) \ &H10000

m_hRgn = CreateRectRgn(0, 0, cDib.Width, cDib.Height)
Debug.Assert (m_hRgn <> 0)
If m_hRgn <> 0 Then
With tSA
.cbElements = 1
.cDims = 2
.Bounds(0).lLbound = 0
.Bounds(0).cElements = cDib.Height
.Bounds(1).lLbound = 0
.Bounds(1).cElements = cDib.BytesPerScanLine()
.pvData = cDib.DIBSectionBitsPtr
End With
CopyMemory ByVal VarPtrArray(bDib()), VarPtr(tSA), 4

lWidth = cDib.BytesPerScanLine \ 3
lHeight = cDib.Height
For x = 0 To (lWidth - 1) * 3 Step 3
For y = lHeight - 1 To 0 Step -1
If bDib(x, y) = bB And bDib(x + 1, y) = bG And bDib(x + 2, y) = bR Then
If Not bStart Then
yStart = lHeight - 1 - y
bStart = True
End If
Else
If bStart Then
hRgnTemp = CreateRectRgn(lX, yStart, lX + 1, lHeight - 1 - y)
CombineRgn m_hRgn, hRgnTemp, m_hRgn, RGN_XOR
DeleteObject hRgnTemp
bStart = False
End If
End If
Next y
If bStart Then
hRgnTemp = CreateRectRgn(lX, yStart, lX + 1, lHeight - 1 - y)
CombineRgn m_hRgn, hRgnTemp, m_hRgn, RGN_XOR
DeleteObject hRgnTemp
bStart = False
End If
lX = lX + 1
Next x
CopyMemory ByVal VarPtrArray(bDib), 0&, 4
End If
End Sub

Private Sub Class_Terminate()
Destroy
End Sub

'form main
Private Sub cmdCrystal_Click()
'-- Flash form ----------------------------------------------------------------------------------
Dim cDib As New cDIBSection
cDib.CreateFromPicture picBackground.Picture
m_cDibR.Create cDib
m_cDibR.Applied(Me.hWnd) = True
Set Me.Picture = picBackground.Picture
'-- End of Flash form ---------------------------------------------------------------------------

End Sub

[dtt_vn]

Delphi hay VB đều có khả năng tạo skin mạnh mẽ vì đều dùng các hàm Region của W

[ITbaby]

Anh Xeko hãy vào trang này http://www.byalexv.co.uk/index.html?VBSFC.html down về. Xem ví dụ của nó trước nhé. Have Fun :D

[hoanganhviet2002]

Dùng active skin cũng hay.

[ITbaby]

Dùng mấy cái OCX đó thì giảm khả năng mất. Có 1 cái cũng hay nữa nè. Va`o Link sau
http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=44773&lngWId=1

Download nó về. Run là biết liền hà. Còn từ cái Source đó các anh có thể tùy biến cho nó giống như Form của ENGlich Study cũng được, Thay đổi như thế nào cũng được đó là tùy các anh nhé. Hơi bị Cool đó

[phamhuuphu]

To ITbaby : thật tuyệt vời . Thank nìu

[bagia_nhayhiphop]

Ac ac! De xoa mot vu`ng den ben ngoa`i vien cua hinh tron cu~ng la` ca? moy vna de chu it gi` dau, ca mot doan code the kia ma