home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD125101292000.psc / PopupMod1.bas < prev    next >
Encoding:
BASIC Source File  |  2000-12-05  |  9.8 KB  |  409 lines
  1. Attribute VB_Name = "PopupMod1"
  2. 'Declaration section
  3. Public Declare Function CreatePopupMenu Lib "user32.dll" () As Long
  4. Public Declare Function DestroyMenu Lib "user32.dll" (ByVal hMenu As Long) As Long
  5. Public Type MENUITEMINFO
  6.         cbSize As Long
  7.         fMask As Long
  8.         fType As Long
  9.         fState As Long
  10.         wID As Long
  11.         hSubMenu As Long
  12.         hbmpChecked As Long
  13.         hbmpUnchecked As Long
  14.         dwItemData As Long
  15.         dwTypeData As String
  16.         cch As Long
  17. End Type
  18. Public Const MIIM_STATE = &H1
  19. Public Const MIIM_ID = &H2
  20. Public Const MIIM_SUBMENU = &H4
  21. Public Const MIIM_CHECKMARKS = &H8
  22. Public Const MIIM_DATA = &H20
  23. Public Const MIIM_TYPE = &H10
  24. Public Const MFT_BITMAP = &H4
  25. Public Const MFT_MENUBARBREAK = &H20
  26. Public Const MFT_MENUBREAK = &H40
  27. Public Const MFT_OWNERDRAW = &H100
  28. Public Const MFT_RADIOCHECK = &H200
  29. Public Const MFT_RIGHTJUSTIFY = &H4000
  30. Public Const MFT_RIGHTORDER = &H2000
  31. Public Const MFT_SEPARATOR = &H800
  32. Public Const MFT_STRING = &H0
  33. Public Const MFS_CHECKED = &H8
  34. Public Const MFS_DEFAULT = &H1000
  35. Public Const MFS_DISABLED = &H2
  36. Public Const MFS_ENABLED = &H0
  37. Public Const MFS_GRAYED = &H1
  38. Public Const MFS_HILITE = &H80
  39. Public Const MFS_UNCHECKED = &H0
  40. Public Const MFS_UNHILITE = &H0
  41. Public Declare Function InsertMenuItem Lib "user32.dll" Alias "InsertMenuItemA" _
  42. (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPosition As Long, lpmii As MENUITEMINFO) As Long
  43. Public Declare Function TrackPopupMenu Lib "user32.dll" _
  44. (ByVal hMenu As Long, ByVal uFlags As Long, ByVal X As Long, ByVal Y As Long, _
  45. ByVal nReserved As Long, ByVal hWnd As Long, ByVal prcRect As Long) As Long
  46. Public Const TPM_RIGHTALIGN = &H8&
  47. Public Const TPM_CENTERALIGN = &H4&
  48. Public Const TPM_LEFTALIGN = &H0
  49. Public Const TPM_TOPALIGN = &H0
  50. Public Const TPM_NONOTIFY = &H80
  51. Public Const TPM_RETURNCMD = &H100
  52. Public Const TPM_LEFTBUTTON = &H0
  53. Public Const TPM_RIGHTBUTTON = &H2&
  54. Public Type POINT_TYPE
  55. X As Long
  56. Y As Long
  57. End Type
  58. Public Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINT_TYPE) As Long
  59. Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
  60.  
  61. Public Sub CreateApiMenu()
  62. Dim hPopupMenu1 As Long
  63. Dim Menu1 As MENUITEMINFO
  64. Dim curpos As POINT_TYPE
  65. Dim menusel As Long
  66. Dim retval As Long
  67.  
  68. hPopupMenu1 = CreatePopupMenu()
  69.  
  70. With Menu1
  71. .cbSize = Len(Menu1)
  72. .fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE Or MIIM_SUBMENU
  73. End With
  74.  
  75. With Menu1
  76. .fType = MFT_STRING
  77. .fState = MFS_ENABLED
  78. .wID = 1011 ' Assign this item an item identifier.
  79. .dwTypeData = "View normal size"
  80. .cch = Len("View normal size")
  81. .hSubMenu = 0
  82. End With
  83. retval = InsertMenuItem(hPopupMenu1, 0, 1, Menu1)
  84.  
  85. With Menu1
  86. .fType = MFT_SEPARATOR
  87. .fState = MFS_ENABLED
  88. .wID = 1010 ' Assign this item an item identifier.
  89. .dwTypeData = "/separator/"
  90. .cch = Len("/separator/")
  91. .hSubMenu = 0
  92. End With
  93. retval = InsertMenuItem(hPopupMenu1, 1, 1, Menu1)
  94.  
  95. With Menu1
  96. .fType = MFT_STRING
  97. .fState = MFS_ENABLED
  98. .wID = 1009
  99. .dwTypeData = "Reduce to 75%"
  100. .cch = Len("Reduce to 75%")
  101. .hSubMenu = 0
  102. End With
  103. retval = InsertMenuItem(hPopupMenu1, 2, 1, Menu1)
  104.  
  105. With Menu1
  106. .fType = MFT_STRING
  107. .fState = MFS_ENABLED
  108. .wID = 1008
  109. .dwTypeData = "Reduce to 50%"
  110. .cch = Len("Reduce to 50%")
  111. .hSubMenu = 0
  112. End With
  113. retval = InsertMenuItem(hPopupMenu1, 3, 1, Menu1)
  114.  
  115. With Menu1
  116. .fType = MFT_STRING
  117. .fState = MFS_ENABLED
  118. .wID = 1007
  119. .dwTypeData = "Reduce to 25%"
  120. .cch = Len("Reduce to 25%")
  121. .hSubMenu = 0
  122. End With
  123. retval = InsertMenuItem(hPopupMenu1, 4, 1, Menu1)
  124.  
  125. With Menu1
  126. .fType = MFT_SEPARATOR
  127. .fState = MFS_ENABLED
  128. .wID = 1006
  129. .dwTypeData = "/separator/"
  130. .cch = Len("/separator/")
  131. .hSubMenu = 0
  132. End With
  133. retval = InsertMenuItem(hPopupMenu1, 5, 1, Menu1)
  134.  
  135. With Menu1
  136. .fType = MFT_STRING
  137. .fState = MFS_ENABLED
  138. .wID = 1005
  139. .dwTypeData = "Enlarge to 150%"
  140. .cch = Len("Enlarge to 150%")
  141. .hSubMenu = 0
  142. End With
  143. retval = InsertMenuItem(hPopupMenu1, 6, 1, Menu1)
  144.  
  145. With Menu1
  146. .fType = MFT_STRING
  147. .fState = MFS_ENABLED
  148. .wID = 1004 ' Assign this item an item identifier.
  149. .dwTypeData = "Enlarge to 200%"
  150. .cch = Len("Enlarge to 200%")
  151. .hSubMenu = 0
  152. End With
  153. retval = InsertMenuItem(hPopupMenu1, 7, 1, Menu1)
  154.  
  155. With Menu1
  156. .fType = MFT_STRING
  157. .fState = MFS_ENABLED
  158. .wID = 1003 ' Assign this item an item identifier.
  159. .dwTypeData = "Enlarge to 250%"
  160. .cch = Len("Enlarge to 250%")
  161. .hSubMenu = 0
  162. End With
  163. retval = InsertMenuItem(hPopupMenu1, 8, 1, Menu1)
  164.  
  165. With Menu1
  166. .fType = MFT_STRING
  167. .fState = MFS_ENABLED
  168. .wID = 1002 ' Assign this item an item identifier.
  169. .dwTypeData = "Enlarge to 300%"
  170. .cch = Len("Enlarge to 300%")
  171. .hSubMenu = 0
  172. End With
  173. retval = InsertMenuItem(hPopupMenu1, 9, 1, Menu1)
  174.  
  175. With Menu1
  176. .fType = MFT_SEPARATOR
  177. .fState = MFS_ENABLED
  178. .wID = 1001 ' Assign this item an item identifier.
  179. .dwTypeData = "/separator/"
  180. .cch = Len("/separator/")
  181. .hSubMenu = 0
  182. End With
  183. retval = InsertMenuItem(hPopupMenu1, 10, 1, Menu1)
  184.  
  185. With Menu1
  186. .fType = MFT_STRING
  187. .fState = MFS_ENABLED
  188. .wID = 1000 ' Assign this item an item identifier.
  189. .dwTypeData = "Main"
  190. .cch = Len("Main")
  191. .hSubMenu = 0
  192. End With
  193. retval = InsertMenuItem(hPopupMenu1, 11, 1, Menu1)
  194.  
  195. With Menu1
  196. .fType = MFT_SEPARATOR
  197. .fState = MFS_ENABLED
  198. .wID = 1012 ' Assign this item an item identifier.
  199. .dwTypeData = "/separator/"
  200. .cch = Len("/separator/")
  201. .hSubMenu = 0
  202. End With
  203. retval = InsertMenuItem(hPopupMenu1, 12, 1, Menu1)
  204.  
  205. With Menu1
  206. .fType = MFT_STRING
  207. .fState = MFS_ENABLED
  208. .wID = 1013 ' Assign this item an item identifier.
  209. .dwTypeData = "Show Info"
  210. .cch = Len("Show Info")
  211. .hSubMenu = 0
  212. End With
  213. retval = InsertMenuItem(hPopupMenu1, 13, 1, Menu1)
  214.  
  215. retval = GetCursorPos(curpos)
  216. menusel = TrackPopupMenu(hPopupMenu1, TPM_TOPALIGN Or TPM_NONOTIFY Or TPM_RETURNCMD Or TPM_RIGHTALIGN Or TPM_RIGHTBUTTON, curpos.X, curpos.Y, 0, Thumbfrm2.hWnd, 0)
  217. retval = DestroyMenu(hPopupMenu3)
  218. Select Case menusel
  219. Case 1013
  220. Call ApiMenu10_Click
  221. Case 1011
  222. Call ApiMenu1_Click
  223. Case 1009
  224. Call ApiMenu2_Click
  225. Case 1008
  226. Call ApiMenu3_Click
  227. Case 1007
  228. Call ApiMenu4_Click
  229. Case 1005
  230. Call ApiMenu5_Click
  231. Case 1004
  232. Call ApiMenu6_Click
  233. Case 1003
  234. Call ApiMenu7_Click
  235. Case 1002
  236. Call ApiMenu8_Click
  237. Case 1000
  238. Call ApiMenu9_Click
  239. Case Else
  240. End Select
  241. End Sub
  242. 'execute items in popupmenu.
  243.  
  244. Public Sub ApiMenu1_Click()
  245. GetNewDim 100
  246. ShowSized
  247. End Sub
  248.  
  249. Public Sub ApiMenu2_Click()
  250. GetNewDim 75
  251. ShowSized
  252. End Sub
  253.  
  254. Public Sub ApiMenu3_Click()
  255. GetNewDim 50
  256. ShowSized
  257. End Sub
  258.  
  259. Public Sub ApiMenu4_Click()
  260. GetNewDim 25
  261. ShowSized
  262. End Sub
  263.  
  264. Public Sub ApiMenu5_Click()
  265. GetNewDim 150
  266. ShowSized
  267. End Sub
  268.  
  269. Public Sub ApiMenu05_Click()
  270. GetNewDim 100
  271. ShowSized
  272. Thumbfrm2.Show 1
  273. End Sub
  274.  
  275. Public Sub ApiMenu6_Click()
  276. GetNewDim 200
  277. ShowSized
  278. End Sub
  279.  
  280. Public Sub ApiMenu06_Click()
  281. GetNewDim 75
  282. ShowSized
  283. Thumbfrm2.Show 1
  284. End Sub
  285.  
  286. Public Sub ApiMenu7_Click()
  287. GetNewDim 250
  288. ShowSized
  289. End Sub
  290.  
  291. Public Sub ApiMenu07_Click()
  292. GetNewDim 50
  293. ShowSized
  294. Thumbfrm2.Show 1
  295. End Sub
  296.  
  297. Public Sub ApiMenu8_Click()
  298. GetNewDim 300
  299. ShowSized
  300. End Sub
  301.  
  302. Public Sub ApiMenu08_Click()
  303. GetNewDim 25
  304. ShowSized
  305. Thumbfrm2.Show 1
  306. End Sub
  307.  
  308. Public Sub ApiMenu9_Click()
  309. Thumbfrm2.Hide
  310. End Sub
  311.  
  312. Public Sub ApiMenu10_Click()
  313. With ThumbFrm3
  314. .Label2.Caption = "Item: " & Idx + 1 & vbCr & vbCr
  315. .Label2.Caption = .Label2.Caption & "Filename: " & Info(Idx, 0) & vbCr
  316. .Label2.Caption = .Label2.Caption & "Filelength: " & Info(Idx, 1) & " bytes" & vbCr
  317. .Label2.Caption = .Label2.Caption & "Picture normal width: " & Info(Idx, 2) & vbCr
  318. .Label2.Caption = .Label2.Caption & "Picture normal height: " & Info(Idx, 3) & vbCr & vbCr
  319. .Label2.Caption = .Label2.Caption & "Current " & Thumbfrm2.Image1.ToolTipText & vbCr
  320. .Label2.Caption = .Label2.Caption & "Picture current width: " & Thumbfrm2.Image1.Width & vbCr
  321. .Label2.Caption = .Label2.Caption & "Picture current height: " & Thumbfrm2.Image1.Height & vbCr & vbCr
  322. .Label2.Caption = .Label2.Caption & "Last Modified: " & Info(Idx, 4) & vbCr
  323. ThumbFrm3.Show 1
  324. End With
  325. End Sub
  326.  
  327. Public Sub CreateApiMenu2()
  328. Dim hPopupMenu1 As Long
  329. Dim Menu4 As MENUITEMINFO
  330. Dim curpos As POINT_TYPE
  331. Dim menusel As Long
  332. Dim retval As Long
  333.  
  334. hPopupMenu1 = CreatePopupMenu()
  335.  
  336. With Menu4
  337. .cbSize = Len(Menu4)
  338. .fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE Or MIIM_SUBMENU ' Which elements of the structure to use.
  339. End With
  340.  
  341. With Menu4
  342. .fType = MFT_STRING
  343. .fState = MFS_ENABLED
  344. .wID = 1004
  345. .dwTypeData = "View full picture"
  346. .cch = Len("View full picture")
  347. .hSubMenu = 0
  348. End With
  349. retval = InsertMenuItem(hPopupMenu1, 0, 1, Menu4)
  350.  
  351. With Menu4
  352. .fType = MFT_SEPARATOR
  353. .fState = MFS_ENABLED
  354. .wID = 1003
  355. .dwTypeData = "/separator/"
  356. .cch = Len("/separator/")
  357. .hSubMenu = 0
  358. End With
  359. retval = InsertMenuItem(hPopupMenu1, 1, 1, Menu4)
  360.  
  361. With Menu4
  362. .fType = MFT_STRING
  363. .fState = MFS_ENABLED
  364. .wID = 1002
  365. .dwTypeData = "View 75%"
  366. .cch = Len("View 75%")
  367. .hSubMenu = 0
  368. End With
  369. retval = InsertMenuItem(hPopupMenu1, 2, 1, Menu4)
  370.  
  371. With Menu4
  372. .fType = MFT_STRING
  373. .fState = MFS_ENABLED
  374. .wID = 1001
  375. .dwTypeData = "View 50%"
  376. .cch = Len("View 50%")
  377. .hSubMenu = 0
  378. End With
  379. retval = InsertMenuItem(hPopupMenu1, 3, 1, Menu4)
  380.  
  381. With Menu4
  382. .fType = MFT_STRING
  383. .fState = MFS_ENABLED
  384. .wID = 1000
  385. .dwTypeData = "View 25%"
  386. .cch = Len("View 25%")
  387. .hSubMenu = 0
  388. End With
  389. retval = InsertMenuItem(hPopupMenu1, 4, 1, Menu4)
  390.  
  391. retval = GetCursorPos(curpos)
  392. menusel = TrackPopupMenu(hPopupMenu1, TPM_TOPALIGN Or TPM_NONOTIFY Or TPM_RETURNCMD Or TPM_RIGHTALIGN Or TPM_RIGHTBUTTON, curpos.X, curpos.Y, 0, ThumbFrm.hWnd, 0)
  393. retval = DestroyMenu(hPopupMenu1)
  394. Select Case menusel
  395. Case 1004
  396. Call ApiMenu05_Click
  397. Case 1002
  398. Call ApiMenu06_Click
  399. Case 1001
  400. Call ApiMenu07_Click
  401. Case 1000
  402. Call ApiMenu08_Click
  403. Case Else
  404. End Select
  405. End Sub
  406.  
  407.  
  408.  
  409.