Страница: 1
Вопрос: форма в виде треугольнука, как?
Добавлено: 19.06.09 10:48
Автор вопроса: LEX1ERS | ICQ: 4204936
Как сделать форму в виде треугольника?как в виде эллипса знаю, но там достаточно указать сам круг и его размеры...а как треугольник хз(
Ответить
Номер ответа: 4Автор ответа: Winand Вопросов: 87Ответов: 2795
Web-сайт: winandfx.narod.ru Профиль | | #4
Добавлено: 19.06.09 19:44
lex1ers, всё проще. и не нужны дополнительные тулзы (это преимущество)
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long , ByVal nIndex As Long ) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long , ByVal nIndex As Long , ByVal dwNewLong As Long ) As Long
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long , ByVal crKey As Long , ByVal bAlpha As Byte , ByVal dwFlags As Long ) As Long
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY As Long = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Public Sub SetTranspLevel(ByVal hWnd As Long , ByVal pp As Byte )
Call SetWindowLong(hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
SetLayeredWindowAttributes hWnd, 0, pp, LWA_ALPHA
End Sub
Public Sub SetTranspColor(ByVal hWnd As Long , ByVal color As Long )
Call SetWindowLong(hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
Call SetLayeredWindowAttributes(hWnd, color, 0, LWA_COLORKEY) End Sub Ответить
Номер ответа: 11Автор ответа: AntiOxygene (MegaDefender) Вопросов: 2Ответов: 107
Web-сайт: safetyAV.narod.ru Профиль | | #11
Добавлено: 21.06.09 01:14
Интересно, а админы на этом форуме существуют? Везде реклама VBD - "www.homacosoft.com", "form creator", "xtreme antivirus", "xqr2". Это нормально?!
Ответить
Номер ответа: 14Автор ответа: VβÐUηìt Вопросов: 246Ответов: 3333
Web-сайт: смекаешь.рф Профиль | | #14
Добавлено: 21.06.09 08:48
Код модуля:
Public Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Public Declare Function GdipDrawImageRect Lib "gdiplus" (ByVal graphics As Long , _
ByVal image As Long , ByVal x As Single , ByVal y As Single , ByVal Width As Single , ByVal Height As Single ) As GpStatus
Public Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String , image As Long ) As GpStatus
Public Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal image As Long , Width As Long ) As GpStatus
Public Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal image As Long , Height As Long ) As GpStatus
Public Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long ) As GpStatus
Public Declare Function GdiplusStartup Lib "gdiplus" (token As Long , _
inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus
Public Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long , graphics As Long ) As GpStatus
Public Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long ) As GpStatus
Public Enum GpStatus
Ok = 0
GenericError = 1
InvalidParameter = 2
OutOfMemory = 3
ObjectBusy = 4
InsufficientBuffer = 5
NotImplemented = 6
Win32Error = 7
WrongState = 8
Aborted = 9
FileNotFound = 10
ValueOverflow = 11
AccessDenied = 12
UnknownImageFormat = 13
FontFamilyNotFound = 14
FontStyleNotFound = 15
NotTrueTypeFont = 16
UnsupportedGdiplusVersion = 17
GdiplusNotInitialized = 18
PropertyNotFound = 19
PropertyNotSupported = 20
End Enum
Option Explicit
Private Const ULW_ALPHA = &H2
Private Const DIB_RGB_COLORS As Long = 0
Private Const AC_SRC_ALPHA As Long = &H1
Private Const AC_SRC_OVER = &H0
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE As Long = -20
Private Const HWND_TOPMOST As Long = -1
Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_NOSIZE As Long = &H1
Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
Private Type Size
cx As Long
cy As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFOHEADER
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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd _
As Long , ByVal nIndex As Long , ByVal dwNewLong As Long ) As Long
Private Declare Function UpdateLayeredWindow Lib "user32.dll" (ByVal hwnd As Long , _
ByVal hdcDst As Long , pptDst As Any, psize As Any, ByVal hdcSrc As Long , pptSrc As Any, ByVal crKey As Long , ByRef pblend As BLENDFUNCTION, ByVal dwFlags As Long ) As Long
Private Declare Function CreateDIBSection Lib "gdi32.dll" (ByVal hdc As Long , _
pBitmapInfo As BITMAPINFO, ByVal un As Long , ByRef lplpVoid As Any, _
ByVal handle As Long , ByVal dw As Long ) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long ) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long , _
ByVal hObject As Long ) As Long
Private Declare Function SetWindowPos Lib "user32.dll" (ByVal hwnd As Long , _
ByVal hWndInsertAfter As Long , ByVal x As Long , ByVal y As Long , ByVal cx As Long , ByVal cy As Long , ByVal wFlags As Long ) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" _
(ByVal hwnd As Long , ByVal nIndex As Long ) As Long
Private mDC As Long
Private mainBitmap As Long
Private blendFunc32bpp As BLENDFUNCTION
Private token As Long
Private oldBitmap As Long
Private Declare Sub ReleaseCapture Lib "user32" ()
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long , ByVal wMsg As Long , ByVal wparam As Integer , ByVal iparam As Long ) As Long
Private Sub FormMove(lhWnd As Long )
ReleaseCapture
Call SendMessage(lhWnd, &HA1, 2, 0&)
End Sub
Private Sub Form_DblClick()
Unload Me
End Sub
Private Sub Form_MouseMove(Button As Integer , Shift As Integer , x As Single , y As Single )
If Button = 1 Then FormMove hwnd
End Sub
Private Sub Form_Initialize()
Dim GpInput As GdiplusStartupInput
GpInput.GdiplusVersion = 1
If GdiplusStartup(token, GpInput) <> 0 Then
MsgBox "Ошибка GDI+!" , vbCritical
Unload Me
End If
MakeTrans App.Path & "\pngres.png"
End Sub
Private Function MakeTrans(pngPath As String ) As Boolean
Dim tempBI As BITMAPINFO
Dim lngHeight As Long
Dim lngWidth As Long
Dim curWinLong As Long
Dim img As Long
Dim graphics As Long
Dim winSize As Size
Dim srcPoint As POINTAPI
With tempBI.bmiHeader
.biSize = Len(tempBI.bmiHeader)
.biBitCount = 32
.biHeight = ScaleHeight
.biWidth = ScaleWidth
.biPlanes = 1
.biSizeImage = .biWidth * .biHeight * (.biBitCount / 8)
End With
mDC = CreateCompatibleDC(hdc)
mainBitmap = CreateDIBSection(mDC, tempBI, DIB_RGB_COLORS, ByVal 0, 0, 0)
oldBitmap = SelectObject(mDC, mainBitmap)
Call GdipCreateFromHDC(mDC, graphics)
Call GdipLoadImageFromFile(StrConv(pngPath, vbUnicode), img)
Call GdipGetImageHeight(img, lngHeight)
Call GdipGetImageWidth(img, lngWidth)
Call GdipDrawImageRect(graphics, img, 0, 0, lngWidth, lngHeight)
curWinLong = GetWindowLong(hwnd, GWL_EXSTYLE)
SetWindowLong hwnd, GWL_EXSTYLE, curWinLong Or WS_EX_LAYERED
SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
srcPoint.x = 0
srcPoint.y = 0
winSize.cx = ScaleWidth
winSize.cy = ScaleHeight
With blendFunc32bpp
.AlphaFormat = AC_SRC_ALPHA
.BlendFlags = 0
.BlendOp = AC_SRC_OVER
.SourceConstantAlpha = 255
End With
Call GdipDisposeImage(img)
Call GdipDeleteGraphics(graphics)
Call UpdateLayeredWindow(hwnd, hdc, ByVal 0&, winSize, mDC, srcPoint, 0, blendFunc32bpp, ULW_ALPHA)
End Function
Call MakeTrans (App.Path & "\skin.png" )
Ответить
Страница: 1
Поиск по форуму
LEX1ERS | ICQ: 4204936 
Stars
User Unknown