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 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
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 Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Const RGN_OR = 2
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Global sknRectBack As String
Global sknColors(0 To 6) As Long
Global hndLongueur(1 To 3) As Double
Global ActualSkin As String
'Ciseler la feuille selon le canal alpha
Public Sub Chisel(hwnd As Long, picSource As PictureBox, lngTransColor As Variant)
rFinal = CreateRectRgn(0, 0, 0, 0)
lHeight = picSource.Height / Screen.TwipsPerPixelY
lWidth = picSource.Width / Screen.TwipsPerPixelX
For Y = 0 To lHeight - 1
X = 0
Do While X < lWidth
Do While X < lWidth And GetPixel(picSource.hdc, X, Y) = lngTransColor
X = X + 1
Loop
If X < lWidth Then
lStart = X
Do While X < lWidth And GetPixel(picSource.hdc, X, Y) <> lngTransColor
X = X + 1
Loop
If X > lWidth Then X = lWidth
rTmp = CreateRectRgn(lStart, Y, X, Y + 1)
r = CombineRgn(rFinal, rFinal, rTmp, RGN_OR)
DeleteObject (rTmp)
End If
Loop
Next
r = SetWindowRgn(hwnd, rFinal, True)
End Sub
Function ReadINI(INIFile As String, Entete As String, Variable As String) As String
Dim Retour As String
Retour = String(255, Chr(0))
ReadINI = Left$(Retour, GetPrivateProfileString(Entete, ByVal Variable, "", Retour, Len(Retour), INIFile))
End Function
Function WriteINI(INIFile As String, Entete As String, Variable As String, Valeur As String)
WriteINI = WritePrivateProfileString(Entete, Variable, Valeur, INIFile)
End Function
Function CnvPath(strPath As String) As String
CnvPath = strPath & IIf(Right(CnvPath, 1) = "\", "", "\")
End Function
'Appliquer le skin a l'ensemble du programme
Public Sub ApplySkin(SkinID As String)
On Error GoTo lblErr
sknPath = CnvPath(App.Path) & "Skins\" & SkinID & "\"
With Main
.Picture = LoadPicture(sknPath & ReadINI(sknPath & "config.ini", "images", "imgMain"))
.picPalette = LoadPicture(sknPath & ReadINI(sknPath & "config.ini", "images", "imgPalette"))
For i = 0 To 6
sknColors(i) = GetPixel(.picPalette.hdc, i, 0)
Next
.picAlpha = LoadPicture(sknPath & ReadINI(sknPath & "config.ini", "images", "imgAlpha"))
.lstMenu.ListImages.Clear
For i = 1 To 3
.lstMenu.ListImages.Add .lstMenu.ListImages.Count + 1, "", LoadPicture(sknPath & ReadINI(sknPath & "config.ini", "images", "btn" & i) & "_0.gif")
.lstMenu.ListImages.Add .lstMenu.ListImages.Count + 1, "", LoadPicture(sknPath & ReadINI(sknPath & "config.ini", "images", "btn" & i) & "_1.gif")
.cmdMenu(i) = .lstMenu.ListImages(i * 2 - 1).Picture
.cmdMenu(i).Left = ReadINI(sknPath & "config.ini", "general", "btn" & i & "left") * Screen.TwipsPerPixelX
.cmdMenu(i).Top = ReadINI(sknPath & "config.ini", "general", "btn" & i & "top") * Screen.TwipsPerPixelY
Next
.picCadran = LoadPicture(sknPath & ReadINI(sknPath & "config.ini", "images", "imgCadran"))
.picCadran.Left = ReadINI(sknPath & "config.ini", "cadran", "left") * Screen.TwipsPerPixelX
.picCadran.Top = ReadINI(sknPath & "config.ini", "cadran", "top") * Screen.TwipsPerPixelY
For i = 1 To 3
.lneAiguille(i).BorderColor = ReadINI(sknPath & "config.ini", "cadran", "color" & i)
hndLongueur(i) = ReadINI(sknPath & "config.ini", "cadran", "len" & i)
Next
.picRectBack = LoadPicture(sknPath & ReadINI(sknPath & "config.ini", "images", "imgRectBack"))
.Width = .picAlpha.Width
.Height = .picAlpha.Height
Chisel .hwnd, .picAlpha, sknColors(0)
End With
ApplyColors sknColors(4), sknColors(5), sknColors(6)
Agenda.Picture = Main.picRectBack
Alarme.Picture = Main.picRectBack
AlarmeAlert.Picture = Main.picRectBack
AlarmeInfo.Picture = Main.picRectBack
AlarmeMedia.Picture = Main.picRectBack
AlarmeMsg.Picture = Main.picRectBack
MesureTemps.Picture = Main.picRectBack
SetTime.Picture = Main.picRectBack
For i = 1 To 3
Reglage.cdrPanel(i) = Main.picRectBack
Next
ActualSkin = SkinID
WriteINI CnvPath(App.Path) & "config.ini", "general", "skinID", SkinID
Exit Sub
lblErr:
MsgBox "Une erreur a eu lieu lors du chargement du skin " & SkinID & " !!!", vbCritical
End
End Sub
'Appliquer les couleurs du skin à TOUS les controles
Sub ApplyColors(Color1, Color2, Color3)
With Agenda
.lbl(0).ForeColor = Color1
.lbl(1).ForeColor = Color1
.lblSaints.ForeColor = Color1
.lblPosition.ForeColor = Color1
.lblZodiac.ForeColor = Color1
.lblDate.ForeColor = Color1
.cdrInfos.BackColor = Color2
.lblDate.BackColor = Color3
.picZodiac.BackColor = Color3
.lblPosition.BackColor = Color3
End With
With Alarme
For i = 0 To 7
.lbl(i).ForeColor = Color1
Next
.lstAlarmes.ForeColor = Color1
.lstActions.ForeColor = Color1
.cdrAdd.BackColor = Color2
For i = 0 To 2
.lstDate(i).ForeColor = Color1
.lstTime(i).ForeColor = Color1
.lstDate(i).BackColor = Color3
.lstTime(i).BackColor = Color3
.lne(i).BorderColor = Color1
Next
.txtTitre.BackColor = Color3
.lstAlarmes.BackColor = Color3
.lstActions.BackColor = Color3
End With
With AlarmeAlert
.lbl.ForeColor = Color1
.txtMsg.ForeColor = Color1
.txtMsg.BackColor = Color2
End With
With AlarmeInfo
For i = 0 To 4
.lbl(i).ForeColor = Color1
Next
.lstActions.ForeColor = Color1
.lblTitre.ForeColor = Color1
.lblDate.ForeColor = Color1
.lblTime.ForeColor = Color1
.lblDescr.ForeColor = Color1
.txtContents.ForeColor = Color1
.lstActions.BackColor = Color2
.cdrMore.BackColor = Color2
.txtContents.BackColor = Color3
End With
With AlarmeMedia
.lbl(0).ForeColor = Color1
.lbl(1).ForeColor = Color1
.lblTitre.ForeColor = Color1
.picProgress2.BackColor = Color1
.picProgress.BackColor = Color2
End With
With AlarmeMsg
.lbl.ForeColor = Color1
.txtMsg.ForeColor = Color1
.txtMsg.BackColor = Color2
End With
With MesureTemps
For i = 0 To 2
.lstTime(i).ForeColor = Color1
.lstTime(i).BackColor = Color3
Next
.lbl.ForeColor = Color1
.lstFonctions.ForeColor = Color1
.lstInterm.ForeColor = Color1
.lblMesure.ForeColor = Color1
.lblSep1.ForeColor = Color1
.lblSep2.ForeColor = Color1
.lstFonctions.BackColor = Color3
.lstInterm.BackColor = Color3
End With
With Reglage
For i = 0 To 3
.lbl(i).ForeColor = Color1
Next
.lne.BorderColor = Color1
.lstStyles.ForeColor = Color1
.lstSkins.ForeColor = Color1
.lstTools.ForeColor = Color1
.lblSkin.ForeColor = Color1
.chkRun.ForeColor = Color1
.lblSkin.BackColor = Color2
.lstSkins.BackColor = Color2
.lstTools.BackColor = Color2
.chkRun.BackColor = Color3
.lstStyles.BackColor = Color3
End With
With SetTime
For i = 0 To 6
.lbl(i).ForeColor = Color1
Next
For i = 0 To 2
.lstDate(i).ForeColor = Color1
.lstTime(i).ForeColor = Color1
.lstDate(i).BackColor = Color3
.lstTime(i).BackColor = Color3
Next
.lne.BorderColor = Color1
End With
End Sub
