Vista/Win 7 Gadgets Styles

[Deluxe0321]

Habe mich gerade dank Langeweile etwas mit den Controls (Gadgets) und deren Styles
beschäftigt, dabei ist ein kleines Testprogramm rausgekommen.
Das Programm muss in Unicode-Modus kompiliert werden, hatte keine Lust das entsprechend abzufangen.
Viel Spaß & Grüße

Code: Alles auswählen

; Vista Gadgets Test
; UNICODE must be enabled!!!!

;- Style Constants
#BCN_SETDROPDOWNSTATE = $1606
#BCM_SETNOTE = $00001609

#BS_SPLITBUTTON =  $0000000C
#BS_COMMANDLINK  = $0000000E

#BM_SETIMAGE = $F7 
#EM_SETCUEBANNER = $1501
#LVS_EX_DOUBLEBUFFER = $00010000

;- Window Constants
;
Enumeration
  #Window
EndEnumeration

;- Gadget Constants
;
Enumeration
  #ListIcon
  #Frame3D_0
  #LIView
  #LIStyle
  #prog
  #progchange
  #input
  #Button_1
  #Button_2
  #Button_3
EndEnumeration

If OpenLibrary(0,"uxtheme.dll")
  Global *WindowTheme = GetFunction(0, "SetWindowTheme")
Else
  Debug "ERROR"
EndIf 

