CD Autorun example

[oridan]

Here a small CD Autorun.

Code: Select all

; ------------------------------------------------------------------
;
;   CD Autorun
;   Version: 1.0  
;   PureBasic Version: 3.94
;
;   Author: Oridan
;   Date: 24/06/2006
;
; ------------------------------------------------------------------
;
;- Get Current Directory
CurrentDirectory$=Space(255)
GetCurrentDirectory_(255,@CurrentDirectory$)
 If Right(CurrentDirectory$,1)<>"\":CurrentDirectory$+"\":EndIf
 
InitSound()

CatchSound(0,?IB1)
CatchSound(1,?IB3)

;- Fonts
Global FontID1
FontID1 = LoadFont(1, "Tahoma", 8)
;- Image Plugins

;- Image Globals
Global Image0

;- Catch Images
Image0 = CatchImage(0, ?Image0)

;- Images
DataSection
Image0:
  IncludeBinary "BackGround.bmp"
EndDataSection

Procedure HotSpot() 
Shared Cursor, Sound
  Select ChildWindowFromPoint_(WindowID(0),WindowMouseX(),WindowMouseY()) 
    Case GadgetID(2) 
      SetCursor_(Cursor)
      If Sound = 1
         StopSound(1)
      Else
         PlaySound(1,0)
         Sound = 1
      EndIf
    Case GadgetID(3) 
      SetCursor_(Cursor)   
      If Sound = 1
         StopSound(1)
      Else
         PlaySound(1,0)
         Sound = 1
      EndIf            
    Case GadgetID(4) 
      SetCursor_(Cursor)
      If Sound = 1
         StopSound(1)
      Else
         PlaySound(1,0)
         Sound = 1
      EndIf      
    Case GadgetID(1)
      Sound = 0
  EndSelect 
EndProcedure

