How to draw a half-transparent image in window?

[netmaestro]

Really, can I do it without WinAPI?

Unfortunately not. Here's a little demo of how you can do it using API though:

Code: Select all

; Transparent gadgets demo by netmaestro
;
;================================================
;  Create a gradient image to use as background
;================================================

OpenLibrary(0,"Msimg32.dll") 
Prototype GradientFill(hdc,*Vert,Int1,*Rect,Int2,Flags) 
GradientFill.GradientFill=GetFunction(0,"GradientFill") 

Dim vert.TRIVERTEX(1)
gRect.GRADIENT_RECT
vert (0) \x      = 0;
vert (0) \y      = 0;
vert (0) \Red    = $0000;
vert (0) \Green  = $ffff;
vert (0) \Blue   = $ffff;
vert (0) \Alpha  = $0000;

vert (1) \x      = 260;
vert (1) \y      = 160; 
vert (1) \Red    = $ffff;
vert (1) \Green  = $0ff0;
vert (1) \Blue   = $ffff;
vert (1) \Alpha  = $0000;

gRect\UpperLeft  = 0;
gRect\LowerRight = 1;

CreateImage(0,260,160,32)
hDC = StartDrawing(ImageOutput(0))
  GradientFill(hdc, @vert(), 2, @gRect, 1, #GRADIENT_FILL_RECT_H)
StopDrawing()

CloseLibrary(0)

;================================================
;  Demo transparent checkbox and text gadgets
;================================================

Global GadgetFrg=#Black, GadgetBkg = GetStockObject_(#HOLLOW_BRUSH) 

Procedure WindowProc(hWnd, Msg, wParam, lParam) 
  result = #PB_ProcessPureBasicEvents 
  If Msg=#WM_CTLCOLORSTATIC 
    Select GetDlgCtrlID_(lparam)
      Case 1 To 3
        SetBkMode_(wParam,#TRANSPARENT) 
        SetTextColor_(wParam,GadgetFrg) 
        result = GadgetBkg
    EndSelect
  EndIf 
  ProcedureReturn result
EndProcedure 

OpenWindow(0,0,0,260,160,"test",$CF0001) 
SetWindowCallback(@WindowProc()) 
CreateGadgetList(WindowID(0)) 
CheckBoxGadget(1,10,20,245,20,"This is a transparent Checkbox gadget") 
CheckBoxGadget(2,10,50,245,20,"This is another transparent Checkbox gadget")
TextGadget(3, 10,82,250,20,"This is a transparent text gadget")

hBrush = CreatePatternBrush_(ImageID(0)) 
SetClassLong_(WindowID(0), #GCL_HBRBACKGROUND, hBrush)  
InvalidateRect_(WindowID(0), 0, #True) 
Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow 

DeleteObject_(GadgetBkg) 
DeleteObject_(hBrush)

[netmaestro]

I dunno. This is how the demo code shows here:



[edit] Hey! Where'd your post go?

[Michael Korolev]

Look at this:


Why background stripes didn't disappeared in checkbox gadgets?

In upper gadget must be text "This is a transparent Checkbox gadget"
Lower gadget - "This is another transparent Checkbox gadget"....

P.S. What is WindowProc() procedure? For what it's needed?

[netmaestro]

OK, I can reproduce it if I enable XP themes. I'm not sure why it doesn't work correctly with themes enabled, but here's a workaround you can use that should show correctly with themes on or off:

Code: Select all

; Transparent gadgets demo by netmaestro 
; 
;================================================ 
;  Create a gradient image to use as background 
;================================================ 

OpenLibrary(0,"Msimg32.dll") 
Prototype GradientFill(hdc,*Vert,Int1,*Rect,Int2,Flags) 
GradientFill.GradientFill=GetFunction(0,"GradientFill") 

Dim vert.TRIVERTEX(1) 
gRect.GRADIENT_RECT 
vert (0) \x      = 0; 
vert (0) \y      = 0; 
vert (0) \Red    = $0000; 
vert (0) \Green  = $ffff; 
vert (0) \Blue   = $ffff; 
vert (0) \Alpha  = $0000; 

vert (1) \x      = 260; 
vert (1) \y      = 160; 
vert (1) \Red    = $ffff; 
vert (1) \Green  = $0ff0; 
vert (1) \Blue   = $ffff; 
vert (1) \Alpha  = $0000; 

gRect\UpperLeft  = 0; 
gRect\LowerRight = 1; 

CreateImage(0,260,160,32) 
hDC = StartDrawing(ImageOutput(0)) 
  GradientFill(hdc, @vert(), 2, @gRect, 1, #GRADIENT_FILL_RECT_H) 
StopDrawing() 

CloseLibrary(0) 

;================================================ 
;  Demo transparent checkbox and text gadgets 
;================================================ 

Procedure ThemesEnabled()
  dlv.DLLVERSIONINFO
  dlv\cbsize=SizeOf(DLLVERSIONINFO) 
  lib=OpenLibrary(#PB_Any,"comctl32.dll") 
  If lib 
    CallFunction(lib,"DllGetVersion",@dlv) 
    DLLVersion = dlv\dwMajorVersion 
    CloseLibrary(lib) 
  EndIf 
  If DLLVersion = 6
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

Global GadgetFrg=#Black, GadgetBkg

If ThemesEnabled()
  GadgetBkg = CreatePatternBrush_(GrabImage(0,1,10,20,245,20))
Else
  GadgetBkg = GetStockObject_(#HOLLOW_BRUSH)
EndIf

Procedure WindowProc(hWnd, Msg, wParam, lParam) 
  result = #PB_ProcessPureBasicEvents 
  If Msg=#WM_CTLCOLORSTATIC 
    Select GetDlgCtrlID_(lparam) 
      Case 1 To 3 
        SetBkMode_(wParam,#TRANSPARENT) 
        SetTextColor_(wParam,GadgetFrg) 
        result = GadgetBkg 
    EndSelect 
  EndIf 
  ProcedureReturn result 
EndProcedure 

OpenWindow(0,0,0,260,160,"test",$CF0001) 
SetWindowCallback(@WindowProc()) 
CreateGadgetList(WindowID(0)) 
CheckBoxGadget(1,10,20,245,20,"This is a transparent Checkbox gadget") 
CheckBoxGadget(2,10,50,245,20,"This is another transparent Checkbox gadget") 
TextGadget(3, 10,82,245,20,"This is a transparent text gadget") 

hBrush = CreatePatternBrush_(ImageID(0)) 
SetClassLong_(WindowID(0), #GCL_HBRBACKGROUND, hBrush)  
InvalidateRect_(WindowID(0), 0, #True) 
Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow 

DeleteObject_(GadgetBkg) 
DeleteObject_(hBrush) 

This workaround is a bit of trouble to implement because the GrabImage background has to match the coordinates of the gadget, which means that if you're using an image for a background instead of a simple gradient, you will need a separate background for each gadget. Annoying to say the least. Maybe someone knows a better workaround? Or possibly I've missed something? It looks like (another) bug in the Windows Common Controls version 6, as an API-created checkbox also has the problem.

[Molchyn]

On german forum I saw some solution, may be it's helpfull..

Code: Select all

SetWindowLong_(WindowID( #Window_0),#GWL_EXSTYLE,GetWindowLong_(WindowID(0),#GWL_EXSTYLE) | #WS_EX_LAYERED) 
SetLayeredWindowAttributes_(WindowID( #Window_0), 0, (255 * 70) / 100, #LWA_ALPHA)

And like example:

Code: Select all

Enumeration
  #Window_0
EndEnumeration
;}
;{ Gadgets
Enumeration
  #ListIconGadget_1
  #ButtonGadget_1
  #TextGadget_1
EndEnumeration

#APPNAME = "Your Stuff"
OpenWindow( #Window_0,0,0,320,240,#APPNAME,  #PB_Window_ScreenCentered | #PB_Window_BorderLess); | #PB_Window_SystemMenu) 
  ;remowe window from toolbar
SetWindowLong_(WindowID(#Window_0), #GWL_EXSTYLE, GetWindowLong_(WindowID(#Window_0), #GWL_EXSTYLE) | #WS_EX_LAYERED | #WS_EX_TOOLWINDOW)

CreateGadgetList(WindowID( #Window_0)) 
ButtonGadget(#ButtonGadget_1,300,0,20,20,"X") 

TextGadget(#TextGadget_1,0,0,250,40,"",#PB_Text_Center); | #LBS_OWNERDRAWFIXED) 
ListIconGadget(#ListIconGadget_1, 5, 43, 295, 190, "Time", 50, #PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
SendMessage_(GadgetID(#ListIconGadget_1), #LVM_SETCOLUMNWIDTH, 0, #LVSCW_AUTOSIZE_USEHEADER)

  ;=======================


SetWindowLong_(WindowID( #Window_0),#GWL_EXSTYLE,GetWindowLong_(WindowID(0),#GWL_EXSTYLE) | #WS_EX_LAYERED) 
SetLayeredWindowAttributes_(WindowID( #Window_0), 0, (255 * 70) / 100, #LWA_ALPHA)

StickyWindow( #Window_0,1) 


Quit = 0 
Repeat 
  ev = WaitWindowEvent() 
  Select ev 
    Case #WM_RBUTTONUP
     
    Case #WM_LBUTTONDOWN 
      SendMessage_(WindowID( #Window_0),#WM_NCLBUTTONDOWN,#HTCAPTION,0) 
    Case #PB_Event_Menu
      
    Case #PB_Event_Gadget 
      If EventGadget()=#ButtonGadget_1
        Quit = 1 
      EndIf 
  EndSelect 
Until Quit 

[Fangbeast]

The transparent styles are great. Is there any way to add a gradient fill to this?

I want to fill it with a light blue gradient and then i'll add a timeout to the window so it will be like a messagebox but sexy and colourful.

If I ever figure out how, I also want it to look like a speech bubble. I know you can do that with balloon tip code I have seen around but I don't want to attach a tip to a gadget and this seems a nice way of doing things.

[Fangbeast]

I popup a little editor box with my message, give it a small timeout and it doesn't look too bad. Would like a gradient on it.

Also had to use the PV lib to colour the window background as

Brush.LOGBRUSH\lbColor=16744576
SetClassLong_(WindowID(#Window_messages),#GCL_HBRBACKGROUND,CreateBrushIndirect_(Brush))

didn't seem to work with the other SetCLass commands but doesn't seem to interfere at the window code level.

Code: Select all

Enumeration 1
  #Window_messages
EndEnumeration

#WindowIndex = #PB_Compiler_EnumerationValue

Enumeration 1
  #Gadget_messages_fmain
  #Gadget_messages_message
EndEnumeration

#GadgetIndex = #PB_Compiler_EnumerationValue

Procedure.l Window_messages()
  If OpenWindow(#Window_messages,123,192,400,85,"", #PB_Window_BorderLess|#PB_Window_ScreenCentered|#PB_Window_Invisible)
    Brush.LOGBRUSH\lbColor=16744576
    SetClassLong_(WindowID(#Window_messages),#GCL_HBRBACKGROUND,CreateBrushIndirect_(Brush))
    If CreateGadgetList(WindowID(#Window_messages))
      Frame3DGadget(#Gadget_messages_fmain,5,0,390,80,"")
      EditorGadget(#Gadget_messages_message,10,10,380,65,#PB_Editor_ReadOnly)
        SendMessage_(GadgetID(#Gadget_messages_message),#EM_SETBKGNDCOLOR,0,16744576)
      HideWindow(#Window_messages,0)
      ProcedureReturn WindowID(#Window_messages)
    EndIf
  EndIf
EndProcedure

Procedure WindowCallback(WindowID, Message, wParam, lParam)
  ReturnValue = #PB_ProcessPureBasicEvents
  If Message = #WM_CTLCOLORSTATIC Or Message = #WM_CTLCOLOREDIT Or Message = #WM_CTLCOLORLISTBOX
    ReturnValue = PVDynamic_ColorGadget(lParam, wParam)
  EndIf
  ProcedureReturn ReturnValue
EndProcedure

If Window_messages()
  SetWindowLong_(WindowID(#Window_messages), #GWL_EXSTYLE, GetWindowLong_(WindowID(#Window_messages), #GWL_EXSTYLE) | #WS_EX_LAYERED)
  SetLayeredWindowAttributes_(WindowID(#Window_messages), 0, (255 * 70) / 100, #LWA_ALPHA)
  While WindowEvent():Wend
  SetWindowCallback(@WindowCallback())
  Delay(2000)
  CloseWindow(#Window_messages)
EndIf
End

[Fangbeast]

This looks neater. Now all I need is a gradient fill in the editorgadget

Code: Select all

Enumeration 1
  #Window_messages
EndEnumeration

#WindowIndex = #PB_Compiler_EnumerationValue

Enumeration 1
  ;#Gadget_messages_fmain
  #Gadget_messages_message
EndEnumeration

#GadgetIndex = #PB_Compiler_EnumerationValue

Procedure.l Window_messages()
  If OpenWindow(#Window_messages,123,192,400,85,"", #PB_Window_BorderLess|#PB_Window_ScreenCentered|#PB_Window_Invisible)
    If CreateGadgetList(WindowID(#Window_messages))
      EditorGadget(#Gadget_messages_message,0,0,401,86,#PB_Editor_ReadOnly)
        SendMessage_(GadgetID(#Gadget_messages_message),#EM_SETBKGNDCOLOR,0,16744576)
      HideWindow(#Window_messages,0)
      ProcedureReturn WindowID(#Window_messages)
    EndIf
  EndIf
EndProcedure

If Window_messages()
  SetWindowLong_(WindowID(#Window_messages), #GWL_EXSTYLE, GetWindowLong_(WindowID(#Window_messages), #GWL_EXSTYLE) | #WS_EX_LAYERED)
  SetLayeredWindowAttributes_(WindowID(#Window_messages), 0, (255 * 70) / 100, #LWA_ALPHA)
  While WindowEvent():Wend
  Delay(2000)
  CloseWindow(#Window_messages)
EndIf
End

[netmaestro]

Here's a bit of doodling I did for fun, it tailbites up no problem:

Code: Select all

; Yet another useless program from netmaestro 
; 
; Because there are just never enough useless programs 
  
  
Procedure WinProc(hWnd,Msg,wParam,lParam) 
  result = #PB_ProcessPureBasicEvents 
  If Msg=#WM_CTLCOLORSTATIC 
    SetBkMode_(wParam,#TRANSPARENT) 
    SetTextColor_(wParam,#Black) 
    result = GetStockObject_(#NULL_BRUSH) 
  EndIf 
  ProcedureReturn result 
EndProcedure 

Procedure WindUp(msgwin,oldbrush,bkimg,hbrush) 
  SetClassLong_(WindowID(msgwin), #GCL_HBRBACKGROUND, oldbrush) 
  FreeImage(bkimg) 
  DeleteObject_(hbrush) 
  CloseWindow(msgwin) 
EndProcedure 

ProcedureDLL GradientMessage(x,y,msgtext.s, duration)  
  lib=OpenLibrary(#PB_Any,"Msimg32.dll") 
  
  Dim vert.TRIVERTEX(1) 
  gRect.GRADIENT_RECT 
  vert (0) \x      = 0; 
  vert (0) \y      = 0; 
  vert (0) \Red    = $0000; 
  vert (0) \Green  = $ffff; 
  vert (0) \Blue   = $ffff; 
  vert (0) \Alpha  = $0000; 
  
  vert (1) \x      = 300; 
  vert (1) \y      = 150; 
  vert (1) \Red    = $ffff; 
  vert (1) \Green  = $0ff0; 
  vert (1) \Blue   = $ffff; 
  vert (1) \Alpha  = $0000; 
  
  gRect\UpperLeft  = 0; 
  gRect\LowerRight = 1; 
  
  bkimg = CreateImage(#PB_Any,300,150,32) 
  hDC = StartDrawing(ImageOutput(bkimg)) 
    CallFunction(lib, "GradientFill", hdc, @vert(), 2, @gRect, 1, #GRADIENT_FILL_RECT_H) 
  StopDrawing() 
  
  CloseLibrary(lib) 
  
  hbrush = CreatePatternBrush_(ImageID(bkimg)) 
  
  Dim t.POINT(2) 
  t(0)\x = 100 
  t(0)\y = 99 
  t(1)\x = 130 
  t(1)\y = 99 
  t(2)\x = 80 
  t(2)\y = 150 
  
  hrgn =  CreateRectRgn_(0,0,300,150) 
  hrgn0 = CreateRoundRectRgn_(0,0,300,100,40,40) 
  hrgn1 = CreatePolygonRgn_(@t(),3,#WINDING) 
  CombineRgn_(hrgn,hrgn0,hrgn1,#RGN_XOR) 
    
  msgwin = OpenWindow(#PB_Any,x,y,400,200,"",#PB_Window_BorderLess|#PB_Window_Invisible) 
  oldbrush = SetClassLong_(WindowID(msgwin),#GCL_HBRBACKGROUND,hbrush) 
  CreateGadgetList(WindowID(msgwin)) 
  htxt = TextGadget(#PB_Any, 0,45,300,20,msgtext,#SS_CENTER) 
  hlink = HyperLinkGadget(#PB_Any, 280,10,20,20,"X",#White) 
  SetGadgetFont(hlink, GetStockObject_(#SYSTEM_FONT)) 
  SetWindowCallback(@WinProc(),msgwin) 
  SetWindowRgn_(WindowID(msgwin), hrgn, #True) 
  SetWindowLong_(WindowID(msgwin), #GWL_EXSTYLE, GetWindowLong_(WindowID(msgwin), #GWL_EXSTYLE) | #WS_EX_LAYERED | #WS_EX_TOOLWINDOW) 
  SetLayeredWindowAttributes_(WindowID(msgwin), 0, 20, #LWA_ALPHA) 
  HideWindow(msgwin,0) 
  
  alpha = 20 
  Repeat 
    alpha+5 
    SetLayeredWindowAttributes_(WindowID(msgwin), 0, alpha, #LWA_ALPHA) 
    UpdateWindow_(WindowID(msgwin)) 
    ev = WindowEvent() 
    If ev = #PB_Event_Gadget And EventGadget() = hlink 
      Windup(msgwin,oldbrush,bkimg,hbrush) : ProcedureReturn 
    EndIf 
    Delay(1) 
  Until alpha>=200 
  
  time = ElapsedMilliseconds() 
  Repeat 
    ev = WindowEvent() 
    If ev = #PB_Event_Gadget And EventGadget() = hlink 
      Windup(msgwin,oldbrush,bkimg,hbrush) : ProcedureReturn 
    ElseIf ev = #WM_LBUTTONDOWN
      SendMessage_(WindowID(msgwin),#WM_NCLBUTTONDOWN,#HTCAPTION,0)
    EndIf 
    Delay(1) 
  Until ElapsedMilliseconds()-time > duration 
  
  alpha = 200 
  Repeat 
    alpha-5 
    SetLayeredWindowAttributes_(WindowID(msgwin), 0, alpha, #LWA_ALPHA) 
    UpdateWindow_(WindowID(msgwin)) 
    ev = WindowEvent() 
    If ev = #PB_Event_Gadget And EventGadget() = hlink 
      Windup(msgwin,oldbrush,bkimg,hbrush) : ProcedureReturn 
    EndIf 
    Delay(1) 
  Until alpha<=20 

  Windup(msgwin,oldbrush,bkimg,hbrush)    

EndProcedure 

GradientMessage(300,300,"Hello there, I have an important message for you!", 5000)