Programmer 7500/MAX_PROGRAMMERS.iso/VISUAL_B/CODIGO_1/FOLDER/FOLDERS.BAS

BASIC Source File | 1994-05-30 | 11.1 KB | 379 lines

Option Explicit

Const TabOffsetConstant = 4

Dim Folders() As Control      ' Array of the form's folders
Global FolderNum As Integer   ' Current active folder
Global NumFolders As Integer  ' Total number of folders

Dim VisibleTabs As Integer    ' Number of tabs across screen
Dim OneTabHeight As Integer   ' Height of one row of tabs
Dim FolderTabs As Control     ' Picture to paint tabs on
Dim TabWidth As Long          ' Tab width
Dim NumRows As Integer        ' Number of rows of tabs
Dim TabOffset As Integer      ' # of pixels for tab's diagonal
Dim TabOffsetX As Integer     ' Offset translated to x-twips
Dim TabOffsetY As Integer     ' Offset translated to y-twips

'Used for border/menu sizes
Declare Function GetSystemMetrics% Lib "User" (ByVal nIndex%)
'Used to see if menu is used
Declare Function GetMenu Lib "User" (ByVal hWnd%) As Integer

' Locate the folder controls
' Set the Folders array to point to the folders
' Modify each folder to match the first folder (index=0)
Function DefineFolders (NumAcross As Integer, Fldr As Control, FolderTabControl As Control) As Integer
Dim I As Integer

  ' Find out how many folders in an array are on the form
  ' Done by checking each control to see if it is a folder
  '   and then checking each folder to see if it has an index
  '   value (part of an array of folders)
  NumFolders = 0
  On Error GoTo NoIndex
  For I = 0 To Fldr.Parent.Controls.Count - 1
    If TypeOf Fldr.Parent.Controls(I) Is Frame Then
      If Not Fldr.Parent.Controls(I).Index >= 0 Then
    ' Fill Space
      Else
    If Fldr.Parent.Controls(I).Index > NumFolders Then NumFolders = Fldr.Parent.Controls(I).Index
      End If
    End If
  Next I
  On Error GoTo 0

  ' Fill the Folders array with pointers to the folder
  '   on the form
  ' Done by the same loop as last time, but this time
  '   I assign it to an array
  ReDim Folders(NumFolders)
  On Error GoTo NoIndex
  For I = 0 To Fldr.Parent.Controls.Count - 1
    If TypeOf Fldr.Parent.Controls(I) Is Frame Then
      If Not Fldr.Parent.Controls(I).Index >= 0 Then
    'Fill Space
      Else
    On Error GoTo 0
    Set Folders(Fldr.Parent.Controls(I).Index) = Fldr.Parent.Controls(I)
    On Error GoTo NoIndex
      End If
    End If
  Next I
  On Error GoTo 0

  ' Define Standard variables
  If NumAcross = 0 Then
    VisibleTabs = NumFolders + 1
  Else
    VisibleTabs = NumAcross
  End If
  TabOffset = TabOffsetConstant
  SetTabOffset -TabOffset

  'Modify all the folders to match folder0
  For I = 0 To NumFolders
    Folders(I).Top = Folders(0).Top
    Folders(I).Left = Folders(0).Left
    Folders(I).Width = Folders(0).Width
    Folders(I).Height = Folders(0).Height
    Folders(I).BackColor = Folders(0).BackColor
    Folders(I).Tag = Folders(I).Caption
    Folders(I).FontBold = False
    Folders(I).FontItalic = Folders(0).FontItalic
    Folders(I).FontName = Folders(0).FontName
    Folders(I).FontSize = Folders(0).FontSize
    Folders(I).FontStrikethru = Folders(0).FontStrikethru
    Folders(I).FontUnderline = Folders(0).FontUnderline
    Folders(I).ForeColor = Folders(0).ForeColor
    Folders(I).Visible = True
    Folders(I).ZOrder 1
  Next I
  FolderNum = 0  ' Start with the first folder highlighted
         ' If you want a different first folder, use
         '   the GotoFolder function right after you
         '   use DefineFolders

  'Fldr.Parent.Show
  DefineTabs FolderTabControl   ' Configure the tab picture box
  Call ShowFolder  ' Move the first folder to the top

  Exit Function
NoIndex:
  Resume Next

End Function

