[Code mise à jour le 16/02/15 à 13h22 avec la correction de la procédure GetDimensionText, ci-dessous par
Code : Tout sélectionner
UsePNGImageDecoder()
Procedure.l SetLayeredWindow(WindowID) ; Mettre l'attribut WS_EX_LAYERED à la fenêtre
SetWindowLong_(WindowID, #GWL_EXSTYLE, GetWindowLong_(WindowID, #GWL_EXSTYLE) | #WS_EX_LAYERED) ; Mettre l'attribut WS_EX_LAYERED à la fenêtre
EndProcedure
Procedure.l AlphaImageWindow(WindowID, ImageID) ; Mettre une image PNG comme fond d'une fenêtre
Protected Image_HDC.i, Image_Bitmap.BITMAP, Image_BitmapInfo.BITMAPINFO, ContextOffset.POINT, Blend.BLENDFUNCTION
Protected Image_Ancienne.i ,xx, yy, x, y, Rouge.l, Vert.l, Bleu.l, AlphaChannel.l
; Précalcul
Protected Dim Echelle.f($FF)
For x = 0 To $FF
Echelle(x) = x / $FF
Next
; Chargement du HDC
Image_HDC = CreateCompatibleDC_(#Null)
Image_Ancienne = SelectObject_(Image_HDC, ImageID)
; Dimension de l'image
GetObject_(ImageID, SizeOf(BITMAP), @Image_Bitmap)
Image_BitmapInfo\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
Image_BitmapInfo\bmiHeader\biWidth = Image_Bitmap\bmWidth
Image_BitmapInfo\bmiHeader\biHeight = Image_Bitmap\bmHeight
Image_BitmapInfo\bmiHeader\biPlanes = 1
Image_BitmapInfo\bmiHeader\biBitCount = 32
; Zone mémoire pour copier l'image
xx = Image_Bitmap\bmWidth - 1
yy = Image_Bitmap\bmHeight - 1
Protected Dim Image.l(xx, yy)
; Copie de l'image en mémoire
GetDIBits_(Image_HDC, ImageID, 0, Image_Bitmap\bmHeight, @Image(), @Image_BitmapInfo, #DIB_RGB_COLORS)
; Modification de l'image en mémoire
For x = 0 To xx
For y = 0 To yy
Couleur = Image(x, y)
AlphaChannel = Couleur >> 24 & $FF
If AlphaChannel < $FF
Rouge = (Couleur & $FF) * Echelle(AlphaChannel)
Vert = (Couleur >> 8 & $FF) * Echelle(AlphaChannel)
Bleu = (Couleur >> 16 & $FF) * Echelle(AlphaChannel)
Image(x, y) = Rouge | Vert << 8 | Bleu << 16 | AlphaChannel << 24
EndIf
Next
Next
; Transfert de la mémoire dans la l'image de base
SetDIBits_(Image_HDC, ImageID, 0, Image_Bitmap\bmHeight, @Image(), @Image_BitmapInfo, #DIB_RGB_COLORS)
; L'image est mise en skin de la fenêtre
Blend\SourceConstantAlpha = 255 ; niveau de transparence
Blend\AlphaFormat = 1 ; Support de la couche alpha
Blend\BlendOp = 0
Blend\BlendFlags = 0
UpdateLayeredWindow_(WindowID, 0, 0, @Image_BitmapInfo + 4, Image_HDC, @ContextOffset, 0, @Blend, 2)
; Fermeture du HDC
SelectObject_(Image_HDC, Image_Ancienne)
DeleteDC_(Image_HDC)
EndProcedure
Procedure.l GetDimensionText(Text.s, FontID.l, *Width.Long, *Height.Long)
Protected Image.l, Res.l = 0, CountText.l
Protected MaxLine.s, Line.s, MaxLen.l, Len.l, a.l
CountText = CountString(Text, Chr(13))
For a= 1 To CountText + 1
Line = StringField(Text, a, Chr(13))
Len = Len(Line)
If MaxLen < Len
MaxLen = Len
MaxLine = Line
EndIf
Next a
Image = CreateImage(#PB_Any, 100, 100)
If Image
If StartDrawing(ImageOutput(Image))
DrawingFont(FontID(FontID))
*Width\l = TextWidth(MaxLine)
*Height\l = TextHeight(MaxLine)
StopDrawing()
EndIf
FreeImage(Image)
EndIf
If *Width\l <> 0 And *Height\l <> 0
*Height\l = *Height\l * (CountText + 1)
Res = 1
EndIf
ProcedureReturn Res
EndProcedure
Procedure.l CreateText(Width.l, Height.l, Text.s, TextColor=$000000, TextFontID=#PB_Default)
Protected Image.l, CountText.l, Line.s, MoveHeight.l = 0
CountText = CountString(Text, Chr(13))
Image = CreateImage(#PB_Any, Width, Height, 32 , #PB_Image_Transparent)
If Image
If StartDrawing(ImageOutput(Image))
DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Transparent)
DrawingFont(FontID(TextFontID))
For a = 1 To CountText +1
Line = StringField(Text, a, Chr(13))
DrawText((Width - TextWidth(Line))/2, MoveHeight, Line, TextColor | $FF000000)
MoveHeight = MoveHeight + TextHeight(Line)
Next a
StopDrawing()
EndIf
EndIf
ProcedureReturn Image
EndProcedure
Procedure.l CreateTextWithImage(Image.l, Text.s, HeightPosition.l, TextColor=$000000, TextFontID=#PB_Default)
Protected CountText.l, Line.s, MoveHeight.l = 0
CountText = CountString(Text, Chr(13))
If StartDrawing(ImageOutput(Image))
DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Transparent)
DrawingFont(FontID(TextFontID))
For a = 1 To CountText +1
Line = StringField(Text, a, Chr(13))
DrawText((ImageWidth(Image) - TextWidth(Line)) / 2, HeightPosition + MoveHeight, Line, TextColor | $FF000000)
MoveHeight = MoveHeight + TextHeight(Line)
Next a
StopDrawing()
Else
Image = 0
EndIf
ProcedureReturn Image
EndProcedure
;----------------------------------------------------------------------------------
; PARAMETRES
;----------------------------------------------------------------------------------
Texte.s = "PureBasic" + Chr(13) + "by" + Chr(13) + "Nico" ; Chr(13) = Retour chariot Cr (nouvelle ligne)
LoadFont (0, "Arial", 18)
TextColor = RGB(0,0,255)
Xpos = 9999 ; 9999 = Centré | Droite = toute valeur supérieur à la largeur du bureau (ex: 8888)
Ypos = 9999 ; 9999 = Centré | Bas = toute valeur supérieur à la hauteur du bureau (ex: 8888)
Delai = 10 ; en seconde(s) | 0 = illimité
HideOnTaskBar = 1 ; 0 = false | 1 = true
;----------------------------------------------------------------------------------
; Essayer l'une ou l'autre des options
;----------------------------------------------------------------------------------
If GetDimensionText(Texte, 0, @Width, @Height)
Image = CreateText(Width, Height, Texte, TextColor, 0)
EndIf
;----------------------------------------------------------------------------------
; Si vous décochez ce qui suit, pensez à cocher les 3 lignes de code précédentes
;----------------------------------------------------------------------------------
; If LoadImage(1, "C:\ votre image avec canal alpha")
; Image = CreateTextWithImage(1, Texte, 40, TextColor, 0)
; EndIf
;----------------------------------------------------------------------------------
; Position
ExamineDesktops()
If Xpos = 9999
Xpos = (DesktopWidth(0) / 2) - (ImageWidth(Image) / 2)
Else
If Xpos > DesktopWidth(0)- ImageWidth(Image) : Xpos = DesktopWidth(0)- ImageWidth(Image) : EndIf
EndIf
If Ypos = 9999
Ypos = (DesktopHeight(0) / 2) - (ImageHeight(Image) / 2)
Else
If Ypos > DesktopHeight(0)- ImageHeight(Image) : Ypos = DesktopHeight(0)- ImageHeight(Image) : EndIf
EndIf
; Cacher sur la barre des tâches
If HideOnTaskBar = 0
Option = #PB_Window_BorderLess
Else
Option = PB_Window_BorderLess | #PB_Window_Tool
EndIf
If OpenWindow(0, Xpos, Ypos, ImageWidth(Image), ImageHeight(Image), "", Option)
AddKeyboardShortcut(0, #PB_Shortcut_Escape, 1) ; Escape pour quitter (Alt+F4) génère un évènement de type #PB_Event_Menu
SetLayeredWindow(WindowID(0))
If Image
AlphaImageWindow(WindowID(0), ImageID(Image))
EndIf
StickyWindow(0, 1)
NbDelai = 0
Repeat
Event = WindowEvent()
Select Event
Case #WM_LBUTTONDOWN
SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
Case #PB_Event_CloseWindow
Quit = 1
Case #PB_Event_Menu ; AddKeyboardShortcut Escape
Quit = 1
EndSelect
Delay(100)
NbDelai + 1
If Delai <> 0 And NbDelai/10 > Delai
Quit = 1
EndIf
Until Quit = 1
EndIf
), dans Windows 8.1 (je n'ai pas le souci avec Win7) il faut Lancer le Shell (Explorer) avec ce compte