It is currently Mon Sep 28, 2020 8:40 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 5 posts ] 
Author Message
 Post subject: Hyperlink into ListIconGadget
PostPosted: Sat Dec 29, 2007 12:00 pm 
Offline
Enthusiast
Enthusiast

Joined: Tue Oct 12, 2004 12:14 am
Posts: 128
Location: Italy
Hi,
it is possible to insert into ListIconGadget a Hyperlink as in figure?

Image

Thanks in advance


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sat Dec 29, 2007 5:59 pm 
Offline
PureBasic Bullfrog
PureBasic Bullfrog
User avatar

Joined: Wed Jul 06, 2005 5:42 am
Posts: 8143
Location: Fort Nelson, BC, Canada
Certainly it's possible, there are several ways to accomplish it. Here's one that doesn't actually put a gadget into the listicon, but simulates the functionality:
Code:
; Yet another useless program from netmaestro
; Because all the useless programs aren't written yet

CompilerIf Defined(LVM_SUBITEMHITTEST, #PB_Constant) = 0
  #LVM_SUBITEMHITTEST = #LVM_FIRST + 57
CompilerEndIf

CompilerIf Defined(LVM_GETSUBITEMRECT, #PB_Constant) = 0
  #LVM_GETSUBITEMRECT = #LVM_FIRST + 56
CompilerEndIf

Macro GetItem(gadget)
  GetItemOrSubItem(gadget, 0)
EndMacro

Macro GetSubItem(gadget)
  GetItemOrSubItem(gadget, 1)
EndMacro

Global hand = LoadCursor_(0, #IDC_HAND)

Procedure GetItemOrSubItem(gadget, subitem)
  GetCursorPos_(@cp.POINT)
  MapWindowPoints_(0, GadgetID(gadget), cp, 1)
  hti.LVHITTESTINFO
  hti\pt\x = cp\x
  hti\pt\y = cp\y
  SendMessage_(GadgetID(gadget), #LVM_SUBITEMHITTEST, 0, hti)
  If subitem
    ProcedureReturn hti\iSubItem
  Else
    ProcedureReturn hti\iItem
  EndIf
EndProcedure

Procedure IsPositionHot(gadget, item, column)
  If item <> -1
    GetCursorPos_(@cp.POINT)
    MapWindowPoints_(0, GadgetID(gadget), cp, 1)
    RtlZeroMemory_(@itemrect.RECT, SizeOf(RECT))
    itemrect\top = column
    SendMessage_(GadgetID(gadget), #LVM_GETSUBITEMRECT, item, @itemrect)
    dc = GetWindowDC_(WindowID(0))
    hdcmem = CreateCompatibleDC_(dc)
    text$ = GetGadgetItemText(Gadget, item, column)
    SelectObject_(hdcmem, GetStockObject_(#DEFAULT_GUI_FONT))
    GetTextExtentPoint32_(hdcmem, @text$, Len(text$), @size.SIZE)
    ReleaseDC_(WindowID(0), dc)
    DeleteDC_(hdcmem)
    If cp\x >= itemrect\left+5 And cp\x <= itemrect\left+size\cx+5
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure ShowWeb(gadget)
  RunProgram(GetGadgetItemText(gadget, getitem(gadget), 1))
EndProcedure
   
Procedure LVProc(hwnd, msg, wparam, lparam)
  oldproc = GetProp_(hwnd, "oldproc")
  gadget  = GetProp_(hwnd, "PB_ID")
  Select msg
    Case #WM_NCDESTROY
      RemoveProp_(hwnd, "oldproc")
    Case #WM_MOUSEMOVE
      If GetActiveGadget() <> gadget
        SetActiveGadget(gadget)
      EndIf
      If GetSubItem(gadget) = 1
        If IsPositionHot(gadget, GetItem(gadget), 1)
          SetCursor_(hand)
        EndIf
      EndIf
      ProcedureReturn 0
    Case #WM_LBUTTONDOWN
      If GetSubItem(gadget) = 1
        If IspositionHot(gadget, Getitem(gadget), 1)
          ShowWeb(gadget)
        EndIf
      EndIf     
      ProcedureReturn 0
  EndSelect
  ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wparam, lparam)
EndProcedure

OpenWindow(0,0,0,550,240,"Movie Looker-Upper",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CreateGadgetList(WindowID(0))
ListIconGadget(10,0,0,550,240,"Movie Title",120,#PB_ListIcon_GridLines)
AddGadgetColumn(10,1,"IMDB Page",325)
AddGadgetColumn(10,2,"Genre",100)
SetProp_(GadgetID(10),"oldproc",SetWindowLong_(GadgetID(10),#GWL_WNDPROC,@LVProc()))

AddGadgetItem(10,-1,"As Good As It Gets"+Chr(10)+"http://www.imdb.com/title/tt0119822/"+Chr(10)+"Comedy Drama")
AddGadgetItem(10,-1,"Back to School"+Chr(10)+"http://www.imdb.com/title/tt0090685/"+Chr(10)+"Comedy")
AddGadgetItem(10,-1,"Carry On Camping"+Chr(10)+"http://www.imdb.com/title/tt0064133/"+Chr(10)+"Comedy")
AddGadgetItem(10,-1,"Dangerous Liasons"+Chr(10)+"http://www.imdb.com/title/tt0094947/"+Chr(10)+"Drama")
AddGadgetItem(10,-1,"Ever After"+Chr(10)+"http://www.imdb.com/title/tt0120631/"+Chr(10)+"Chick Flick")
AddGadgetItem(10,-1,"Learn how to do this"+Chr(10)+"http://www.purebasic.fr/english/viewtopic.php?t=30275&start=1"+Chr(10)+"Hehe")

For i=0 To CountGadgetItems(10)-1
  SetGadgetItemColor(10,i,#PB_Gadget_FrontColor,#Blue,1)
Next
SetActiveGadget(10)

Repeat :Until WaitWindowEvent()=#PB_Event_CloseWindow

_________________
Veni, vidi, vici.


Last edited by netmaestro on Sat Dec 29, 2007 9:19 pm, edited 5 times in total.

Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sat Dec 29, 2007 6:39 pm 
Offline
Enthusiast
Enthusiast

Joined: Tue Oct 12, 2004 12:14 am
Posts: 128
Location: Italy
Hi netmaestro,

Your code returns the error...
Code:
Constant not found: #LVM_SUBITEMHITTEST


... and I have added to your code this:
Code:
#LVM_SUBITEMHITTEST = #LVM_FIRST + 57


Thanks you very much! Excellent work... :D


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sat Dec 29, 2007 6:44 pm 
Offline
PureBasic Bullfrog
PureBasic Bullfrog
User avatar

Joined: Wed Jul 06, 2005 5:42 am
Posts: 8143
Location: Fort Nelson, BC, Canada
Thx, what version of PB are you using?

[edit] Added compiler check to prevent a recurrence of that problem.

_________________
Veni, vidi, vici.


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sat Dec 29, 2007 7:50 pm 
Offline
Enthusiast
Enthusiast

Joined: Tue Oct 12, 2004 12:14 am
Posts: 128
Location: Italy
netmaestro wrote:
Thx, what version of PB are you using?

[edit] Added compiler check to prevent a recurrence of that problem.


Thanks, I use PB 4.02.


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 5 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 32 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye