GRAPHIC BUTTONS

************************************************************************************
Source code of GraphicalButton.vbp
************************************************************************************

Type=Exe
Form=frmGraphicalButton.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\system32\stdole2.tlb#OLE Automation
IconForm="frmGraphicalButton"
Startup="frmGraphicalButton"
ExeName32="Progetto1.exe"
Command32=""
Name="Progetto1"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="."
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1

[MS Transaction Server]
AutoRefresh=1

************************************************************************************
End of source code of GraphicalButton.vbp
************************************************************************************

************************************************************************************
Source code of frmGraphicalButton.frm
************************************************************************************
VERSION 5.00
Begin VB.Form frmGraphicalButton 
   BackColor       =   &H00FFFDF9&
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "Graphic Buttons"
   ClientHeight    =   3735
   ClientLeft      =   45
   ClientTop       =   285
   ClientWidth     =   7875
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   249
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   525
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.OptionButton Option1 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "V"
      ForeColor       =   &H80000008&
      Height          =   195
      Index           =   1
      Left            =   7320
      TabIndex        =   4
      Top             =   120
      Width           =   375
   End
   Begin VB.OptionButton Option1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "H"
      ForeColor       =   &H80000008&
      Height          =   195
      Index           =   0
      Left            =   6840
      TabIndex        =   3
      Top             =   120
      Value           =   -1  'True
      Width           =   435
   End
   Begin VB.ComboBox Combo1 
      Height          =   315
      Left            =   5460
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   60
      Width           =   1275
   End
   Begin VB.PictureBox p 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H000000FF&
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "Segoe UI"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   750
      Index           =   0
      Left            =   120
      ScaleHeight     =   50
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   56
      TabIndex        =   0
      Tag             =   "0"
      Top             =   600
      Width           =   840
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      BeginProperty Font 
         Name            =   "Lucida Console"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   60
      TabIndex        =   1
      Top             =   60
      Width           =   5295
   End
End
Attribute VB_Name = "frmGraphicalButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' SetCapture, ReleaseCapture, GetCapture for to simulate MouseEnter and MouseLeave events
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetCapture Lib "user32" () As Long
' Retrieve pixel color, faster then Point function
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
Dim sCaption(4) As String, s As Integer, t(255) As String

'******************************************************************************
'
' Buttons definition
'
' imgXYYZ
'
' img = image prefix
' X = n: normal, o: over, c: clicked
' YY = skin number in hex format (2 digit)
' Z = image number
'
' NOTE: only skins "Rosso" and "Blu" have left and right different pictures
' 0, 1 and 2. All the others skins have only picture 0
'
' Each skin is formed by 3 pictures imgnYY0, imgoYY0 and imgcYY0
'
' "Rosso" and "Blu" are formed by 9 pictures imgnYY0, imgoYY0, imgcYY0,
' imgnYY1, imgoYY1, imgcYY1, imgnYY2, imgoYY2, imgcYY2
'
' imgnYY0, imgoYY0, imgcYY0 are for left button images
' imgnYY1, imgoYY1, imgcYY1 are for middle buttons images
' imgnYY2, imgoYY2, imgcYY2 are for right button images
'
' see comments on PICTURE SELECTOR, variable t() store picture selection
'
'******************************************************************************

Private Sub Combo1_Click()
 'store skin number
 s = Combo1.ListIndex
 'change skin layout
 ChangeSkin
End Sub

Private Sub Form_Load()
Dim i As Integer
' add skin names
Combo1.AddItem "Rosso"
Combo1.AddItem "Blu"
Combo1.AddItem "XP Met1"
Combo1.AddItem "Vista TkB1"
Combo1.AddItem "Vista Btn1"
Combo1.AddItem "Vista Btn2"
Combo1.AddItem "Blood"
Combo1.AddItem "Dark"
Combo1.AddItem "Haze"
Combo1.AddItem "Mixed_1"
Combo1.AddItem "Vista Btn3"
Combo1.AddItem "Vista TkB2"
Combo1.AddItem "Mixed_2"
Combo1.AddItem "Mixed_3"
Combo1.AddItem "Mixed_4"
Combo1.AddItem "Mixed_5"
Combo1.AddItem "XP HS_1"
Combo1.AddItem "XP HS_2"
Combo1.AddItem "XP HS_3"
Combo1.AddItem "XP Met2"
Combo1.AddItem "MAC2_1"
Combo1.AddItem "LH_1"
Combo1.AddItem "Rnd_1"
Combo1.AddItem "Tabs_1"
Combo1.AddItem "Vista Btn3"

'PICTURE SELECTOR
'determine how many different button picture I'm using
For i = LBound(t) To UBound(t)
 'by default all skins are only one button picture, type "0"
 t(i) = "00000"
Next i
'"Rosso' is using 3 different button pictures, the first is type "0", all the others type "1" and the last type "2"
t(0) = "01112"
'"Blu" is using same layout as "Rosso"
t(1) = "01112"

'loading button pictures
For i = 1 To 4
 Load p(i)
 p(i).Visible = True
Next i

'move the first button on upper left corner of the form
p(0).Move 10, 30, 100, 30

'0 create horizontal bar, 1 create vertical menu
CreateButtons 0
'select last skin ("Vista Btn3")
Combo1.ListIndex = Combo1.ListCount - 1
End Sub