Procedure Open_Window()
  If OpenWindow(#Window, 289, 225, 549, 421, "Gimme Vista/Win 7",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
      ListIconGadget(#ListIcon, 15, 15, 335, 205, "Column0", 100)
      AddGadgetColumn(#ListIcon, 1, "Column1", 100)
      AddGadgetColumn(#ListIcon, 2, "Column2", 100)
      Frame3DGadget(#Frame3D_0, 365, 15, 170, 205, "ListIconStyle")
      ButtonGadget(#LIView, 375, 40, 150, 30, "View",#BS_SPLITBUTTON)
      ButtonGadget(#LIStyle, 375, 85, 150, 30, "Style/Additonal",#BS_SPLITBUTTON)
      ProgressBarGadget(#prog, 15, 235, 335, 30, 0, 100)
      ButtonGadget(#progchange, 365, 235, 170, 30, "Change me",#BS_SPLITBUTTON)
      StringGadget(#input, 15, 285, 190, 20, "")
      ButtonGadget(#Button_1, 15, 330, 160, 75, "Button 1",#BS_COMMANDLINK) 
      ButtonGadget(#Button_2, 195, 330, 160, 75, "COMMANDLINK!!",#BS_COMMANDLINK)
      ButtonGadget(#Button_3, 375, 330, 160, 75, "Click!",#BS_COMMANDLINK)
  EndIf
  
  For a=0 To 40
    AddGadgetItem(#ListIcon,a,"Item "+Str(a)+Chr(10)+  "Item "+Str(a)+Chr(10)+"Item "+Str(a)+Chr(10))
  Next
  
  If CreatePopupMenu(0)
    MenuItem(0, "Report")
    MenuItem(1, "LargeIcon")
    MenuItem(2, "SmallIcon")
    MenuItem(3, "List")
  EndIf

  If CreatePopupMenu(1)
    MenuItem(4, "Explorer Style")
    MenuItem(5, "Semie Trans Select")
  EndIf
  
    If CreatePopupMenu(2)
    MenuItem(6, "Normal")
    MenuItem(7, "Pause")
    MenuItem(8, "Error/Waiting")
  EndIf
  
  
  ; Cue TextBoxes
  ; no flag, but #EM_SETCUEBANNER @ Sendmessage
  SendMessage_(GadgetID(#input), #EM_SETCUEBANNER, 0, @"Please type in something.");
  
  ; Commandlink Buttons
  ; #BS_COMMANDLINK flag @ Button
  ; Set "Note" with #BCM_SETNOTE @ Sendmessage
  Chr10Test.s = "Trololololololol"+Chr(10)+"hahahaha"
  SendMessage_(GadgetID(#Button_1),#BCM_SETNOTE,#Null,@"This is a Note ;)")
  SendMessage_(GadgetID(#Button_2),#BCM_SETNOTE,#Null,@Chr10Test.s)
  SendMessage_(GadgetID(#Button_3),#BCM_SETNOTE,#Null,@"Click here to see the Content of #Input!")
  
  ;Icons
  Img1.i = LoadImage(0, #PB_Compiler_Home + "Examples\Sources - Advanced\MoviePlayer\Icons\About.ico")
  Img2.i = LoadImage(1, #PB_Compiler_Home + "Examples\Sources - Advanced\MoviePlayer\Icons\Play.ico")
  SendMessage_(GadgetID(#Button_2), #BM_SETIMAGE, 1, Img1.i);
  SendMessage_(GadgetID(#Button_3), #BM_SETIMAGE, 1, Img2.i);
  
EndProcedure

Open_Window()

Repeat 
 
  Event = WaitWindowEvent()
  GadgetID = EventGadget() 
  EventMenu = EventMenu()
  
  If Random(100) % 2
    SetGadgetState(#prog,a) : a+1 : If a=100 : a=0 : EndIf  
  EndIf
  
  If Event = #PB_Event_Menu
    If EventMenu = 0
      SetGadgetAttribute(#ListIcon, #PB_ListIcon_DisplayMode,#PB_ListIcon_Report)
    ElseIf EventMenu = 1
      SetGadgetAttribute(#ListIcon, #PB_ListIcon_DisplayMode,#PB_ListIcon_LargeIcon)
    ElseIf EventMenu = 2
      SetGadgetAttribute(#ListIcon, #PB_ListIcon_DisplayMode,#PB_ListIcon_SmallIcon)
    ElseIf EventMenu = 3
      SetGadgetAttribute(#ListIcon, #PB_ListIcon_DisplayMode,#PB_ListIcon_List)  
    ElseIf EventMenu = 4
      CallFunctionFast(*WindowTheme, GadgetID(#ListIcon), @"explorer", #Null)
    ElseIf EventMenu = 5
      SendMessage_(GadgetID(#ListIcon), $1000 + 54, $00010000, $00010000);
    ElseIf EventMenu = 6 
      SendMessage_(GadgetID(#prog), $400 + 16, $0001, 0)
    ElseIf EventMenu = 7
      SendMessage_(GadgetID(#prog), $400 + 16, $0003, 0)
    ElseIf EventMenu = 8
      SendMessage_(GadgetID(#prog), $400 + 16, $0002, 0)
    EndIf  
      
  EndIf
  
  If Event = #PB_Event_Gadget
      
    If GadgetID = #LIView
      DisplayPopupMenu(0, WindowID(0))
    ElseIf GadgetID = #LIStyle
      DisplayPopupMenu(1, WindowID(0))
    ElseIf GadgetID = #progchange
      DisplayPopupMenu(2, WindowID(0))
    ElseIf GadgetID = #Button_1 Or GadgetID = #Button_2 Or GadgetID = #Button_3
      MessageRequester("InputCont","Content of Stringgadget: "+Chr(10)+GetGadgetText(#input)) : SetGadgetText(#input,"")
    EndIf
    
  EndIf
  
Until Event = #PB_Event_CloseWindow
End

[STARGÅTE]

*Kopf kratz*


Sieht irgendwie nicht wie Vista aus

[Deluxe0321]

hehe, vll hätte ich dazuschreiben sollen das bei so wenig Code wohl keine Emulation stattfindet.
Kurz: Die Effekte bekommste auch nur unter Vista/Windows 7
Aber mal sehn, ist bestimmt interessant das unter XP und co. umzusetzten.

[X0r]

Was gibtsn da noch schönes?

[alen]

Hallo,

das Sieht bei mir genau so wenig nach Vista / Win7 aus wie beim Screenshot von STARGÅTE.
Meine Komponenten:

Windows 7 (64Bit)
Purebasic 4.50 (32Bit Compiler)

Grüße
Alen

[a14xerus]

es geht sich nur um die kleinen zugaben wie die dropdownpfeile, die großen buttons mit dme grünen pfeil nach rechts, andersfarbiger fortschirttsbalken etc
es wird keinesfalls das aero glas theme emuliert wenn es nicht sowieso aktiviert ist.

wäre das der fall würden auch direkt alle wieder rumheulen das die das ja garnich wollen, weil die ja extra ihren alten win98 skin an haben und auch wollen das die anwendungen sich dadran halten

[DarkDragon]

XP Skin muss an sein, sonst sieht es auf Windows 7 mit angeschaltetem Aero immernoch nach Windows 98 aus.