home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD1279112172000.psc / frmView.frm (.txt) next >
Encoding:
Visual Basic Form  |  2000-12-17  |  8.4 KB  |  245 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  4. Begin VB.Form frmView 
  5.    BackColor       =   &H00000000&
  6.    Caption         =   "Viewer"
  7.    ClientHeight    =   5790
  8.    ClientLeft      =   60
  9.    ClientTop       =   345
  10.    ClientWidth     =   6270
  11.    Icon            =   "frmView.frx":0000
  12.    LinkTopic       =   "Form1"
  13.    OLEDropMode     =   1  'Manual
  14.    ScaleHeight     =   5790
  15.    ScaleWidth      =   6270
  16.    StartUpPosition =   2  'CenterScreen
  17.    Begin MSComDlg.CommonDialog cdlView 
  18.       Left            =   2880
  19.       Top             =   2640
  20.       _ExtentX        =   847
  21.       _ExtentY        =   847
  22.       _Version        =   393216
  23.       CancelError     =   -1  'True
  24.       Filter          =   "(Default type)"
  25.    End
  26.    Begin MSComctlLib.ProgressBar pbrView 
  27.       Height          =   195
  28.       Left            =   3660
  29.       TabIndex        =   2
  30.       Top             =   5580
  31.       Visible         =   0   'False
  32.       Width           =   2295
  33.       _ExtentX        =   4048
  34.       _ExtentY        =   344
  35.       _Version        =   393216
  36.       Appearance      =   0
  37.       Scrolling       =   1
  38.    End
  39.    Begin MSComctlLib.StatusBar sbrView 
  40.       Align           =   2  'Align Bottom
  41.       Height          =   255
  42.       Left            =   0
  43.       TabIndex        =   1
  44.       Top             =   5535
  45.       Width           =   6270
  46.       _ExtentX        =   11060
  47.       _ExtentY        =   450
  48.       _Version        =   393216
  49.       BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
  50.          NumPanels       =   3
  51.          BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  52.             Alignment       =   1
  53.             AutoSize        =   2
  54.             Bevel           =   2
  55.             Object.Width           =   3810
  56.             MinWidth        =   3810
  57.             Text            =   "Dimension"
  58.             TextSave        =   "Dimension"
  59.          EndProperty
  60.          BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  61.             Alignment       =   1
  62.             AutoSize        =   2
  63.             Bevel           =   2
  64.             Text            =   "Size"
  65.             TextSave        =   "Size"
  66.          EndProperty
  67.          BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  68.             AutoSize        =   1
  69.             Object.Width           =   4101
  70.             Picture         =   "frmView.frx":0442
  71.          EndProperty
  72.       EndProperty
  73.    End
  74.    Begin VB.PictureBox picView 
  75.       AutoSize        =   -1  'True
  76.       BackColor       =   &H00FFFFFF&
  77.       BorderStyle     =   0  'None
  78.       Height          =   3135
  79.       Index           =   0
  80.       Left            =   0
  81.       OLEDropMode     =   1  'Manual
  82.       ScaleHeight     =   3135
  83.       ScaleWidth      =   2655
  84.       TabIndex        =   0
  85.       Top             =   0
  86.       Visible         =   0   'False
  87.       Width           =   2655
  88.    End
  89.    Begin VB.Menu mnuPopup 
  90.       Caption         =   ""
  91.       Visible         =   0   'False
  92.       Begin VB.Menu mnuSave 
  93.          Caption         =   "Save &As..."
  94.       End
  95.       Begin VB.Menu mnuDump 
  96.          Caption         =   "&Dump it"
  97.       End
  98.       Begin VB.Menu mnuSep 
  99.          Caption         =   "-"
  100.       End
  101.       Begin VB.Menu mnuPics 
  102.          Caption         =   ""
  103.          Index           =   0
  104.          Visible         =   0   'False
  105.       End
  106.    End
  107. Attribute VB_Name = "frmView"
  108. Attribute VB_GlobalNameSpace = False
  109. Attribute VB_Creatable = False
  110. Attribute VB_PredeclaredId = True
  111. Attribute VB_Exposed = False
  112. Option Explicit
  113. Private totalPic As Integer
  114. Private lastIndex As Integer
  115. Private StartMove As Integer
  116. Private OldX As Single, OldY As Single
  117. Private Sub ViewPic(fName As String, Index As Integer)
  118. On Error GoTo errHandle
  119.     Load picView(Index)
  120.     picView(Index).Tag = fName
  121.     picView(Index) = LoadPicture(fName)
  122.     picView(Index).Visible = True
  123.     Load mnuPics(Index)
  124.     mnuPics(Index).Caption = Right(fName, Len(fName) - InStrRev(fName, "\"))
  125.     mnuPics(Index).Visible = True
  126.     Exit Sub
  127. errHandle:
  128.     MsgBox Err.Description + ": " + fName, vbCritical
  129.     If picView(Index).Picture = 0 Then Unload picView(Index)
  130.     Exit Sub
  131. End Sub
  132. Private Sub Form_Load()
  133. On Error Resume Next
  134.     If App.PrevInstance = True Then End
  135.     If Command = "" Then Exit Sub
  136.     Dim files() As String, pos As Integer
  137.     files = Split(Command)
  138.     For pos = 0 To UBound(files)
  139.         ViewPic files(pos), pos + 1
  140.     Next
  141.     totalPic = UBound(files) + 1
  142.     If Err Then MsgBox Err.Description, vbCritical
  143. End Sub
  144. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  145.     If Button = vbRightButton And mnuPics.Count > 1 Then
  146.         mnuSave.Visible = False
  147.         mnuDump.Visible = False
  148.         mnuSep.Visible = False
  149.         PopupMenu mnuPopup
  150.     End If
  151. End Sub
  152. Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
  153. On Error Resume Next
  154.     pbrView.Visible = True
  155.     pbrView.Max = Data.files.Count
  156.     Dim i As Integer
  157.     For i = 1 To Data.files.Count
  158.         ViewPic Data.files(i), totalPic + i
  159.         pbrView.Value = i
  160.     Next
  161.     totalPic = totalPic + Data.files.Count
  162.     pbrView.Visible = False
  163.     pbrView.Value = 0
  164. If Err Then MsgBox Err.Description, vbCritical
  165. End Sub
  166. Private Sub Form_Resize()
  167. On Error Resume Next
  168.     If WindowState <> vbMinimized Then
  169.         pbrView.Move 3660, ScaleHeight - 210
  170.         pbrView.Width = ScaleWidth - 3660 - 315
  171.     End If
  172. End Sub
  173. Private Sub mnuDump_Click()
  174.     Unload picView(lastIndex)
  175.     Unload mnuPics(lastIndex)
  176.     lastIndex = 0
  177.     If picView.Count = 1 Then
  178.         Caption = "Viewer"
  179.         sbrView.Panels(1).Text = "Dimension"
  180.         sbrView.Panels(2).Text = "Size"
  181.     End If
  182. End Sub
  183. Private Sub mnuPics_Click(Index As Integer)
  184.     picView(Index).ZOrder
  185.     sbrView.ZOrder
  186.     pbrView.ZOrder
  187.     mnuPics(Index).Checked = True
  188.     mnuPics(lastIndex).Checked = False
  189.     lastIndex = Index
  190. End Sub
  191. Private Sub mnuSave_Click()
  192. On Error GoTo errHandle
  193.     cdlView.Flags = cdlOFNCreatePrompt + cdlOFNExplorer + cdlOFNHideReadOnly + _
  194.         cdlOFNLongNames + cdlOFNOverwritePrompt
  195.     cdlView.FileName = Right(picView(lastIndex).Tag, Len(picView(lastIndex).Tag) - InStrRev(picView(lastIndex).Tag, "\"))
  196.     cdlView.ShowSave
  197.     SavePicture picView(lastIndex), cdlView.FileName
  198.     Exit Sub
  199. errHandle:
  200.     If Err <> 32755 Then MsgBox Err.Description, vbCritical
  201.     Exit Sub
  202. End Sub
  203. Private Sub picView_GotFocus(Index As Integer)
  204.     picView(Index).ZOrder
  205.     sbrView.ZOrder
  206.     pbrView.ZOrder
  207.     Caption = picView(Index).Tag
  208.     sbrView.Panels(1).Text = "Dimension: " & picView(Index).Width \ 16 & " x " & picView(Index).Height \ 16
  209. On Error Resume Next
  210.     Dim SizePic As Long, size As Long, unit As String
  211.     SizePic = FileLen(picView(Index).Tag)
  212.     size = IIf(SizePic \ 1024 > 1, SizePic \ 1024, SizePic)
  213.     unit = IIf(SizePic \ 1024 > 1, " KB", " Bytes")
  214.     sbrView.Panels(2).Text = "Size: " & Format(size, "#,##0") & unit
  215. End Sub
  216. Private Sub picView_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  217.     If Button = vbRightButton Then
  218.         mnuSave.Visible = True
  219.         mnuDump.Visible = True
  220.         mnuSep.Visible = True
  221.         picView(Index).ZOrder
  222.         sbrView.ZOrder
  223.         pbrView.ZOrder
  224.         mnuPics(Index).Checked = True
  225.         mnuPics(lastIndex).Checked = False
  226.         lastIndex = Index
  227.         PopupMenu mnuPopup
  228.     ElseIf Button = vbLeftButton Then
  229.         StartMove = True
  230.         OldX = X
  231.         OldY = Y
  232.     End If
  233. End Sub
  234. Private Sub picView_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  235.     If StartMove And Button = vbLeftButton Then
  236.         picView(Index).Move picView(Index).Left + (X - OldX), picView(Index).Top + (Y - OldY)
  237.     End If
  238. End Sub
  239. Private Sub picView_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  240.     StartMove = False
  241. End Sub
  242. Private Sub picView_OLEDragDrop(Index As Integer, Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
  243.     Form_OLEDragDrop Data, Effect, Button, Shift, X, Y
  244. End Sub
  245.