PureBasic Forums - English

Code: Select all

; 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

Code: Select all

Constant not found: #LVM_SUBITEMHITTEST

Code: Select all

#LVM_SUBITEMHITTEST = #LVM_FIRST + 57