home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / Fast_Strin2133581192008.psc / basListView.bas < prev    next >
BASIC Source File  |  2008-11-04  |  6KB  |  170 lines
  1. Attribute VB_Name = "basListView"
  2. Option Explicit
  3.  
  4. ' Code by Randy Birch
  5.  
  6. Public Enum LedgerColours
  7.   vbLedgerWhite = &HF9FEFF
  8.   vbLedgerGreen = &HD0FFCC
  9.   vbLedgerYellow = &HE1FAFF
  10.   vbLedgerRed = &HE1E1FF
  11.   vbLedgerGrey = &HE0E0E0
  12.   vbLedgerbeige = &HD9F2F7
  13.   vbLedgerSoftWhite = &HF7F7F7
  14.   vbLedgerPureWhite = &HFFFFFF
  15.   vbLedgerLightBlue = &HFBC0A2
  16. End Enum
  17.  
  18. Public Enum ImageSizingTypes
  19.    [sizeNone] = 0
  20.    [sizeCheckBox]
  21.    [sizeIcon]
  22. End Enum
  23. ''''''this added extra D.Senthilathiban
  24. Public StopSearch As Boolean
  25. ''''''''''''''''''''''''''''''''''''''
  26. Public Sub SetListViewLedger(lv As ListView, _
  27.                               Bar1Color As LedgerColours, _
  28.                               Bar2Color As LedgerColours, _
  29.                               nSizingType As ImageSizingTypes)
  30.  
  31.    Dim iBarHeight  As Long  '/* height of 1 line in the listview
  32.    Dim lBarWidth   As Long  '/* width of listview
  33.    Dim diff        As Long  '/* used in calculations of row height
  34.    Dim twipsy      As Long  '/* variable holding Screen.TwipsPerPicture1elY
  35.    
  36.    iBarHeight = 0
  37.    lBarWidth = 0
  38.    diff = 0
  39.    
  40.    On Local Error GoTo SetListViewColor_Error
  41.    
  42.    twipsy = Screen.TwipsPerPixelY
  43.    
  44.    If lv.View = lvwReport Then
  45.    
  46.      '/* set up the listview properties
  47.       With lv
  48.         .Picture = Nothing  '/* clear picture
  49.         .Refresh
  50.         .Visible = 1
  51.         .PictureAlignment = lvwTile
  52.         lBarWidth = .Width
  53.       End With  ' lv
  54.         
  55.      '/* set up the picture box properties
  56.       With frmFileSearchCRC.Picture1
  57.          .AutoRedraw = False       '/* clear/reset picture
  58.          .Picture = Nothing
  59.          .BackColor = vbWhite
  60.          .Height = 1
  61.          .AutoRedraw = True        '/* assure image draws
  62.          .BorderStyle = vbBSNone   '/* other attributes
  63.          .ScaleMode = vbTwips
  64.          .Top = frmFileSearchCRC.Top - 10000  '/* move it way off screen
  65.          .Width = Screen.Width
  66.          .Visible = False
  67.          .Font = lv.Font           '/* assure Picture1 font matched listview font
  68.          
  69.         '/* match picture box font properties
  70.         '/* with those of listview
  71.          With .Font
  72.             .Bold = lv.Font.Bold
  73.             .Charset = lv.Font.Charset
  74.             .Italic = lv.Font.Italic
  75.             .Name = lv.Font.Name
  76.             .Strikethrough = lv.Font.Strikethrough
  77.             .Underline = lv.Font.Underline
  78.             .Weight = lv.Font.Weight
  79.             .Size = lv.Font.Size
  80.          End With  'Picture1.Font
  81.          
  82.         '/* here we calculate the height of each
  83.         '/* bar in the listview. Several things
  84.         '/*  can affect this height - the use
  85.         '/* of item icons, the size of those icons,
  86.         '/* the use of checkboxes and so on through
  87.         '/* all the permutations.
  88.         '/*
  89.         '/* Shown here is code sufficient to calculate
  90.         '/* this height based on three combinations of
  91.         '/*  data, state icons, and imagelist icons:
  92.         '/*
  93.         '/* 1. text only
  94.         '/* 2. text with checkboxes
  95.         '/* 3. text with icons
  96.         
  97.        '/* used by all sizing routines
  98.          iBarHeight = .TextHeight("W")
  99.  
  100.          Select Case nSizingType
  101.             Case sizeNone:
  102.               '/* 1. text only
  103.                iBarHeight = iBarHeight + twipsy
  104.                
  105.             Case sizeCheckBox:
  106.               '/* 2. text with checkboxes: add to textheight the
  107.               '/*    difference between 18 Pixels and iBarHeight
  108.               '/*    all calculated initially in Pixels,
  109.               '/*    then converted to twips
  110.                If (iBarHeight \ twipsy) > 18 Then
  111.                   iBarHeight = iBarHeight + twipsy
  112.                Else
  113.                   diff = 18 - (iBarHeight \ twipsy)
  114.                   iBarHeight = iBarHeight + (diff * twipsy) + (twipsy * 1)
  115.                End If
  116.                
  117.             Case sizeIcon:
  118.               '/* 3. text with icons: add to textheight the
  119.               '/*    difference between textheight and image
  120.               '/*    height, all calculated initially in Pixels,
  121.               '/*    then converted to twips. Handles 16x16 icons
  122.                'diff = imagelist1.ImageHeight - (iBarHeight \ twipsy)
  123.                'iBarHeight = iBarHeight + (diff * twipsy) + (twipsy * 1)
  124.                
  125.          End Select
  126.       
  127.         '/* since we need two-tone bars, the
  128.         '/* picturebox needs to be twice as high
  129.          .Height = iBarHeight * 2
  130.          .Width = lBarWidth
  131.          
  132.         '/* paint the two bars of color and refresh
  133.         '/* Note: The line method does not support
  134.         '/* With/End With blocks
  135.          frmFileSearchCRC.Picture1.Line (0, 0)-(lBarWidth, iBarHeight), Bar1Color, BF
  136.          frmFileSearchCRC.Picture1.Line (0, iBarHeight)-(lBarWidth, iBarHeight * 2), Bar2Color, BF
  137.       
  138.          .AutoSize = True
  139.          .Refresh
  140.          
  141.       End With  'Picture1
  142.      
  143.      '/* set the lv picture to the
  144.      '/* Picture1 image
  145.      
  146.       lv.Refresh
  147.       lv.Picture = frmFileSearchCRC.Picture1.Image
  148.       
  149.    Else
  150.     
  151.       lv.Picture = Nothing
  152.         
  153.    End If  'lv.View = lvwReport
  154.  
  155. SetListViewColor_Exit:
  156. On Local Error GoTo 0
  157. Exit Sub
  158.     
  159. SetListViewColor_Error:
  160.  
  161.   '/* clear the listview's picture and exit
  162.    With lv
  163.       .Picture = Nothing
  164.       .Refresh
  165.    End With
  166.    
  167.    Resume SetListViewColor_Exit
  168.     
  169. End Sub
  170.