Private Sub Option1_Click(Index As Integer)
'set horizontal or vertical button bar
 CreateButtons Index
End Sub

Private Sub p_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
 'mouse button is left
 If Button = 1 Then
  'set buttondown image
  p(Index).Picture = LoadPicture("imgc" & d2h(s) & Mid$(t(Val(s)), Index + 1, 1) & ".gif")
  'print again text this time 1 pixel shifted (tb is true)
  PrintText p(Index), sCaption(Index), True
  'message the button is pressed
  Label1 = sCaption(Index) & " pressed"
 End If
End Sub

Private Sub p_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
 'simulating MouseEnter and MouseLeave events
 If (x < 0) Or (y < 0) Or (x > p(Index).Width) Or (y > p(Index).Height) Then
  'mouseleave
  ReleaseCapture
  'restore normal button image and text
  p(Index).Picture = LoadPicture("imgn" & d2h(s) & Mid$(t(Val(s)), Index + 1, 1) & ".gif")
  PrintText p(Index), sCaption(Index)
  'no events
  Label1 = ""
 ElseIf GetCapture() <> p(Index).hWnd Then
  'mouseenter
  SetCapture p(Index).hWnd
  'set mousemove image
  p(Index).Picture = LoadPicture("imgo" & d2h(s) & Mid$(t(Val(s)), Index + 1, 1) & ".gif")
  'print text again because button image is changed
  PrintText p(Index), sCaption(Index)
  'event mouseover button
  Label1 = sCaption(Index) & " over"
 End If
End Sub

Private Sub p_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
 'restore mouveover image button and normal text
 p(Index).Picture = LoadPicture("imgo" & d2h(s) & p(Index).Tag & ".gif")
 PrintText p(Index), sCaption(Index)
End Sub

Private Sub PrintText(C As PictureBox, txt As String, Optional tb As Boolean = False)
Dim x1 As Long, y1 As Long
'set button text
 C.FontBold = False
 x1 = C.TextWidth(txt)
 y1 = C.TextHeight(txt)
 'positionin text on cener middle of button
 C.CurrentX = C.Width \ 2 - x1 \ 2 + Abs(tb) 'tb simulate button down and if true move text 1 pixel on right
 C.CurrentY = C.Height \ 2 - y1 \ 2 + Abs(tb) ' one pixel down
 'print button text
 C.Print txt;
End Sub

Private Sub ChangeSkin()
Dim i As Integer
'select one-by-one all the buttons and is setting
 For i = p.lbound To p.UBound
  'button caption
  sCaption(i) = Combo1.List(s) & "_" & i + 1
  'button picture
  p(i).Picture = LoadPicture("imgn" & d2h(s) & Mid$(t(s), i + 1, 1) & ".gif")
   'get main button color and set form background with this color
   If i = 0 Then Me.BackColor = GetPixel(p(0).hDC, 50, 15)
  'set buttons background same as form background in case button picture using transparent color
  p(i).BackColor = Me.BackColor
  'set button forecolor
  p(i).ForeColor = CptColor(Me.BackColor)
  'finally print the button text
  PrintText p(i), sCaption(i)
 Next i
 'set form forecolor as buttons forecolor
 Me.ForeColor = p(0).ForeColor
 'set other objects background and foreground color
 Label1.ForeColor = p(0).ForeColor
 Option1(0).ForeColor = p(0).ForeColor
 Option1(1).ForeColor = p(0).ForeColor
 Option1(0).BackColor = Me.BackColor
 Option1(1).BackColor = Me.BackColor
End Sub

Private Function d2h(n As Integer) As String
 'convert from decimal to two digit hex
 d2h = Hex$(n)
 If Len(d2h) = 1 Then d2h = "0" & d2h
End Function

Private Function CptColor(ByVal lColor As Long) As Long
 'convert color on grayscale
 lColor = 0.33 * (lColor Mod 256) + 0.59 * ((lColor \ 256) Mod 256) _
        + 0.11 * ((lColor \ 65536) Mod 256)
 'if grayscale is dark then CptColor is white else is black
 If lColor < 128 Then CptColor = &HFFFFFF Else lColor = &H0&
End Function

Private Sub CreateButtons(indice As Integer)
Dim i As Integer
'reset all buttons
ChangeSkin
' positioning buttons on form
Select Case indice
 Case 0 ' Horizontal bar
  For i = 1 To 4
   p(i).Move p(0).Left + p(0).Width * i, p(0).Top, p(0).Width, p(0).Height
  Next i
 Case 1 ' vertical menu
  For i = 1 To 4
   p(i).Move p(0).Left, p(0).Top + p(0).Height * i, p(0).Width, p(0).Height
  Next i
 Case Else 'do nothing
End Select
End Sub
************************************************************************************
End of source code of frmGraphicalButton.frm
************************************************************************************

************************************************************************************
Source code of GraphicalButton.vbw
************************************************************************************
frmGraphicalButton = 44, 44, 800, 535, Z, 22, 22, 778, 513, C
************************************************************************************
End of source code of GraphicalButton.vbw
************************************************************************************

Télécharger le zip

25 août 2008 12:13:03 :

Source code added as requested