home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD13317132001.psc / VbMenuTestForm.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-10-30  |  17.0 KB  |  549 lines
  1. VERSION 5.00
  2. Begin VB.Form StartUpForm 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "StartUpForm"
  5.    ClientHeight    =   3195
  6.    ClientLeft      =   165
  7.    ClientTop       =   735
  8.    ClientWidth     =   6195
  9.    KeyPreview      =   -1  'True
  10.    LinkTopic       =   "Form2"
  11.    ScaleHeight     =   3195
  12.    ScaleWidth      =   6195
  13.    StartUpPosition =   3  'Windows Default
  14.    WindowState     =   2  'Maximized
  15.    Begin VB.PictureBox CommonDialog1 
  16.       Height          =   480
  17.       Left            =   120
  18.       ScaleHeight     =   420
  19.       ScaleWidth      =   1140
  20.       TabIndex        =   18
  21.       Top             =   2280
  22.       Width           =   1200
  23.    End
  24.    Begin VB.PictureBox SysTrayPic 
  25.       AutoSize        =   -1  'True
  26.       Height          =   540
  27.       Index           =   11
  28.       Left            =   5280
  29.       ScaleHeight     =   480
  30.       ScaleWidth      =   480
  31.       TabIndex        =   17
  32.       Top             =   4200
  33.       Visible         =   0   'False
  34.       Width           =   540
  35.    End
  36.    Begin VB.PictureBox SysTrayPic 
  37.       AutoSize        =   -1  'True
  38.       Height          =   540
  39.       Index           =   10
  40.       Left            =   4800
  41.       ScaleHeight     =   480
  42.       ScaleWidth      =   480
  43.       TabIndex        =   16
  44.       Top             =   4200
  45.       Visible         =   0   'False
  46.       Width           =   540
  47.    End
  48.    Begin VB.PictureBox SysTrayPic 
  49.       AutoSize        =   -1  'True
  50.       Height          =   540
  51.       Index           =   9
  52.       Left            =   4320
  53.       ScaleHeight     =   480
  54.       ScaleWidth      =   480
  55.       TabIndex        =   15
  56.       Top             =   4200
  57.       Visible         =   0   'False
  58.       Width           =   540
  59.    End
  60.    Begin VB.PictureBox SysTrayPic 
  61.       AutoSize        =   -1  'True
  62.       Height          =   540
  63.       Index           =   8
  64.       Left            =   3840
  65.       ScaleHeight     =   480
  66.       ScaleWidth      =   480
  67.       TabIndex        =   14
  68.       Top             =   4200
  69.       Visible         =   0   'False
  70.       Width           =   540
  71.    End
  72.    Begin VB.PictureBox SysTrayPic 
  73.       AutoSize        =   -1  'True
  74.       Height          =   540
  75.       Index           =   7
  76.       Left            =   3360
  77.       ScaleHeight     =   480
  78.       ScaleWidth      =   480
  79.       TabIndex        =   13
  80.       Top             =   4200
  81.       Visible         =   0   'False
  82.       Width           =   540
  83.    End
  84.    Begin VB.PictureBox SysTrayPic 
  85.       AutoSize        =   -1  'True
  86.       Height          =   540
  87.       Index           =   6
  88.       Left            =   2880
  89.       ScaleHeight     =   480
  90.       ScaleWidth      =   480
  91.       TabIndex        =   12
  92.       Top             =   4200
  93.       Visible         =   0   'False
  94.       Width           =   540
  95.    End
  96.    Begin VB.PictureBox SysTrayPic 
  97.       AutoSize        =   -1  'True
  98.       Height          =   540
  99.       Index           =   5
  100.       Left            =   2400
  101.       ScaleHeight     =   480
  102.       ScaleWidth      =   480
  103.       TabIndex        =   11
  104.       Top             =   4200
  105.       Visible         =   0   'False
  106.       Width           =   540
  107.    End
  108.    Begin VB.PictureBox SysTrayPic 
  109.       AutoSize        =   -1  'True
  110.       Height          =   540
  111.       Index           =   4
  112.       Left            =   1920
  113.       ScaleHeight     =   480
  114.       ScaleWidth      =   480
  115.       TabIndex        =   10
  116.       Top             =   4200
  117.       Visible         =   0   'False
  118.       Width           =   540
  119.    End
  120.    Begin VB.PictureBox SysTrayPic 
  121.       AutoSize        =   -1  'True
  122.       Height          =   540
  123.       Index           =   3
  124.       Left            =   1440
  125.       ScaleHeight     =   480
  126.       ScaleWidth      =   480
  127.       TabIndex        =   9
  128.       Top             =   4200
  129.       Visible         =   0   'False
  130.       Width           =   540
  131.    End
  132.    Begin VB.PictureBox SysTrayPic 
  133.       AutoSize        =   -1  'True
  134.       Height          =   540
  135.       Index           =   2
  136.       Left            =   960
  137.       ScaleHeight     =   480
  138.       ScaleWidth      =   480
  139.       TabIndex        =   8
  140.       Top             =   4200
  141.       Visible         =   0   'False
  142.       Width           =   540
  143.    End
  144.    Begin VB.PictureBox SysTrayPic 
  145.       AutoSize        =   -1  'True
  146.       Height          =   540
  147.       Index           =   1
  148.       Left            =   480
  149.       ScaleHeight     =   480
  150.       ScaleWidth      =   480
  151.       TabIndex        =   7
  152.       Top             =   4200
  153.       Visible         =   0   'False
  154.       Width           =   540
  155.    End
  156.    Begin VB.PictureBox SysTrayPic 
  157.       AutoSize        =   -1  'True
  158.       Height          =   540
  159.       Index           =   0
  160.       Left            =   0
  161.       ScaleHeight     =   480
  162.       ScaleWidth      =   480
  163.       TabIndex        =   6
  164.       Top             =   4200
  165.       Visible         =   0   'False
  166.       Width           =   540
  167.    End
  168.    Begin VB.PictureBox Picture1 
  169.       Height          =   615
  170.       Left            =   480
  171.       ScaleHeight     =   555
  172.       ScaleWidth      =   1875
  173.       TabIndex        =   1
  174.       Top             =   0
  175.       Visible         =   0   'False
  176.       Width           =   1935
  177.       Begin VB.TextBox Text1 
  178.          BeginProperty Font 
  179.             Name            =   "MS Sans Serif"
  180.             Size            =   12
  181.             Charset         =   238
  182.             Weight          =   400
  183.             Underline       =   0   'False
  184.             Italic          =   0   'False
  185.             Strikethrough   =   0   'False
  186.          EndProperty
  187.          Height          =   495
  188.          Left            =   1440
  189.          TabIndex        =   2
  190.          Text            =   "8"
  191.          Top             =   0
  192.          Width           =   375
  193.       End
  194.       Begin VB.Label Label1 
  195.          Caption         =   "Delay in seconds"
  196.          Height          =   255
  197.          Left            =   120
  198.          TabIndex        =   3
  199.          Top             =   120
  200.          Width           =   1335
  201.       End
  202.    End
  203.    Begin VB.PictureBox FinalPicture 
  204.       AutoRedraw      =   -1  'True
  205.       BackColor       =   &H000000FF&
  206.       BorderStyle     =   0  'None
  207.       Height          =   4095
  208.       Left            =   960
  209.       ScaleHeight     =   4095
  210.       ScaleWidth      =   6015
  211.       TabIndex        =   0
  212.       Top             =   360
  213.       Width           =   6015
  214.       Begin VB.PictureBox PictContainer 
  215.          BorderStyle     =   0  'None
  216.          Height          =   1335
  217.          Left            =   480
  218.          ScaleHeight     =   1335
  219.          ScaleWidth      =   1575
  220.          TabIndex        =   5
  221.          Top             =   2520
  222.          Visible         =   0   'False
  223.          Width           =   1575
  224.          Begin VB.Timer Timer2 
  225.             Enabled         =   0   'False
  226.             Interval        =   1000
  227.             Left            =   360
  228.             Top             =   600
  229.          End
  230.       End
  231.       Begin VB.PictureBox Picture3 
  232.          AutoRedraw      =   -1  'True
  233.          BorderStyle     =   0  'None
  234.          Height          =   1335
  235.          Left            =   1680
  236.          ScaleHeight     =   1335
  237.          ScaleWidth      =   2775
  238.          TabIndex        =   4
  239.          Top             =   120
  240.          Visible         =   0   'False
  241.          Width           =   2775
  242.       End
  243.       Begin VB.Shape Shape1 
  244.          BorderColor     =   &H000000FF&
  245.          BorderWidth     =   2
  246.          Height          =   135
  247.          Left            =   2400
  248.          Top             =   1680
  249.          Visible         =   0   'False
  250.          Width           =   135
  251.       End
  252.       Begin VB.Image Image1 
  253.          Height          =   1575
  254.          Index           =   0
  255.          Left            =   0
  256.          Stretch         =   -1  'True
  257.          Top             =   840
  258.          Visible         =   0   'False
  259.          Width           =   2175
  260.       End
  261.    End
  262.    Begin VB.Image Image2 
  263.       Height          =   480
  264.       Left            =   6840
  265.       Stretch         =   -1  'True
  266.       Top             =   840
  267.       Visible         =   0   'False
  268.       Width           =   480
  269.    End
  270.    Begin VB.Menu PicMnu 
  271.       Caption         =   "PicMnu"
  272.       Begin VB.Menu LetMouseGo 
  273.          Caption         =   "Let mouse go"
  274.       End
  275.       Begin VB.Menu DeleteImage 
  276.          Caption         =   "Delete image"
  277.       End
  278.       Begin VB.Menu SaveImage 
  279.          Caption         =   "Save image"
  280.       End
  281.       Begin VB.Menu ResizeImage 
  282.          Caption         =   "Resize image(shrink)"
  283.       End
  284.       Begin VB.Menu MoveImage 
  285.          Caption         =   "Move image"
  286.       End
  287.       Begin VB.Menu GoGetAnotherPicture 
  288.          Caption         =   "Go get another picture"
  289.       End
  290.    End
  291.    Begin VB.Menu FormMnu 
  292.       Caption         =   "FormMnu"
  293.       Begin VB.Menu GoGetNewPictureNoDelay 
  294.          Caption         =   "Go get new picture"
  295.       End
  296.       Begin VB.Menu GoGetPic 
  297.          Caption         =   "Go get new picture (10 sec. delay)"
  298.       End
  299.       Begin VB.Menu SaveEntireScreenShot 
  300.          Caption         =   "Save entire screen shot"
  301.       End
  302.       Begin VB.Menu CutOutAndSave 
  303.          Caption         =   "Cut out and save"
  304.       End
  305.       Begin VB.Menu ExitMe 
  306.          Caption         =   "Exit"
  307.       End
  308.    End
  309. Attribute VB_Name = "StartUpForm"
  310. Attribute VB_GlobalNameSpace = False
  311. Attribute VB_Creatable = False
  312. Attribute VB_PredeclaredId = True
  313. Attribute VB_Exposed = False
  314. Dim a ' to show count down in forms caption bar
  315. Dim mouseexit As Boolean 'avoid some problems at interaction of menu and my bas
  316. Dim CutCounting As Boolean 'vil break counting if user click in systray
  317. Dim ImageIdentifier As Byte ' images index
  318. Dim ImageDeleted As Boolean ' prevents capturing mouse into disappeard image
  319. Dim BeenThere As Boolean
  320. Private Sub DeleteImage_Click()
  321. Unload Image1(ImageIdentifier)
  322. ImageDeleted = True
  323. End Sub
  324. Private Sub ExitMe_Click()
  325. End Sub
  326. Private Sub FinalPicture_Click()
  327. Select Case ActionTaken
  328. Case "GLUER"
  329. NumberOfLoadedImages = NumberOfLoadedImages + 1
  330. Load Image1(NumberOfLoadedImages)
  331. 'Picture3.Visible = False
  332. DoEvents
  333. 'Set FinalPicture.Picture = hDCToPicture(GetDC(Picture3.hwnd), (startX / Screen.TwipsPerPixelX), (startY / Screen.TwipsPerPixelY), (Picture3.Width / Screen.TwipsPerPixelX), (Picture3.Height / Screen.TwipsPerPixelY))
  334. Image1(NumberOfLoadedImages).Width = Picture3.Width
  335. Image1(NumberOfLoadedImages).Height = Picture3.Height
  336. Image1(NumberOfLoadedImages).Top = Picture3.Top
  337. Image1(NumberOfLoadedImages).Left = Picture3.Left
  338. Image1(NumberOfLoadedImages).Picture = Picture3.Picture
  339. Picture3.Visible = False
  340. Image1(NumberOfLoadedImages).Visible = True
  341. ActionTaken = "NONE"
  342. Case "NONE"
  343. ClipCursor ByVal 0&
  344. PopupMenu FormMnu
  345. ExitMe.Visible = True
  346. Case Else
  347. End Select
  348. 'Me.MousePointer = 0
  349. 'ActionTaken = "NONE"
  350. End Sub
  351. Private Sub Form_Activate()
  352. 'Dim c As control
  353. 'For Each c In Me
  354. 'If TypeOf c Is Menu Then
  355. '          If c.Visible = False Then
  356. '          List1.AddItem c.Caption
  357. '          End If
  358. 'End If
  359. 'Next
  360. FinalPicture.SetFocus
  361. End Sub
  362. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  363. If ActionTaken = "RESIZER" Then
  364.                  Select Case KeyCode
  365.                  Case vbKeyDown
  366.                  Image1(ImageIdentifier).Height = Image1(ImageIdentifier).Height - Screen.TwipsPerPixelY
  367.                  Case vbKeyUp
  368.                  Image1(ImageIdentifier).Height = Image1(ImageIdentifier).Height + Screen.TwipsPerPixelY
  369.                  Case vbKeyRight
  370.                  Image1(ImageIdentifier).Width = Image1(ImageIdentifier).Width + Screen.TwipsPerPixelX
  371.                  Case vbKeyLeft
  372.                  Image1(ImageIdentifier).Width = Image1(ImageIdentifier).Width - Screen.TwipsPerPixelX
  373.                  Case Else
  374.                  End Select
  375. End If
  376. End Sub
  377. Private Sub Form_Load()
  378. '-----------------------------------
  379. ActionTaken = "NONE"
  380. '-----------------------------------
  381. Me.Left = 0
  382. Me.Top = 0
  383. Me.Width = Screen.Width
  384. Me.Height = Screen.Height
  385. FinalPicture.Top = 0
  386. FinalPicture.Left = 0
  387. FinalPicture.Width = Me.Width
  388. FinalPicture.Height = Me.Height
  389. SystemTrayIcon SysTrayPic(11), Me, "ADD"
  390. CommonDialog1.InitDir = App.Path
  391. End Sub
  392. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  393. SystemTrayIcon SysTrayPic(11), Me, "DELETE"
  394. End Sub
  395. Private Sub GoGetAnotherPicture_Click()
  396. GoGetPic_Click
  397. End Sub
  398. Private Sub GoGetNewPictureNoDelay_Click()
  399. mouseexit = True
  400. ClipCursor ByVal 0
  401. 'DO STUFF TO GLUE THINGS INTO OUR PICTURE
  402. ActionTaken = "GLUER"
  403. a = 0 'count down
  404. Me.Hide
  405. 'do stuff
  406. Me.Visible = False
  407. Picture1.Visible = False
  408. Form1.Show
  409. Load Form1
  410. DoEvents
  411. End Sub
  412. Private Sub GoGetPic_Click()
  413. mouseexit = True
  414. ClipCursor ByVal 0
  415. 'DO STUFF TO GLUE THINGS INTO OUR PICTURE
  416. ActionTaken = "GLUER"
  417. a = 0 'count down
  418. Me.Hide
  419. 'Timer1.Interval = Text1.Text * 1000
  420. Timer2.Interval = 1000
  421. Timer2.Enabled = True 'will count down
  422. Me.Visible = False
  423. End Sub
  424. Private Sub Image1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  425. Select Case Button
  426.   Case 2 'left click exit image
  427.   'ClipCursor ByVal 0
  428.   Case 1
  429.   ImageIdentifier = Index
  430.   ActionTaken = "NONE"
  431.   Me.MousePointer = 0
  432.   PopupMenu PicMnu
  433.   If mouseexit = True Or ImageDeleted = True Then GoTo Skip
  434.   MCCaptureMouseCursorIntoNestedArea StartUpForm, FinalPicture, Image1(Index)
  435. Skip:
  436. mouseexit = False
  437. ImageDeleted = False
  438.   Case Else
  439.   End Select
  440. End Sub
  441. Private Sub LetMouseGo_Click()
  442. mouseexit = True
  443. ClipCursor ByVal 0
  444. End Sub
  445. Private Sub FinalPicture_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  446. Select Case ActionTaken
  447. Case "GLUER"
  448. Picture3.Left = X - 1
  449. Picture3.Top = Y - 1
  450. startX = X
  451. startY = Y
  452. Case Else
  453. End Select
  454. End Sub
  455. Private Sub MoveImage_Click()
  456. 'take it up into picturebox
  457. Picture3.Width = Image1(ImageIdentifier).Width
  458. Picture3.Height = Image1(ImageIdentifier).Height
  459. Set Picture3.Picture = Image1(ImageIdentifier).Picture
  460. Picture3.ZOrder 0
  461. 'delete it from current position
  462. DeleteImage_Click
  463. 'enable pic3 to be moved together with mouse
  464. Picture3.Visible = True
  465. Picture3.Refresh
  466. ActionTaken = "GLUER"
  467. End Sub
  468. Private Sub Picture3_Click()
  469. Select Case ActionTaken
  470. Case "GLUER"
  471. NumberOfLoadedImages = NumberOfLoadedImages + 1
  472. Load Image1(NumberOfLoadedImages)
  473. 'Picture3.Visible = False
  474. DoEvents
  475. 'Set FinalPicture.Picture = hDCToPicture(GetDC(Picture3.hwnd), (startX / Screen.TwipsPerPixelX), (startY / Screen.TwipsPerPixelY), (Picture3.Width / Screen.TwipsPerPixelX), (Picture3.Height / Screen.TwipsPerPixelY))
  476. Image1(NumberOfLoadedImages).Width = Picture3.Width
  477. Image1(NumberOfLoadedImages).Height = Picture3.Height
  478. Image1(NumberOfLoadedImages).Top = Picture3.Top
  479. Image1(NumberOfLoadedImages).Left = Picture3.Left
  480. Image1(NumberOfLoadedImages).Picture = Picture3.Picture
  481. Picture3.Visible = False
  482. Image1(NumberOfLoadedImages).Visible = True
  483. ActionTaken = "NONE"
  484. Case Else
  485. End Select
  486. Me.MousePointer = 0
  487. End Sub
  488. Private Sub Picture3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  489. Select Case ActionTaken
  490. Case "GLUER"
  491. Picture3.Left = X + Picture3.Left
  492. Picture3.Top = Y + Picture3.Top
  493. startX = X
  494. startY = Y
  495. Case Else
  496. End Select
  497. End Sub
  498. Private Sub ResizeImage_Click()
  499.   'MCCaptureMouseCursorIntoNestedArea Me, FinalPicture, Image1(ImageIdentifier)
  500. 'Me.MousePointer = 15
  501. 'Me.MouseIcon = Image2.Picture
  502. ActionTaken = "RESIZER" 'effect in mouse move - finalpicture
  503. End Sub
  504. Private Sub SaveEntireScreenShot_Click()
  505. On Error GoTo ErrHandler
  506. CommonDialog1.ShowSave
  507. 'without following line nothing right is saved !
  508. DoEvents
  509. Set Me.FinalPicture.Picture = hDCToPicture(GetDC(FinalPicture.hWnd), (0 / Screen.TwipsPerPixelX), (0 / Screen.TwipsPerPixelY), (Me.Width / Screen.TwipsPerPixelX), (Me.Height / Screen.TwipsPerPixelY))
  510. SavePicture FinalPicture.Image, CommonDialog1.FileName
  511. Exit Sub
  512. ErrHandler:  'User pressed the Cancel button
  513. End Sub
  514. Private Sub SaveImage_Click()
  515. On Error GoTo ErrHandler
  516. CommonDialog1.ShowSave
  517. SavePicture Image1(ImageIdentifier).Picture, CommonDialog1.FileName
  518. Exit Sub
  519. ErrHandler:  'User pressed the Cancel button
  520. End Sub
  521. Private Sub SysTrayPic_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  522. Dim Msg As Long
  523. Msg = (X And &HFF) * &H100
  524. Select Case Msg
  525.        Case 3840 'click
  526.        CutCounting = True
  527.        Case Else
  528. End Select
  529. End Sub
  530. Private Sub Timer2_Timer()
  531. If CutCounting = True Then GoTo ExitThisSub
  532. 'count
  533. SysTrayPic(11).Picture = SysTrayPic(Text1.Text - a).Picture
  534. DoEvents
  535. SystemTrayIcon SysTrayPic(11), Me, "MODIFY"
  536. a = a + 1
  537. If a > (Text1.Text) Then
  538. ExitThisSub:
  539. CutCounting = False
  540. Timer2.Enabled = False
  541. 'do stuff
  542. Me.Visible = False
  543. Picture1.Visible = False
  544. Form1.Show
  545. Load Form1
  546. Exit Sub
  547. End If
  548. End Sub
  549.