home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Thumbnails2102052162008.psc / ucThumbNails / Form1.frm next >
Text File  |  2008-02-09  |  13KB  |  442 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BackColor       =   &H00E0E0E0&
  4.    Caption         =   "Demo of  ucThumbNails...."
  5.    ClientHeight    =   8715
  6.    ClientLeft      =   60
  7.    ClientTop       =   450
  8.    ClientWidth     =   8925
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   8715
  11.    ScaleWidth      =   8925
  12.    StartUpPosition =   2  'CenterScreen
  13.    Begin VB.CheckBox Check4 
  14.       BackColor       =   &H00E0E0E0&
  15.       Caption         =   "Picture Dimensions"
  16.       Height          =   210
  17.       Left            =   6315
  18.       TabIndex        =   21
  19.       Top             =   2805
  20.       Width           =   2085
  21.    End
  22.    Begin VB.CheckBox Check2 
  23.       BackColor       =   &H00E0E0E0&
  24.       Caption         =   "Rounded Corners"
  25.       Height          =   195
  26.       Left            =   6315
  27.       TabIndex        =   20
  28.       Top             =   3300
  29.       Width           =   1650
  30.    End
  31.    Begin VB.CheckBox Check1 
  32.       BackColor       =   &H00E0E0E0&
  33.       Caption         =   "Show Folder Info"
  34.       Height          =   225
  35.       Left            =   6315
  36.       TabIndex        =   16
  37.       Top             =   3045
  38.       Width           =   1635
  39.    End
  40.    Begin VB.CommandButton Command1 
  41.       Caption         =   "Browse For Folder"
  42.       Height          =   660
  43.       Left            =   6315
  44.       TabIndex        =   3
  45.       Top             =   1020
  46.       Width           =   2475
  47.    End
  48.    Begin VB.CommandButton Command2 
  49.       Caption         =   "Enter above Path"
  50.       Height          =   600
  51.       Left            =   6315
  52.       TabIndex        =   2
  53.       Top             =   2160
  54.       Width           =   2505
  55.    End
  56.    Begin VB.TextBox Text1 
  57.       Height          =   285
  58.       Left            =   6315
  59.       TabIndex        =   1
  60.       Top             =   1845
  61.       Width           =   2505
  62.    End
  63.    Begin Project1.ucThumbNails ucThumbNails1 
  64.       Height          =   7110
  65.       Left            =   60
  66.       TabIndex        =   0
  67.       Top             =   45
  68.       Width           =   6150
  69.       _ExtentX        =   10848
  70.       _ExtentY        =   12541
  71.       PicBoxBorderColor=   16711680
  72.       FontColor       =   255
  73.       BackColor       =   15790320
  74.       ShowFolderInfo  =   0   'False
  75.       ProBarColor     =   16744576
  76.       PicDimen        =   0   'False
  77.    End
  78.    Begin VB.Label Label15 
  79.       BackStyle       =   0  'Transparent
  80.       Caption         =   "Click on thumbnail to view preview. Double click on preview to close.      Left click and hold ,to drag preview."
  81.       Height          =   615
  82.       Left            =   6240
  83.       TabIndex        =   19
  84.       Top             =   7995
  85.       Width           =   2610
  86.    End
  87.    Begin VB.Image Image1 
  88.       Height          =   825
  89.       Left            =   6300
  90.       Picture         =   "Form1.frx":0000
  91.       Stretch         =   -1  'True
  92.       Top             =   135
  93.       Width           =   2535
  94.    End
  95.    Begin VB.Label Label14 
  96.       BackStyle       =   0  'Transparent
  97.       Caption         =   "PicBoxBackColor"
  98.       Height          =   195
  99.       Left            =   6990
  100.       TabIndex        =   18
  101.       Top             =   4980
  102.       Width           =   1275
  103.    End
  104.    Begin VB.Label Label13 
  105.       Appearance      =   0  'Flat
  106.       BackColor       =   &H80000005&
  107.       BorderStyle     =   1  'Fixed Single
  108.       ForeColor       =   &H80000008&
  109.       Height          =   315
  110.       Left            =   6285
  111.       TabIndex        =   17
  112.       Top             =   4905
  113.       Width           =   615
  114.    End
  115.    Begin VB.Label Label12 
  116.       BackStyle       =   0  'Transparent
  117.       Caption         =   "BackColor"
  118.       Height          =   210
  119.       Left            =   7005
  120.       TabIndex        =   15
  121.       Top             =   4215
  122.       Width           =   765
  123.    End
  124.    Begin VB.Label Label1 
  125.       Appearance      =   0  'Flat
  126.       BackColor       =   &H80000005&
  127.       BorderStyle     =   1  'Fixed Single
  128.       ForeColor       =   &H80000008&
  129.       Height          =   315
  130.       Left            =   6285
  131.       TabIndex        =   14
  132.       Top             =   4155
  133.       Width           =   615
  134.    End
  135.    Begin VB.Label Label11 
  136.       BackStyle       =   0  'Transparent
  137.       Caption         =   "Border Color"
  138.       Height          =   255
  139.       Left            =   6990
  140.       TabIndex        =   13
  141.       Top             =   4605
  142.       Width           =   945
  143.    End
  144.    Begin VB.Label Label10 
  145.       BackStyle       =   0  'Transparent
  146.       Caption         =   "FontColor"
  147.       Height          =   165
  148.       Left            =   7005
  149.       TabIndex        =   12
  150.       Top             =   3855
  151.       Width           =   735
  152.    End
  153.    Begin VB.Label Label9 
  154.       Appearance      =   0  'Flat
  155.       BackColor       =   &H80000005&
  156.       BorderStyle     =   1  'Fixed Single
  157.       ForeColor       =   &H80000008&
  158.       Height          =   315
  159.       Left            =   6285
  160.       TabIndex        =   11
  161.       Top             =   4530
  162.       Width           =   615
  163.    End
  164.    Begin VB.Label Label8 
  165.       Appearance      =   0  'Flat
  166.       BackColor       =   &H80000005&
  167.       BorderStyle     =   1  'Fixed Single
  168.       ForeColor       =   &H80000008&
  169.       Height          =   315
  170.       Left            =   6285
  171.       TabIndex        =   10
  172.       Top             =   3795
  173.       Width           =   615
  174.    End
  175.    Begin VB.Label Label7 
  176.       BackStyle       =   0  'Transparent
  177.       Caption         =   "Folder Path"
  178.       Height          =   195
  179.       Left            =   7035
  180.       TabIndex        =   9
  181.       Top             =   6015
  182.       Width           =   930
  183.    End
  184.    Begin VB.Label Label6 
  185.       Appearance      =   0  'Flat
  186.       BackColor       =   &H80000005&
  187.       BorderStyle     =   1  'Fixed Single
  188.       ForeColor       =   &H80000008&
  189.       Height          =   435
  190.       Left            =   6240
  191.       TabIndex        =   8
  192.       Top             =   6240
  193.       Width           =   2655
  194.    End
  195.    Begin VB.Label Label5 
  196.       BackStyle       =   0  'Transparent
  197.       Caption         =   "Selected File"
  198.       Height          =   180
  199.       Left            =   6960
  200.       TabIndex        =   7
  201.       Top             =   5415
  202.       Width           =   930
  203.    End
  204.    Begin VB.Label Label4 
  205.       BackStyle       =   0  'Transparent
  206.       Caption         =   "Full Path"
  207.       Height          =   210
  208.       Left            =   7185
  209.       TabIndex        =   6
  210.       Top             =   6720
  211.       Width           =   690
  212.    End
  213.    Begin VB.Label Label3 
  214.       Appearance      =   0  'Flat
  215.       BackColor       =   &H80000005&
  216.       BorderStyle     =   1  'Fixed Single
  217.       ForeColor       =   &H80000008&
  218.       Height          =   1020
  219.       Left            =   6240
  220.       TabIndex        =   5
  221.       Top             =   6930
  222.       Width           =   2640
  223.    End
  224.    Begin VB.Label Label2 
  225.       Alignment       =   2  'Center
  226.       Appearance      =   0  'Flat
  227.       BackColor       =   &H80000005&
  228.       BorderStyle     =   1  'Fixed Single
  229.       ForeColor       =   &H80000008&
  230.       Height          =   240
  231.       Left            =   6240
  232.       TabIndex        =   4
  233.       Top             =   5640
  234.       Width           =   2655
  235.    End
  236. End
  237. Attribute VB_Name = "Form1"
  238. Attribute VB_GlobalNameSpace = False
  239. Attribute VB_Creatable = False
  240. Attribute VB_PredeclaredId = True
  241. Attribute VB_Exposed = False
  242. Option Explicit
  243.   'FOR DEMO ONLY
  244.  Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
  245.    
  246.    Private Type CHOOSECOLOR
  247.    lStructSize As Long
  248.    hwndOwner As Long
  249.    hInstance As Long
  250.    rgbResult As Long
  251.    lpCustColors As String
  252.    flags As Long
  253.    lCustData As Long
  254.    lpfnHook As Long
  255.    lpTemplateName As String
  256. End Type
  257.  
  258. Dim cc As CHOOSECOLOR
  259.  
  260. Private Type BROWSEINFO
  261.     lngHwnd        As Long
  262.     pIDLRoot       As Long
  263.     pszDisplayName As Long
  264.     lpszTitle      As Long
  265.     ulFlags        As Long
  266.     lpfnCallback   As Long
  267.     lParam         As Long
  268.     iImage         As Long
  269. End Type
  270.  
  271. Private Const BIF_RETURNONLYFSDIRS = 1
  272. Private Const MAX_PATH = 260
  273.  
  274. Private Declare Sub CoTaskMemFree Lib "ole32.dll" _
  275.     (ByVal hMem As Long)
  276.  
  277. Private Declare Function lStrCat Lib "kernel32" _
  278.    Alias "lstrcatA" (ByVal lpString1 As String, _
  279.    ByVal lpString2 As String) As Long
  280.  
  281. Private Declare Function SHBrowseForFolder Lib "shell32" _
  282.    (lpbi As BROWSEINFO) As Long
  283.  
  284. Private Declare Function SHGetPathFromIDList Lib "shell32" _
  285.    (ByVal pidList As Long, ByVal lpBuffer As String) As Long
  286.    
  287. Public Function BrowseForFolder(ByVal lngHwnd As Long, ByVal strPrompt As String) As String
  288.  
  289.     On Error GoTo ehBrowseForFolder 'Trap for errors
  290.  
  291.     Dim intNull As Integer
  292.     Dim lngIDList As Long, lngResult As Long
  293.     Dim strPath As String
  294.     Dim udtBI As BROWSEINFO
  295.     
  296.     'Set API properties (housed in a UDT)
  297.     With udtBI
  298.         .lngHwnd = lngHwnd
  299.         .lpszTitle = lStrCat(strPrompt, "")
  300.         .ulFlags = BIF_RETURNONLYFSDIRS
  301.     End With
  302.  
  303.     'Display the browse folder...
  304.     lngIDList = SHBrowseForFolder(udtBI)
  305.  
  306.     If lngIDList <> 0 Then
  307.         'Create string of nulls so it will fill in with the path
  308.         strPath = String(MAX_PATH, 0)
  309.  
  310.         'Retrieves the path selected, places in the null
  311.          'character filled string
  312.         lngResult = SHGetPathFromIDList(lngIDList, strPath)
  313.  
  314.         'Frees memory
  315.         Call CoTaskMemFree(lngIDList)
  316.  
  317.         'Find the first instance of a null character,
  318.          'so we can get just the path
  319.         intNull = InStr(strPath, vbNullChar)
  320.         'Greater than 0 means the path exists...
  321.         If intNull > 0 Then
  322.             'Set the value
  323.             strPath = Left(strPath, intNull - 1)
  324.         End If
  325.     End If
  326.  
  327.     'Return the path name
  328.     BrowseForFolder = strPath
  329.     Exit Function 'Abort
  330.  
  331. ehBrowseForFolder:
  332.  
  333.     'Return no value
  334.     BrowseForFolder = Empty
  335.  
  336. End Function
  337.  
  338. Private Function ShowColor() As Long
  339.    
  340.    'set the structure size
  341.    cc.lStructSize = Len(cc)
  342.    'Set the owner
  343.    cc.hwndOwner = Form1.HWND
  344.    'set the application's instance
  345.    cc.hInstance = App.hInstance
  346.    'set the custom colors (converted to Unicode)
  347.    cc.lpCustColors = ""
  348.    'no extra flags
  349.    cc.flags = 0  'set to 0 = define custom colors unselected. 2= define custom colors selected
  350.    
  351.    'Show the 'Select Color'-dialog
  352.    If CHOOSECOLOR(cc) <> 0 Then
  353.       ShowColor = (cc.rgbResult)
  354.    Else
  355.       ShowColor = -1
  356.    End If
  357.    
  358. End Function
  359.  
  360. Private Sub Check1_Click()
  361.    If Check1.Value = Checked Then
  362.       ucThumbNails1.ShowFolderInfo = True
  363.    Else
  364.       ucThumbNails1.ShowFolderInfo = False
  365.    End If
  366. End Sub
  367.  
  368. Private Sub Check2_Click()
  369.    If Check2.Value = Checked Then
  370.      ucThumbNails1.RndCorners = True
  371.    Else
  372.      ucThumbNails1.RndCorners = False
  373.    End If
  374. End Sub
  375.  
  376. Private Sub Check4_Click()
  377.    If Check4.Value = Checked Then
  378.      ucThumbNails1.PicDimen = True
  379.    Else
  380.      ucThumbNails1.PicDimen = False
  381.    End If
  382. End Sub
  383.  
  384. Private Sub Command1_Click()
  385.    Label2.Caption = ""
  386.    Label3.Caption = ""
  387.    Label6.Caption = ""
  388.    ucThumbNails1.FolderPath = BrowseForFolder(Me.HWND, "Select a Folder")
  389. End Sub
  390.  
  391. Private Sub Command2_Click()
  392.    ucThumbNails1.FolderPath = Text1.Text
  393. End Sub
  394.  
  395. Private Sub Form_Load()
  396.    Label8.BackColor = ucThumbNails1.FontColor
  397.    Label9.BackColor = ucThumbNails1.PicBoxBorderColor
  398.    Label1.BackColor = ucThumbNails1.BackColor
  399.    Label13.BackColor = ucThumbNails1.PicBoxBackColor
  400.    Check1.Value = 1
  401.    Check4.Value = 1
  402. End Sub
  403.  
  404. Private Sub Label1_Click()  'FOR DEMO ONLY
  405. Dim sure As Long
  406. sure = ShowColor
  407. If sure = -1 Then Exit Sub
  408. Label1.BackColor = sure
  409. ucThumbNails1.BackColor = sure
  410. End Sub
  411.  
  412. Private Sub Label13_Click()   'FOR DEMO ONLY
  413. Dim sure As Long
  414. sure = ShowColor
  415. If sure = -1 Then Exit Sub
  416. Label13.BackColor = sure
  417. ucThumbNails1.PicBoxBackColor = sure
  418. End Sub
  419.  
  420. Private Sub Label8_Click()   'FOR DEMO ONLY
  421. Dim sure As Long
  422. sure = ShowColor
  423. If sure = -1 Then Exit Sub
  424. Label8.BackColor = sure
  425. ucThumbNails1.FontColor = sure
  426. End Sub
  427.  
  428. Private Sub Label9_Click()  'FOR DEMO ONLY
  429. Dim sure As Long
  430. sure = ShowColor
  431. If sure = -1 Then Exit Sub
  432. Label9.BackColor = sure
  433. ucThumbNails1.PicBoxBorderColor = sure
  434. End Sub
  435.  
  436. Private Sub ucThumbNails1_Click()
  437.    Label2.Caption = ucThumbNails1.SelectedFile
  438.    Label3.Caption = ucThumbNails1.FullPath
  439.    Label6.Caption = ucThumbNails1.FolderPath
  440. End Sub
  441.  
  442.