Procedure WindowMain()
  If OpenWindow(0, 333, 135, 506, 286,  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered , "Nero Burning ROM 7.2.0.3b - [ CD Autorun by Oridan ]")
   ;SetWindowPos_(WindowID(),#HWND_TOPMOST,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE)   
    If CreateGadgetList(WindowID())    
      ButtonGadget(2, 20, 180, 240, 25, "Install Nero Burning ROM 7.2.0.3b")
      SetGadgetFont(2, FontID1)
      ButtonGadget(3, 20, 215, 240, 25, "Browse CD...")
      SetGadgetFont(3, FontID1)      
      ButtonGadget(4, 20, 250, 240, 25, "Exit")
      SetGadgetFont(4, FontID1)
      ImageGadget(1, 0, 0, 492, 286, Image0)
      SetWindowLong_(GadgetID(1), #GWL_STYLE, GetWindowLong_(GadgetID(1), #GWL_STYLE) | #WS_CLIPSIBLINGS)
    EndIf     
  EndIf
      
    
EndProcedure

Cursor = LoadCursor_(0, #IDC_HAND)
WindowMain()
      
Repeat
  Stop:
  
  Event = WaitWindowEvent()  
  WindowID = EventWindowID()  
  GadgetID = EventGadgetID()  
  EventType = EventType()  
  
  HotSpot()
  
  If Event = #PB_EventGadget     
      
    If GadgetID = 2
      PlaySound(0,0)
      If RunProgram(CurrentDirectory$+"YourFolder\YourProgram.exe","","",0) ; Run EXE
      Else
        Goto Stop
      EndIf       
    EndIf
      
    If GadgetID = 3
      RunProgram(CurrentDirectory$,"","",0) ; Browse CD...
      PlaySound(0,0)
    EndIf
      
    If GadgetID = 4 ; Exit
      PlaySound(0,0)
      End  
    EndIf
    
  EndIf
  
Until Event = #PB_Event_CloseWindow
  PlaySound(0,0)
  DestroyCursor_(Cursor)
End

;- Include sound file binary
IB1: 
  IncludeBinary "click.wav"
IB2:
IB3: 
  IncludeBinary "over.wav"
IB4:

Source code + image here: DOWNLOAD

Regards

[NoahPhense]

Nice.. How about a 4.0 example..

- np

[utopiomania]

Yes it's nice, thanks for the contribution! Here's a 4.0 translation:

Code: Select all

; ------------------------------------------------------------------
;
;   CD Autorun
;   Version: 1.0  
;
;   Author: Oridan
;   Date: 24/06/2006
;
; ------------------------------------------------------------------
;
;- Get Current Directory
CurrentDirectory$=Space(255)
GetCurrentDirectory_(255,@CurrentDirectory$)
 If Right(CurrentDirectory$,1)<>"\":CurrentDirectory$+"\":EndIf
 
InitSound()

CatchSound(0,?IB1)
CatchSound(1,?IB3)

;- Fonts
Global FontID1
FontID1 = LoadFont(1, "Tahoma", 8)
;- Image Plugins

;- Image Globals
Global Image0

;- Catch Images
Image0 = CatchImage(0, ?Image0)

;- Images
DataSection
Image0:
  IncludeBinary "BackGround.bmp"
EndDataSection

Procedure HotSpot() 
Shared Cursor, Sound
  Select ChildWindowFromPoint_(WindowID(0),WindowMouseX(0),WindowMouseY(0)) 
    Case GadgetID(2) 
      SetCursor_(Cursor)
      If Sound = 1
         StopSound(1)
      Else
         PlaySound(1,0)
         Sound = 1
      EndIf
    Case GadgetID(3) 
      SetCursor_(Cursor)   
      If Sound = 1
         StopSound(1)
      Else
         PlaySound(1,0)
         Sound = 1
      EndIf            
    Case GadgetID(4) 
      SetCursor_(Cursor)
      If Sound = 1
         StopSound(1)
      Else
         PlaySound(1,0)
         Sound = 1
      EndIf      
    Case GadgetID(1)
      Sound = 0
  EndSelect 
EndProcedure

Procedure WindowMain()
  If OpenWindow(0, 333, 135, 506, 286, "Nero Burning ROM 7.2.0.3b - [ CD Autorun by Oridan ]",  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
   ;SetWindowPos_(WindowID(),#HWND_TOPMOST,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE)   
    If CreateGadgetList(WindowID(0))    
      ButtonGadget(2, 20, 180, 240, 25, "Install Nero Burning ROM 7.2.0.3b")
      SetGadgetFont(2, FontID1)
      ButtonGadget(3, 20, 215, 240, 25, "Browse CD...")
      SetGadgetFont(3, FontID1)      
      ButtonGadget(4, 20, 250, 240, 25, "Exit")
      SetGadgetFont(4, FontID1)
      ImageGadget(1, 0, 0, 492, 286, Image0)
      SetWindowLong_(GadgetID(1), #GWL_STYLE, GetWindowLong_(GadgetID(1), #GWL_STYLE) | #WS_CLIPSIBLINGS)
    EndIf     
  EndIf
EndProcedure

Cursor = LoadCursor_(0, #IDC_HAND)
WindowMain()
      
Repeat
  Stop:
  Event = WaitWindowEvent()  
  GadgetID = eventGadget()  
  HotSpot()
  If Event =  #PB_Event_Gadget     
    If GadgetId = 2
      PlaySound(0,0)
      If RunProgram(CurrentDirectory$+"YourFolder\YourProgram.exe","","",0) ; Run EXE
      Else
        Goto Stop
      EndIf       
    EndIf
    If GadgetId = 3
      RunProgram(CurrentDirectory$,"","",0) ; Browse CD...
      PlaySound(0,0)
    EndIf
    If GadgetID = 4 ; Exit
      PlaySound(0,0)
      End  
    EndIf
  EndIf
Until Event = #PB_Event_CloseWindow

[utopiomania]

Here's the rest of the code:

Code: Select all

PlaySound(0,0)
DestroyCursor_(Cursor)
End

;- Include sound file binary
IB1: 
  IncludeBinary "click.wav"
IB2:
IB3: 
  IncludeBinary "over.wav"
IB4:

If I try to post in one listing, I get an 'internal server error' from the forums!

[ts-soft]

Code: Select all

;- Get Current Directory
CurrentDirectory$=Space(255)
GetCurrentDirectory_(255,@CurrentDirectory$)
 If Right(CurrentDirectory$,1)<>"\":CurrentDirectory$+"\":EndIf 

Better this:

Code: Select all

CurrentDirectory$ = GetPathPart(ProgramFilename())

CD Path is not the CurrentDirectory at all!

[NoahPhense]

Thanks for the conversion. Found a bug.

When I click on browse.. then close the window that it opened..

The GUI of the autorun.. is missing the buttons until I roll the mouse
back over them.

- np

[utopiomania]

Sorry, my fault, I commented out the SetWindowLong_ .. to see what it was for.. The listing is updated.

[Michael Vogel]

Fine program thank you oridian.

I only added an additional key "Display Pictures" to make a dia show of all pictures of the CD...

But I've problems when allowing windows skins - there is a gray frame around the correctly skinned buttons - does anyone know how to eleminate this?

[netmaestro]

Hello Michael,

I think the way to accomplish that would be to tweak the code a bit so that instead of using an image gadget for the graphic, you set the window background to an image. Then, you can supply a patternbrush to use for a button background and process it in a callback:

Code: Select all

LoadImage(0,"c:\windows\web\wallpaper\bliss.bmp") 
GrabImage(0,1,200,200,200,25) 
Global hbr = CreatePatternBrush_(ImageID(0)) 
Global hbr2 = CreatePatternBrush_(ImageID(1)) 

Procedure WindowCallback(hWnd, message, wParam, lParam) 
  result = #PB_ProcessPureBasicEvents 
  Select message 
    Case #WM_CTLCOLORBTN 
      SetBkMode_(wParam, #TRANSPARENT) 
      result = hbr2 
  EndSelect 
  ProcedureReturn result 
EndProcedure 

OpenWindow(0,0,0,640,480,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu) 

SetClassLong_(WindowID(0),#GCL_HBRBACKGROUND, hbr) 
InvalidateRect_(WindowID(0),0,1) 

CreateGadgetList(WindowID(0)) 
ButtonGadget(0,200,200,200,20,"Button") 

SetWindowCallback(@WindowCallback()) 

Repeat 
  ev=WaitWindowEvent() 

Until ev=#WM_CLOSE

[Michael Vogel]

Hello Michael,
I think the way to accomplish that would be to tweak the code a bit so that instead of using an image gadget for the graphic, you set the window background to an image. Then, you can supply a patternbrush to use for a button background and process it in a callback: [...]

Thanks netmaestro, but something seems to make still problems (when the compiler option "allow windows skin" is enabled):

With the "old" code from oridan, I'll got the following result (even worse when you have rounded buttons):



Now I tried to use your nice code, but it makes also some interesting things:



Do you have an idea, why the dashed lines around the borders are seen?

Here's my full code:

Code: Select all

; Define
	EnableExplicit

	#WindowsTitle="Startprogramm"

	#Diashow=1
	#Program="Hotkey.exe"
	#Pictures="Todo\Bilder"; kein Backslash am Anfang aber am Ende!!!
	;#Pictures="Dokumente und Einstellungen\vo\Desktop\ \Medien"
	#JpgOnly=1

	#TextProgram="&Start Hotkey"
	#TextDiashow="&Display Pictures..."
	#TextBrowse="&Browse Stick..."
	#TextQuit="Exit"

	#KeyProgram=#PB_Shortcut_S
	#KeyDiashow=#PB_Shortcut_D
	#KeyBrowse=#PB_Shortcut_B
	#KeyQuit=#PB_Shortcut_E

	#ButtonLeft=30
	#ButtonWidth=200
	#ButtonBorder=15

	#MaxPicts=10000

	Global Dummy=GetDC_(0)
	;Global ScreenX=GetSystemMetrics_(#SM_CXSCREEN)
	;Global ScreenY=GetSystemMetrics_(#SM_CYSCREEN)
	Global ScreenX=GetDeviceCaps_(Dummy,#HORZRES)
	Global ScreenY=GetDeviceCaps_(Dummy,#VERTRES)
	Global ScreenZ=GetDeviceCaps_(Dummy,#BITSPIXEL)
	ReleaseDC_(0,Dummy)

	Global FrameSizeX=ScreenX*0.9;640
	Global FrameSizeY=ScreenY*0.94;540
	Global OtherSizeX=ScreenX
	Global OtherSizeY=ScreenY

	Structure PictStruct
		id.l
		x.l
		y.l
		w.l
		h.l
	EndStructure

	Global Dim Picture.PictStruct(1)
	Global Dim Names.s(#MaxPicts)

	Global MainPict; 0!
	Global BackPict
	Global TotalPict
	Global ActualPict
	Global WaitTimer
	Global quit
	Global i
	Global factor.f

	#MaxVarSpeed=7
	#MaxVarWait=7
	#DefaultWait=3
	#DefaultSpeed=4

	Global VarWait=#DefaultWait
	Global VarSpeed=#DefaultSpeed
	Global VarMode
	Global VarInfo
	Global VarRandom
	Global VarFullscreen

	Enumeration
		#ButtonProgram
		#ButtonDiashow
		#ButtonBrowse
		#ButtonQuit
		;#Progress
		#Image; 					Gadget und Imagenummer!
		#BlackBackground;	schwarzer Hintergrund
	EndEnumeration

	;CurrentDirectory$=Space(255)
	;GetCurrentDirectory_(255,@CurrentDirectory$)
	;If Right(CurrentDirectory$,1)<>"":CurrentDirectory$+"":EndIf
	;... besser so...
	Global CurrentDirectory.s=GetPathPart(ProgramFilename())

	InitSound()
	CatchSound(0,?IB1)
	CatchSound(1,?IB3)

	Global FontID0=LoadFont(0,"Verdana",8)
	;Global FontID1=LoadFont(1,"Tahoma",8)

	UseJPEGImageDecoder()
	Global ImageID=CatchImage(#Image,?Image)
	Global BrushID=CreatePatternBrush_(ImageID); ***

	Global WinID
	;Global GadgetID; ***

	Global Cursor=LoadCursor_(0,#IDC_HAND)
	Global DirectXPresent
	Global Sound

	CompilerIf #Diashow
		;UseJPEGImageDecoder()
		;UsePNGImageDecoder(); 80kByte !

		If (InitSprite() And InitSprite3D())
			DirectXPresent=#True
		EndIf

		OpenPreferences("Autorun.inf")
		PreferenceGroup("Show")
		VarMode=ReadPreferenceLong("Mode",0)
		VarFullscreen=ReadPreferenceLong("Full",0)
		VarInfo=ReadPreferenceLong("Info",0)
		VarRandom=ReadPreferenceLong("Cube",0)
		ClosePreferences()
	CompilerEndIf

	DataSection
		Image:
		IncludeBinary "Data\BackBitmap.jpg"
		IB1:
		IncludeBinary "Data\click.wav"
		IB3:
		IncludeBinary "Data\over.wav"
		SpeedTable:
		Data.l 1,3,5,15,17,51,85,255,-1
		WaitTable:
		Data.l 500,1000,2000,3000,5000,10000,20000,30000,-1
	EndDataSection

; EndDefine
Procedure.l FindVal(mem,val)
	Protected i=0
	Protected x
	Repeat
		x=PeekL(mem)
		Debug x
		If x=val
			ProcedureReturn i
		EndIf
		i+1
		mem+4
	Until x=-1
	ProcedureReturn -1
EndProcedure
Procedure CheckKeys()
	Repeat
		For Dummy=1 To 3
			If WaitWindowEvent(2)=#WM_CHAR
				Select EventwParam()
				Case 27,8,'Q'
					quit=999
				Case ' ',13
					quit=1
				Case '+'
					If VarSpeed<#MaxVarSpeed : VarSpeed+1 : EndIf
				Case '-'
					If VarSpeed>0 : VarSpeed-1 : EndIf
				Case 'f','F'; Faster
					If VarWait>0 : VarWait-1 : EndIf
					quit=1
				Case 's','S'; Slower
					If VarWait<#MaxVarWait : VarWait+1 : EndIf
				Case 'd','D'; Default
					VarWait=#DefaultWait
					VarSpeed=#DefaultSpeed
				Case 'i','I','?'; Info
					VarInfo=1-VarInfo
					quit=1
				Case 'm','M'; Mode
					VarMode=1-VarMode
				Case 'r','R'; Restart
					ActualPict=0
					quit=1
				Case 'n','N'; Next
					If ActualPict<TotalPict : ActualPict+1 : EndIf
					quit=2
				Case 'p','P'; Previous
					If ActualPict>1 : ActualPict-1 : EndIf
					quit=2
				Case '~'; Random
					VarRandom=1-VarRandom
				Case 's','S',9; Full-Screen mode
					VarFullscreen=1-VarFullscreen
					Swap FrameSizeX,OtherSizeX
					Swap FrameSizeY,OtherSizeY
					quit=2
				EndSelect
			EndIf
		Next Dummy
	Until (quit) Or (GetTickCount_()>WaitTimer)
EndProcedure
Procedure ScalePicture(n)

	If IsImage(n)=0
		CreateImage(n,32,32,#PB_Image_DisplayFormat)
	EndIf

	Picture(n)\w=ImageWidth(n)
	Picture(n)\h=ImageHeight(n)

	Dummy=#False
	If Picture(n)\w>FrameSizeX
		factor=FrameSizeX/Picture(n)\w
		Picture(n)\w*factor
		Picture(n)\h*factor
		Dummy=#True
	EndIf
	If Picture(n)\h>FrameSizeY
		factor.f=FrameSizeY/Picture(n)\h
		Picture(n)\w*factor
		Picture(n)\h*factor
		Dummy=#True
	EndIf

	If Dummy
		ResizeImage(n,Picture(n)\w,Picture(n)\h,#PB_Image_Smooth)
		;ResizeImage(n,Picture(n)\w,Picture(n)\h,#PB_Image_Raw)
	EndIf

	Picture(n)\id=ImageID(n)
	Picture(n)\x=(ScreenX-Picture(n)\w)>>1
	Picture(n)\y=(ScreenY-Picture(n)\h)>>1

	;If 0
	;	Debug picture(n)\x
	;	Debug picture(n)\y
	;	Debug picture(n)\w
	;	Debug picture(n)\h
	;EndIf

	If IsSprite(n) : FreeSprite(n) : EndIf
	CreateSprite(n,Picture(n)\w,Picture(n)\h,#PB_Sprite_Texture)
	StartDrawing(SpriteOutput(n))
	DrawImage(Picture(n)\id,0,0);,Picture(n)\w,Picture(n)\h); because Resize doesn't work
	StopDrawing()

	If IsSprite3D(n) : FreeSprite3D(n) : EndIf
	CreateSprite3D(n,n)

EndProcedure
Procedure SwapPictures()

	BackPict=MainPict
	MainPict=1-MainPict

	If IsImage(MainPict)
		FreeImage(MainPict)
		If quit=2; 											Next/Previous
			quit=0
		ElseIf VarRandom And (TotalPict>1);	Zufallsbild auswählen
			ActualPict=Random(TotalPict-1)+1
		ElseIf ActualPict<TotalPict;					normales Weiterblättern
			ActualPict+1
		Else;													und wieder von vorn
			ActualPict=1
		EndIf
	EndIf
	;Picture(MainPict)\n=ActualPict
	;Debug Names(ActualPict)

	LoadImage(MainPict,Names(ActualPict),#PB_Image_DisplayFormat)
	ScalePicture(MainPict)

EndProcedure
Procedure ShowProgress(n)
	StartDrawing(WindowOutput(0))
	Box(0,284,n,2,#Blue)
	Box(n,284,506,2,$a0a0a0)
	StopDrawing()
EndProcedure
Procedure FindPictures(depth,path.s)
	;Debug Str(depth)+": "+path
	If quit=0
		If ExamineDirectory(depth,path,"*.*")
			;
			If GetAsyncKeyState_(#VK_ESCAPE) : quit=#True : EndIf
			;
			While NextDirectoryEntry(depth) And (quit=0)

				Protected FileName.s = DirectoryEntryName(depth)
				If DirectoryEntryType(depth)=2
					If FileName<>"." And FileName<>".."
						;Debug "scanning " + path+FileName
						FindPictures(depth+1,path+FileName+"")
					EndIf
				Else
					CompilerIf #JpgOnly
						If LCase(Right(FileName,4))=".jpg"
						CompilerElse
							If FindString("|.jpg|.bmp|",LCase(Right(FileName,4)),1) ;|.png|.gif|.tif| ???
							CompilerEndIf

							If TotalPict<#MaxPicts
								TotalPict+1
								Names(TotalPict)=path+FileName
								If (TotalPict<128)
									ShowProgress(TotalPict>>1)
									;SetGadgetState(#Progress,TotalPict)
								ElseIf (TotalPict&$f=0)
									Dummy=TotalPict<<5
									ShowProgress(Sqr(Dummy))
									If TotalPict>100 : SetGadgetText(#ButtonDiashow,Str(TotalPict)+" Pictures") : EndIf
									;SetGadgetState(#Progress,Sqr(Dummy))
								EndIf
							EndIf
							CompilerIf #Diashow
							EndIf
						CompilerElse
						EndIf
					CompilerEndIf
				EndIf
			Wend
			;Debug "Close"+Str(depth)
			FinishDirectory(depth)
		EndIf
	EndIf
EndProcedure
Procedure ShowPictures()

	If TotalPict

		If OpenScreen(ScreenX,ScreenY,ScreenZ,"Diashow")

			If IsSprite(#BlackBackground)=0
				CreateSprite(#BlackBackground,32,32,#PB_Sprite_Texture)
				;TransparentSpriteColor(#BlackBackground,$0)
				StartDrawing(SpriteOutput(#BlackBackground))
				Box(0,0,32,32,$40404); $20202 macht Brösel bei 16-Bit Farben
				StopDrawing()
				CreateSprite3D(#BlackBackground,#BlackBackground)
				ZoomSprite3D(#BlackBackground,ScreenX,ScreenY)
			EndIf

			; letztes Bild von abgebrochener Diashow "löschen"...
			If IsImage(MainPict)
				FreeImage(MainPict)
			EndIf

			ScalePicture(0)
			ScalePicture(1)

			Repeat
				SwapPictures()

				i=0
				quit=0
				Repeat

					WaitTimer=GetTickCount_()+50

					If VarMode
						Start3D()
						DisplaySprite3D(#BlackBackground,0,0,255)
						Stop3D()
						;ClearScreen(#Black); ist langsam!

						If i<128
							DisplaySprite(BackPict,Picture(BackPict)\x,Picture(BackPict)\y)
							Start3D()
							DisplaySprite3D(#BlackBackground,0,0,i<<1)
							Stop3D()
						Else
							DisplaySprite(MainPict,Picture(MainPict)\x,Picture(MainPict)\y)
							Start3D()
							DisplaySprite3D(#BlackBackground,0,0,511-i<<1)
							Stop3D()
						EndIf

					Else
	
	; *** THIS MODE STILL DOES NOT WORK ON MY OLD NOTEBOOK ***
	Start3D()
						DisplaySprite3D(#BlackBackground,0,0,255)
						DisplaySprite3D(BackPict,Picture(BackPict)\x,Picture(BackPict)\y,255-i)
						DisplaySprite3D(MainPict,Picture(MainPict)\x,Picture(MainPict)\y,i)
						Stop3D()
					EndIf

					If VarInfo
						StartDrawing(ScreenOutput())
						DrawingFont(FontID0)
						DrawText(4,2,Str(ActualPict)+"/"+Str(TotalPict)+": "+Names(ActualPict),#Green,#Black)
						DrawText(4,ScreenY-14,"©2006 Michael Vogel • V1."+Str(VarMode+VarFullscreen<<1+VarRandom<<2)+"."+Str(VarSpeed)+Str(#MaxVarWait-VarWait),#Green,#Black)
						StopDrawing()

						;Else

						;	StartDrawing(ScreenOutput())
						;	DrawAlphaImage(Picture(MainPict)\id,0,0)
						;	DrawImage(Picture(MainPict)\id,0,0)
						;	StopDrawing()

					EndIf

					FlipBuffers()
					CheckKeys()
					If quit=999 : Break : EndIf

					i+PeekL(?SpeedTable+VarSpeed<<2)
				Until i>255

				If quit=0
					WaitTimer=GetTickCount_()+PeekL(?WaitTable+VarWait<<2)
					CheckKeys()
				EndIf

			Until quit>2
			CloseScreen()
		EndIf
	EndIf
	quit=0
EndProcedure

Procedure HotSpot()

	Select ChildWindowFromPoint_(WinID,WindowMouseX(0),WindowMouseY(0))
	Case WinID; *** GadgetID ***
		sound=0
	Case 0; Titelzeile
	Default
		SetCursor_(Cursor)
		If Sound = 1
			StopSound(1)
		Else
			PlaySound(1,0)
			Sound = 1
		EndIf
	EndSelect

EndProcedure
Procedure WindowCallback(hWnd,message,wParam,lParam)
	If message=#WM_CTLCOLORBTN
		SetBkMode_(wParam,#TRANSPARENT)
		ProcedureReturn BrushID
	Else
		ProcedureReturn #PB_ProcessPureBasicEvents
	EndIf
EndProcedure
Procedure InitWindow()
	WinID=OpenWindow(0,333,135,506,286,#WindowsTitle,#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
	;SetWindowPos_(win,#HWND_TOPMOST,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE)

	SetClassLong_(WinID,#GCL_HBRBACKGROUND,BrushID); ***

	CreateGadgetList(WinID)
	SetGadgetFont(#PB_Default,FontID0)

	i=261-#ButtonBorder
	ButtonGadget(#ButtonQuit,#ButtonLeft,i,#ButtonWidth,25,#TextQuit) : i-35
	ButtonGadget(#ButtonBrowse,#ButtonLeft,i,#ButtonWidth,25,#TextBrowse) : i-32
	CompilerIf #Diashow
		ButtonGadget(#ButtonDiashow,#ButtonLeft,i,#ButtonWidth,25,#TextDiashow) : i-32
		DisableGadget(#ButtonDiashow,1-DirectXPresent)
	CompilerEndIf
	ButtonGadget(#ButtonProgram,#ButtonLeft,i,#ButtonWidth,25,#TextProgram)

	;ProgressBarGadget(#Progress,0,280,506,6,0,800)
	;HideGadget(#Progress,1)

	;GadgetID=ImageGadget(#Image,0,0,492,286,ImageID); ***
	;SetWindowLong_(GadgetID,#GWL_STYLE,GetWindowLong_(GadgetID,#GWL_STYLE)|#WS_CLIPSIBLINGS); ***

	AddKeyboardShortcut(0,#KeyProgram,#ButtonProgram)
	AddKeyboardShortcut(0,#KeyDiashow,#ButtonDiashow)
	AddKeyboardShortcut(0,#KeyDiashow|#PB_Shortcut_Shift,#ButtonDiashow)
	AddKeyboardShortcut(0,#KeyBrowse,#ButtonBrowse)
	AddKeyboardShortcut(0,#KeyQuit,#ButtonQuit)
	AddKeyboardShortcut(0,#PB_Shortcut_Escape,#ButtonQuit)

	SetWindowCallback(@WindowCallback())

EndProcedure
Procedure Main()

	InitWindow()

	Repeat

		HotSpot()

		Select WaitWindowEvent()
		Case #PB_Event_Gadget,#PB_Event_Menu

			Select EventGadget()
			Case #ButtonProgram
				PlaySound(0,0)
				RunProgram(CurrentDirectory+#Program)
			Case #ButtonDiashow

				; bei gedrückter Shift-Taste den alternativen Anzeigemodus auswählen...
				; VarMode=(GetKeyState_(#VK_SHIFT)&128)>>7

				PlaySound(0,0)
				SetGadgetText(#ButtonDiashow,"Scanning...")

				TotalPict=0
				;HideGadget(#Progress,0)
				;FindPictures(0,CurrentDirectory+#Pictures)
				FindPictures(0,Left(CurrentDirectory,3)+#Pictures)
				quit=0

				;SetGadgetState(#Progress,800)
				ShowProgress(800)
				Delay(50)
				;HideGadget(#Progress,1)
				If TotalPict
					ShowPictures()
				Else
					Delay(200)
				EndIf
				SetGadgetText(#ButtonDiashow,#TextDiashow)
				ShowProgress(0)

			Case #ButtonBrowse
				PlaySound(0,0)
				RunProgram(CurrentDirectory)
			Case #ButtonQuit
				quit=#True
			EndSelect

		Case #PB_Event_CloseWindow
			quit=#True

		EndSelect

	Until quit
	PlaySound(0,0)
	Delay(100); Time to play the sound...
	DestroyCursor_(Cursor)
	End
EndProcedure

Main()

[netmaestro]

Yes, I see the problem. You have to grab a sub-image off the main one the size of your button, from exactly on the main image where the button will show. Then use that subimage to make a patternbrush and return that patternbrush as background for your button in the callback. If you check my posted code, you'll see that's what I'm doing. In your example, it's working but you're using the wrong section of the image for a patternbrush as you can easily tell the button background is coming from the top left section of the main image.

[Michael Vogel]

[...] You have to grab a sub-image off the main one the size of your button, from exactly on the main image where the button will show [...]

Sorry, that will take a while until I understnad it - does it mean, I have to do a own subimage for each single button?

[netmaestro]

This snippet should show it all. To see the difference the callback makes, run it with the callback commented and then not commented:

Code: Select all

CreateImage(0, 320,240, 32)
StartDrawing(ImageOutput(0))
c=0
For i = 0 To 240
  Line(0,i,320,0,RGB(c+i,c-i,c+i))
Next
StopDrawing()

GrabImage(0,1,50,60,200,20)
GrabImage(0,2,50,100,200,20) 
GrabImage(0,3,50,140,200,20)

Global hbrmain = CreatePatternBrush_(ImageID(0)) 
Global hbr1 = CreatePatternBrush_(ImageID(1)) 
Global hbr2 = CreatePatternBrush_(ImageID(2)) 
Global hbr3 = CreatePatternBrush_(ImageID(3)) 

Procedure WindowCallback(hWnd, message, wParam, lParam) 
  result = #PB_ProcessPureBasicEvents 
  Select message 
    Case #WM_CTLCOLORBTN 
      SetBkMode_(wParam, #TRANSPARENT) 
      Select lparam
        Case GadgetID(1)
          result = hbr1 
        Case GadgetID(2)
          result = hbr2 
        Case GadgetID(3)
          result = hbr3 
      EndSelect
  EndSelect 
  ProcedureReturn result 
EndProcedure 

OpenWindow(0,0,0,320,240,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu) 

SetClassLong_(WindowID(0),#GCL_HBRBACKGROUND, hbrmain) 
InvalidateRect_(WindowID(0),0,1) 

CreateGadgetList(WindowID(0)) 
ButtonGadget(1,50,60,200,20,"Button 1") 
ButtonGadget(2,50,100,200,20,"Button 2") 
ButtonGadget(3,50,140,200,20,"Button 3") 
SetWindowCallback(@WindowCallback()) 

Repeat 
  ev=WaitWindowEvent() 

Until ev=#WM_CLOSE

Here's what I'm seeing, callback is commented for buttons on left:

[Michael Vogel]

Thanks, netmaestro - also that you have patient with me (sometimes it take a while until I understand things) :roll:

[netmaestro]

You're most welcome! And I'll need your help one day soon, I'm sure.