haav | Дата: Воскресенье, 12.01.2014, 09:48 | Сообщение # 1 |
Генералиссимус
Группа: Администраторы
Сообщений: 1366
Статус: Offline
| Цветные кнопки
Простой пример как перекрашивать стандартные контролы Button
Автор: Kwabbernoot
Код ' ****************************** ' * * ' * TEST WINDOWS API BUTTONS * ' * * ' ****************************** ' #Include Once "WINDOWS.BI"
Declare Sub WinInit Declare Function WinProc (ByVal Hwin As HWND, _ ByVal message As UINT, _ ByVal wParam As WPARAM, _ ByVal lParam As LPARAM) As LRESULT Declare Sub ColorButton (ByRef PntDrawIS As DRAWITEMSTRUCT Ptr, _ ByVal ButColor As Integer, _ ByVal ButWidth As Integer, ByVal ButHeight As Integer) Declare Function GradientFill Lib "msimg32" Alias "GradientFill"( _ ByVal hdc As HDC, _ ByVal pVertex As PTRIVERTEX, _ ByVal dwNumVertex As DWORD, _ ByVal pMesh As Const PVOID, _ ByVal dwNumMesh As DWORD, _ ByVal dwMode As DWORD) As BOOL
#DEFINE GRADIENT_FILL_RECT_H 0 #DEFINE CodeRed 1 #DEFINE CodeGreen 2 #DEFINE CodeBlue 3 #DEFINE CodeYellow 4 #DEFINE CodePurple 5 Enum IdButRed = 101 IdButGreen IdButBlue IdButYellow IdButPurple End Enum
Dim Shared As HINSTANCE ProgInst Dim Shared As HWND Hwin Dim Shared As HWND HwinRed, HwinGreen, HwinBlue Dim Shared As HWND HwinYellow, HwinPurple Dim As MSG WinMessage
'*** Start
WinInit '*** Initialize windows session
'*** Process windows messages
Do While GetMessage(@WinMessage, Null, 0, 0) TranslateMessage @WinMessage DispatchMessage @WinMessage Loop
'*** End
End ' ' ******************************** ' * INITIALIZE WINDOWS SESSION * ' ******************************** ' Sub WinInit
Dim As WNDCLASS WinClass Dim As String AppName
'*** Setup window class
ProgInst = GetModuleHandle(Null) AppName = "Colored Buttons"
With WinClass .style = CS_HREDRAW Or CS_VREDRAW .lpfnWndProc = @WinProc .cbClsExtra = 0 .cbWndExtra = 0 .hInstance = ProgInst .hIcon = LoadIcon(Null, IDI_APPLICATION) .hCursor = LoadCursor(Null, IDC_ARROW) ' .hbrBackground = GetStockObject(LTGRAY_BRUSH) ' .hbrBackground = GetSysColorBrush(COLOR_3DFACE) .hbrBackground = Cast(HBRUSH, COLOR_BACKGROUND) .lpszMenuName = Null .lpszClassName = StrPtr(AppName) End With
'*** Register the window class
If RegisterClass(@WinClass) = False Then MessageBox(Null, "Failed to register the window class", AppName, _ MB_ICONERROR) End End If
'*** Create the window and show it
Hwin = CreateWindowEx(0, AppName, AppName, WS_OVERLAPPEDWINDOW, _ CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _ Null, Null, ProgInst, Null) '*** Create window (windows) ShowWindow Hwin, SW_NORMAL '*** Show window (windows) UpdateWindow Hwin '*** Update (client area) window (windows)
End Sub ' ' ****************************** ' * PROCESS WINDOWS MESSAGES * ' * (called by Windows) * ' ****************************** ' Function WinProc(ByVal Hwin As HWND, _ ByVal Message As UINT, _ ByVal wParam As WPARAM, _ ByVal lParam As LPARAM) As LRESULT
Dim As DRAWITEMSTRUCT Ptr PntDrawIS
Function = 0
'*** Process windows messages
Select Case Message Case WM_CREATE '*** Create menus HwinRed = CreateWindowEx(0, "BUTTON", "RED", _ WS_VISIBLE Or WS_CHILD Or BS_OWNERDRAW, 10, 10, 100, 50, Hwin, _ Cast(HMENU, IdButRed), ProgInst, NULL) HwinBlue = CreateWindowEx(0, "BUTTON", "BLUE", _ WS_VISIBLE Or WS_CHILD Or BS_OWNERDRAW, 10, 70, 100, 50, Hwin, _ Cast(HMENU, IdButBlue), ProgInst, NULL) HwinGreen = CreateWindowEx(0, "BUTTON", "GREEN", _ WS_VISIBLE Or WS_CHILD Or BS_OWNERDRAW, 10, 130, 100, 50, Hwin, _ Cast(HMENU, IdButGreen), ProgInst, NULL) HwinYellow = CreateWindowEx(WS_EX_CLIENTEDGE, "BUTTON", "YELLOW", _ WS_VISIBLE Or WS_CHILD Or BS_OWNERDRAW, 10, 190, 100, 50, Hwin, _ Cast(HMENU, IdButYellow), ProgInst, NULL) HwinPurple = CreateWindowEx(WS_EX_CLIENTEDGE, "BUTTON", "PURPLE", _ WS_VISIBLE Or WS_CHILD Or BS_OWNERDRAW, 10, 250, 100, 50, Hwin, _ Cast(HMENU, IdButPurple), ProgInst, NULL)
Case WM_COMMAND '*** User selected a command
'*** Process commands
Select Case LoWord(wParam) Case IdButRed MessageBox(Hwin, "Red Button Pressed", "Red", MB_OK) Case IdButGreen MessageBox(Hwin, "Green Button Pressed", "Green", MB_OK) Case IdButBlue MessageBox(Hwin, "Blue Button Pressed", "Blue", MB_OK) Case IdButYellow MessageBox(Hwin, "Yellow Button Pressed", "Yellow", MB_OK) Case IdButPurple MessageBox(Hwin, "Purple Button Pressed", "Purple", MB_OK) End Select
Case WM_DRAWITEM
'*** Owner-drawn button
PntDrawIS = Cast(DRAWITEMSTRUCT Ptr, lParam) Select Case PntDrawIS->CtlID Case IdButRed ColorButton (PntDrawIS, CodeRed, 100, 50) '*** Color button Case IdButGreen ColorButton (PntDrawIS, CodeGreen, 100, 50) '*** Color button Case IdButBlue ColorButton (PntDrawIS, CodeBlue, 100, 50) '*** Color button Case IdButYellow ColorButton (PntDrawIS, CodeYellow, 95, 45) '*** Color button Case IdButPurple ColorButton (PntDrawIS, CodePurple, 100, 50) '*** Color button End Select
Case WM_KEYDOWN '*** A (nonsystem) key is pressed If LoByte(wParam) = 27 Then PostMessage Hwin, WM_CLOSE, 0, 0 End If
'*** Window was closed
Case WM_DESTROY PostQuitMessage(0) Exit Function
'*** Give message back to windows
Case Else Return DefWindowProc(Hwin, Message, wParam, lParam) End Select Return 0
End Function ' ' ****************** ' * COLOR BUTTON * ' ****************** ' Sub ColorButton (ByRef PntDrawIS As DRAWITEMSTRUCT Ptr, _ ByVal ButColor As Integer, _ ByVal ButWidth As Integer, ByVal ButHeight As Integer)
Dim As HWND HwinBut Dim As TRIVERTEX Vertex(0 To 1) Dim As GRADIENT_RECT GraRect Dim As RECT RectPnt Dim As UInteger RGB0, RGB1 Dim As ZString*30 ButBuffer
HwinBut = PntDrawIS->hwndItem '** Get handle of button Vertex(0).x = 0 Vertex(0).y = 0 Vertex(1).x = ButWidth Vertex(1).y = ButHeight
If PntDrawIS->itemState And ODS_SELECTED Then
'*** Set colors for button pressed
Select Case Butcolor Case CodeRed RGB0 = &HFF0000 RGB1 = &HCC0000 Case CodeGreen RGB0 = &H00FF00 RGB1 = &H00CC00 Case CodeBlue ' RGB0 = &H0000FF RGB0 = &H87CEEB RGB1 = &H0000CC Case CodeYellow RGB0 = &HFFFF00 RGB1 = &HFFDF00 Case Else RGB0 = &HE3BBFF RGB1 = &HC8A2C8 End Select
Else
'*** Set colors for button (not pressed)
Select Case Butcolor Case CodeRed RGB0 = &H990000 RGB1 = &HDD0000 Case CodeGreen RGB0 = &H009900 RGB1 = &H00DD00 Case CodeBlue RGB0 = &H000099 RGB1 = &H0000DD Case CodeYellow RGB0 = &HFFBF00 RGB1 = &HFFDB58 Case Else RGB0 = &HB57ECF RGB1 = &H800080 End Select End If
'*** Show colors and text
Vertex(0).Red = (RGB0 Shr 8) And &H00FF00 Vertex(0).Green = RGB0 And &H00FF00 Vertex(0).Blue = (RGB0 Shl 8) And &H00FF00 Vertex(1).Red = (RGB1 Shr 8) And &H00FF00 Vertex(1).Green = RGB1 And &H00FF00 Vertex(1).Blue = (RGB1 Shl 8) And &H00FF00
GraRect.UpperLeft = 0 GraRect.LowerRight = 1 GradientFill(PntDrawIS->hDC, @Vertex(0), 2, @GraRect, 1, _ GRADIENT_FILL_RECT_H) '*** Fill rectangle (windows) GetClientRect(HwinBut, @RectPnt) '*** Get client coordinates (windows) SetBkMode(PntDrawIS->hDC, TRANSPARENT) '*** Set background mode (windows) GetWindowText(HwinBut, ButBuffer, 30) '*** Get text of a control (windows) DrawText(PntDrawIS->hDC, ButBuffer, -1, @RectPnt, DT_CENTER Or _ DT_VCENTER Or DT_SINGLELINE) '*** Draw text in rectangle (windows)
End Sub
Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
|
|
| |