' Initialize the picture box that the
'   folder tabs are drawn in
Private Sub DefineTabs (FolderTabControl As Control)

  ' Calculate the number of rows needed to display all tabs
  NumRows = NumFolders \ VisibleTabs + 1

  ' Set the picture box's properties
  Set FolderTabs = FolderTabControl
  FolderTabs.AutoSize = False
  FolderTabs.ScaleMode = 1
  FolderTabs.Left = Folders(0).Left
  FolderTabs.Width = Folders(0).Width
  TabWidth = (FolderTabs.Width \ VisibleTabs)
  FolderTabs.AutoRedraw = True
  FolderTabs.BackColor = Folders(0).BackColor
  FolderTabs.BorderStyle = 0
  FolderTabs.DragMode = 0
  FolderTabs.Enabled = True
  FolderTabs.FillStyle = 0
  FolderTabs.DrawStyle = 0
  FolderTabs.FontBold = Folders(0).FontBold
  FolderTabs.FontBold = Folders(0).FontBold
  FolderTabs.FontItalic = Folders(0).FontItalic
  FolderTabs.FontName = Folders(0).FontName
  FolderTabs.FontSize = Folders(0).FontSize
  FolderTabs.FontStrikethru = Folders(0).FontStrikethru
  FolderTabs.FontUnderline = Folders(0).FontUnderline
  FolderTabs.ForeColor = Folders(0).ForeColor
  FolderTabs.LinkMode = 0
  FolderTabs.MousePointer = 0
  FolderTabs.TabStop = False
  FolderTabs.Visible = True
  FolderTabs.ZOrder 0


  ' Calculate the tab height based on the height of a sample
  '   letter + the offset height
  OneTabHeight = (FolderTabs.TextHeight("X") + TabOffsetY)
  FolderTabs.Height = OneTabHeight * NumRows
  FolderTabs.Top = Folders(0).Top - FolderTabs.Height + OneTabHeight

End Sub

' Draws a single folder tab
' TabNumber = the tab that is being drawn
' HorPos = the tabs horizontal position on the folders
' VerPos = the row the tab is on
' Foreground = True if it is the currently selected tab
Private Sub DrawTab (TabNumber As Integer, HorPos As Integer, VerPos As Integer, ForeGround As Integer)
Dim TabTextWidth As Long
Dim L%, R%, T%, B%

  ' Set the Top/Bottom/Left/Right values of the single tab
  T = FolderTabs.Height - VerPos * OneTabHeight
  B = T + OneTabHeight - TwipsY(1)
  L = TabWidth * HorPos
  R = L + TabWidth - TwipsX(1)

  ' Draw the lines around the tab
  FolderTabs.Line (L, B)-(L, T + TabOffsetY), 0

  ' If you reverse the comments in the next three lines, you will
  '   get a rounded top-left corner (not very noticable)
  'FolderTabs.Circle Step(TabOffsetX, 0), TabOffsetX, 0, 3.141 / 2, 3.141
  'FolderTabs.CurrentY = T
  FolderTabs.Line -(L + TabOffsetX, T), 0

  FolderTabs.Line -(R - TabOffsetX, T), 0

  ' If you reverse the comments in the next three lines, you will
  '   get a rounded top-right corner (not very noticable)
  'FolderTabs.Circle Step(0, TabOffsetY), TabOffsetX, 0, 0, 3.141 / 2
  'FolderTabs.CurrentX = R
  FolderTabs.Line -(R, T + TabOffsetY), 0

  FolderTabs.Line -(R, B), 0

  ' If it is the selected folder, draw a blank line underneath
  If ForeGround Then FolderTabs.Line -(L, B), FolderTabs.BackColor

  ' Print the tab's title (bold if foreground)
  FolderTabs.FontBold = ForeGround
  TabTextWidth = FolderTabs.TextWidth(Folders(TabNumber).Caption)
  FolderTabs.CurrentX = (TabWidth * HorPos) + (TabWidth \ 2) - (TabTextWidth \ 2)
  FolderTabs.CurrentY = T + (TabOffsetY \ 2)
  FolderTabs.Print Folders(TabNumber).Caption
  FolderTabs.FontBold = False

End Sub

' Draws each of the visible tabs on screen
Private Sub DrawTabs ()
Dim I As Integer

  FolderTabs.Cls

  ' Draws the lines below the tabs first
  For I = 1 To NumRows
    FolderTabs.Line (0, I * OneTabHeight - TwipsY(1))-(FolderTabs.Width, I * OneTabHeight - TwipsY(1)), 0
  Next I

  ' Draw each tab
  For I = 0 To NumFolders
    DrawTab I, HorTabPos(I), VerTabPos(I), I = FolderNum
  Next I

  ' Draw lines down the left and right side
  FolderTabs.Line (0, TabOffsetY)-(0, FolderTabs.Height - TwipsY(1)), 0
  FolderTabs.Line (FolderTabs.Width - TwipsX(1), FolderTabs.Height - TwipsY(1))-(FolderTabs.Width - TwipsX(1), OneTabHeight - TwipsY(1)), 0

End Sub

' Jump to the folder tab that was clicked on
' This is called by the Tab picture box's MouseDown procedure
Sub FolderClick (Button As Integer, X As Single, Y As Single)
Dim HorPos As Integer
Dim VerPos As Integer


  HorPos = X \ (FolderTabs.Width \ VisibleTabs)
  VerPos = NumRows - (Y \ (FolderTabs.Height \ NumRows)) - 1
  VerPos = (VerPos + (FolderNum \ VisibleTabs + 1)) Mod NumRows - 1
  If VerPos = -1 Then VerPos = NumRows - 1

  GotoFolder (VerPos * VisibleTabs) + HorPos

End Sub

' Make FolderNumber the active folder
Sub GotoFolder (FolderNumber As Integer)

  If (FolderNumber >= 0) And (FolderNumber <= NumFolders) Then FolderNum = FolderNumber
  ShowFolder

End Sub

' Calculate the column of a particular tab
Private Function HorTabPos (TN As Integer) As Integer

  HorTabPos = TN Mod VisibleTabs

End Function

' Moves to the next folder
Sub NextFolder ()

  FolderNum = ((FolderNum + 1) Mod (NumFolders + 1))
  ShowFolder

End Sub

' Move to the previous folder
Sub PrevFolder ()

  If FolderNum = 0 Then
    FolderNum = NumFolders
  Else
    FolderNum = FolderNum - 1
  End If
  ShowFolder

End Sub

' Calculates the Twips ratio of TabOffset
Private Sub SetTabOffset (Offset As Integer)

  TabOffset = Abs(Offset)
  TabOffsetX = TwipsX(CLng(TabOffset))
  TabOffsetY = TwipsY(CLng(TabOffset))
  If Offset >= 0 Then DrawTabs

End Sub

' Makes the current folder visible
' Then updates the tabs
Private Sub ShowFolder ()
Dim I As Integer

  For I = 0 To NumFolders
    Folders(I).Visible = (I = FolderNum)
  Next I
  Call DrawTabs

End Sub

' Moves the whole tab thingy to the top left corner of the
'   form, and then shrinks the form to fit perfectly.
Sub TightenForm ()
Dim SB As Long
Dim CH As Integer
Dim MH As Integer
Dim OY As Long, OX As Long

  FolderTabs.Left = 0
  FolderTabs.Top = 0
  Folders(0).Left = 0
  Folders(0).Top = OneTabHeight * (NumRows - 1)
  For CH = 1 To NumFolders
    Folders(CH).Left = 0
    Folders(CH).Top = Folders(0).Top
  Next CH

  ' Find the height of the caption
  CH = TwipsY(GetSystemMetrics(4))

  ' Is there a menu?
  If GetMenu(CInt(FolderTabs.Parent.hWnd)) <> 0 Then
    MH = TwipsY(GetSystemMetrics(15))  ' Get the menu's height
    Select Case FolderTabs.Parent.BorderStyle
      Case 2    ' Sizable
    SB = 2 * GetSystemMetrics(32)
      Case Else ' Little known fact: with a menu, your window's
        '   borders can only be sizable or single.
    SB = 2 * GetSystemMetrics(5)
    End Select
    OY = -1
  Else
    Select Case FolderTabs.Parent.BorderStyle
      Case 0
    SB = 0
    CH = 0
      Case 1
    SB = 2 * GetSystemMetrics(5)
    OY = -1
      Case 2
    SB = 2 * GetSystemMetrics(32)
    OY = -1
      Case 3
    SB = 2 * GetSystemMetrics(7)
    OX = 2
    OY = 1
    End Select

  End If

  FolderTabs.Parent.Height = Folders(0).Height + TwipsY(SB) + CH + MH + TwipsY(OY) + Folders(0).Top
  FolderTabs.Parent.Width = Folders(0).Width + TwipsX(SB) + TwipsX(OX)

  DrawTabs

End Sub

' Calculate the number of twips in a horizontal pixel
Private Function TwipsX (Pixels As Long) As Long

  TwipsX = Pixels * screen.TwipsPerPixelX

End Function

' Calculate the number of twips in a vertical pixel
Private Function TwipsY (Pixels As Long) As Long

  TwipsY = Pixels * screen.TwipsPerPixelY

End Function

' Calculate the row of a particular tab
Private Function VerTabPos (TN As Integer) As Integer
Dim I As Integer
Dim J As Integer

  I = TN \ VisibleTabs + 1
  J = FolderNum \ VisibleTabs + 1
  If I >= J Then
    VerTabPos = I - J + 1
  ElseIf J > I Then
    VerTabPos = NumRows - (J - I) + 1
  End If

End Function