home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / VISUAL_B / CODIGO_1 / 3D_TABS / TABSLITE.BAS < prev    next >
Encoding:
BASIC Source File  |  1994-06-02  |  8.5 KB  |  267 lines
  1. Option Explicit
  2. Global Const WM_USER = &H400
  3. Global Const EM_GETLINECOUNT = WM_USER + 10
  4. '   Global Variables
  5. '
  6. 'Global Filename$    ' Current file to examine
  7. Global crlf$
  8. Global active%
  9. Declare Function SendMessage& Lib "User" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, lParam As Any)
  10. 'constants
  11. Global Const SRCCOPY = &HCC0020
  12. 'flags for painting
  13. Dim loading%
  14. 'general purpose
  15. Dim i%, r%
  16.  
  17. Type POINTAPI
  18.     x As Integer
  19.     y As Integer
  20. End Type
  21.  
  22. Type RECT
  23.     Left As Integer
  24.     Top As Integer
  25.     right As Integer
  26.     bottom As Integer
  27. End Type
  28.  
  29. Type boxsize
  30.     Width As Integer
  31.     Height As Integer
  32. End Type
  33.  
  34. Type twipdata
  35.     'scaling constants for each instance
  36.     x As Integer            'twips/per/pixelx - depends on parent's scale mode
  37.     y As Integer            'twips/per/pixely
  38.     bx As Integer           'width of nonclient in twips
  39.     by As Integer           'height of nonclient
  40. End Type
  41.  
  42. '===========structure to hold the size data===========
  43.  
  44. Type TabData
  45.     'control 'properties' - set by caller
  46.     num As Integer          'num of Page()'s
  47.     active As Integer       'active Page()
  48.     'orient As Integer       'up = 0, down = 1
  49.     cols As Integer         'horz# of tabs
  50.     Left As Integer         'control left in twips
  51.     Top As Integer          'control top in twips
  52.     offset As Integer       'tab angle
  53.     'optional 'properties' - set by caller for sizable windows
  54.     minwidth As Integer     'based on size of captions
  55.     minheight As Integer    'user-defined
  56.     Width As Integer        'width of whole control
  57.     Height As Integer       'height of whole control
  58.     'optional properties for 'nonaligned' controls
  59.     insetx  As Integer
  60.     insety As Integer
  61.     'calculated by DefineControl()
  62.     rows As Integer         '# of tabs horiz
  63.     box As boxsize          'tabbox
  64.     tab As boxsize          'invbox
  65.     'twips or pixels,depending on scalemode of parent:
  66.     t As twipdata
  67.     'pixels, used by graphic routines:
  68. End Type
  69.  
  70. Declare Function BitBlt% Lib "GDI" (ByVal hDestDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop&)
  71. Declare Sub ClientToScreen Lib "User" (ByVal hWnd%, lpPoint As POINTAPI)
  72. Declare Sub GetClientRect Lib "User" (ByVal hWnd%, lpRect As RECT)
  73. Declare Function GetParent% Lib "User" (ByVal hWnd%)
  74. Declare Function GetWindowLong& Lib "User" (ByVal hWnd%, ByVal nIndex%)
  75. Declare Sub GetWindowRect Lib "User" (ByVal hWnd%, lpRect As RECT)
  76.  
  77. Sub DefineControl (f As Form, tbox As Control, ibox As Control, page0 As Control, tb As TabData)
  78. Dim pageleft%, pagetop%, pageheight%, pagewidth%'in pixels
  79. Dim w%, h%  'in twips
  80. Dim theight%, pheight% 'in scalemode of container
  81. '
  82. loading = -1
  83. Debug.Print "=========new run================"
  84. zGetScaleData f, tbox, tb
  85.  
  86. '===initialize structure with size of the control======
  87.     tb.offset = 4
  88.     tb.rows = tb.num \ tb.cols + 1
  89. '---set height of invbox & tabbox based on textsize
  90.     tb.tab.Height = (tbox.TextHeight("X") + tb.offset)
  91.     tb.box.Height = tb.tab.Height * tb.rows
  92.     ' add 2 pixels to boxheight for 'focus' lines
  93.     theight% = (tb.box.Height + 2) * tb.t.x
  94.  
  95. '---set an integral pixel width for invbox & tabbox
  96.     pagewidth = page0.Width \ tb.t.x
  97.     tb.tab.Width = (pagewidth + (2 * tb.insetx \ tb.t.x)) \ tb.cols
  98.     tb.box.Width = tb.tab.Width * tb.cols
  99.     tb.Width = tb.box.Width * tb.t.x
  100. '--- Calculate size of Page() height & inset---------------
  101.     'use page0 to set control and form height
  102.     pageheight = page0.Height \ tb.t.y
  103.     tb.insetx = (tb.Width - page0.Width) \ 2
  104.     pheight% = page0.Height + 2 * tb.insety
  105. '----height of entire control-----
  106.     tb.Height = theight% + pheight%
  107.  
  108. '===position it all=======
  109. pageleft = tb.Left + tb.insetx
  110. pagetop = tb.Top + tb.insety + theight%
  111. '---size page0
  112. page0.Move pageleft, pagetop, pagewidth * tb.t.x, pageheight * tb.t.y
  113. tbox.Move tb.Left, tb.Top, tb.Width, theight%
  114. '----Draw the constant elements-----
  115. DrawTabs ibox, tbox, tb
  116. '----resize the form
  117. w = tb.Width + tb.t.bx: h = tb.Height + tb.t.by
  118. If tb.t.x = 1 Then
  119.     w = w * screen.TwipsPerPixelX
  120.     h = h * screen.TwipsPerPixelY
  121. End If
  122. f.Move f.Left, f.Top, w, h
  123. End Sub
  124.  
  125. Sub DrawTabs (ibox As Control, tbox As Control, tb As TabData)
  126. Debug.Print "Entering DrawTabs------------"
  127. 'called by DefineControl
  128. Dim box As RECT
  129. Dim off%                'inset for angled line
  130. Dim x%, y%, res%
  131.  
  132. ibox.Cls
  133. ibox.Move 0, 0, tb.tab.Width, tb.tab.Height
  134. 'set color and scale
  135. box.right = ibox.ScaleWidth - 1
  136. off = 4
  137. box.bottom = ibox.ScaleHeight
  138. ' Draw black lines
  139. ibox.Line (0, off)-(off, 0)                 'angle
  140. ibox.Line -(box.right - off - 1, 0)
  141. ibox.Line (box.right - off - 1, 0)-(box.right, off + 1)  'angle
  142. ibox.Line (box.right, 0)-(box.right, box.bottom)                       'box.right
  143. ' Draw white/grey lines
  144. ibox.Line (0, box.bottom)-(0, off + 1), QBColor(15)   'box.left
  145. ibox.Line -(off, 1), QBColor(15)            'angle
  146. ibox.Line -(box.right - off - 1, 1), QBColor(15)  'top
  147. ibox.Line -(box.right - 1, off + 1), QBColor(8)       'angle
  148. ibox.Line -(box.right - 1, box.bottom), QBColor(8)               'right
  149. ibox.Line (0, 0)-(0, off), QBColor(15)
  150. ibox.Line (box.right, 0)-(box.right, off)
  151. ibox.Line (box.right - 1, 0)-(box.right - 1, off), QBColor(8)
  152.  
  153. 'add some grey for the background
  154. ibox.Line (0, 0)-(0, off), QBColor(8)
  155. ibox.Line (1, 0)-(1, off - 1), QBColor(8)
  156. ibox.Line (2, 0)-(2, off - 2), QBColor(8)
  157. ibox.Line (box.right, 0)-(box.right, off + 1), QBColor(8)
  158. ibox.Line (box.right - 1, 0)-(box.right - 1, off), QBColor(8)
  159. ibox.Line (box.right - 2, 0)-(box.right - 2, off - 1), QBColor(8)
  160. ibox.Line (box.right - 3, 0)-(box.right - 3, off - 2), QBColor(8)
  161. ibox.PSet (3, 0), QBColor(8)
  162. ibox.PSet (box.right - 4, 0), QBColor(8)
  163. 'blit to  the row
  164. tbox.Visible = 0
  165. tbox.AutoRedraw = -1
  166. y = 0
  167. For x = 0 To tb.cols - 1
  168. res = BitBlt(tbox.hDC, x * tb.tab.Width, y * tb.tab.Height, tb.tab.Width, tb.tab.Height, ibox.hDC, 0, 0, SRCCOPY)
  169. Next
  170. tbox.Visible = -1
  171. tbox.AutoRedraw = 0
  172.  
  173. End Sub
  174.  
  175. Sub DrawText (tbox As Control, captions$(), tb As TabData)
  176. 'called by tbox_paint
  177. 'draws tab captions and focus line
  178. Dim s$
  179. Dim txtw%, y1%, y2%
  180. Dim x%, y%, inner%, outer%, theight%, cell%
  181. '
  182. Debug.Print "Entering DrawText---------"
  183. '
  184. tbox.Cls
  185. cell = 0
  186. y = 0'tb.box.Height - tb.tab.Height
  187. For x = 0 To tb.num * tb.tab.Width Step tb.tab.Width
  188.     If cell = tb.active Then tbox.FontBold = -1 Else tbox.FontBold = 0
  189.     s$ = captions(cell)
  190.     txtw = tbox.TextWidth(s$)
  191.     tbox.CurrentX = x + (tb.tab.Width - txtw) \ 2
  192.     tbox.CurrentY = y + tb.offset \ 2
  193.     tbox.Print s$
  194.     cell = cell + 1
  195. Next
  196.  
  197. ' draw a blank line underneath the selected tab
  198.     inner = 15
  199.     y1 = tbox.ScaleHeight - 1: y2 = tbox.ScaleHeight - 2
  200. 'solid line
  201. tbox.Line (0, y1)-(tbox.ScaleWidth, y1), QBColor(inner)
  202. tbox.Line (0, y2)-(tbox.ScaleWidth, y2)
  203. 'focus line
  204. x = (tb.active Mod tb.cols) * tb.tab.Width
  205. tbox.Line (x + 1, y1)-(x + tb.tab.Width - 2, y1), tbox.BackColor
  206. tbox.Line (x + 1, y2)-(x + tb.tab.Width - 1, y2), tbox.BackColor
  207. tbox.PSet (x, y1), QBColor(15)
  208. tbox.PSet (x, y2), QBColor(15)
  209. 'tbox.ZOrder 0
  210. End Sub
  211.  
  212. Sub TabClick (Button%, x As Single, y As Single, tbox As Control, captions$(), tb As TabData)
  213. 'called by tbox_MouseUp
  214. Dim hpos%, vpos%
  215. Dim activerow%, thisrow%, row%, n%
  216.  
  217. activerow = 0
  218. '
  219. hpos = x \ tb.tab.Width  '=0,1,2...
  220. vpos = y \ tb.tab.Height
  221. vpos = tb.rows - vpos - 1
  222. '
  223. vpos = vpos + activerow
  224. If vpos >= tb.rows Then
  225.     vpos = vpos - (tb.rows)
  226. End If
  227. n = (vpos * tb.cols) + hpos
  228.  
  229. 'blank tabs:
  230. If n < 0 Or n > tb.num Then Exit Sub
  231.  
  232. tb.active = n
  233. DrawText tbox, captions(), tb
  234. End Sub
  235.  
  236. Private Sub zGetScaleData (f As Form, tbox As Control, tb As TabData)
  237. 'called by DefineControl
  238. Dim containerhwnd%
  239. Dim win As RECT, client As RECT
  240. 'adjustment for scalemode of the form
  241. tb.t.x = screen.TwipsPerPixelX
  242. tb.t.y = screen.TwipsPerPixelY
  243. '
  244. containerhwnd% = GetParent(tbox.hWnd)
  245. If containerhwnd% = f.hWnd Then
  246.     If f.ScaleMode = 3 Then tb.t.x = 1: tb.t.y = 1
  247. Else
  248. For i = 0 To f.Controls.Count - 1
  249. On Error Resume Next
  250.     If f.Controls(i).hWnd = containerhwnd Then
  251.     If f.Controls(i).ScaleMode = 3 Then
  252.         If Err Then Exit For
  253.         tb.t.x = 1: tb.t.y = 1
  254.     End If
  255.     Exit For
  256.     End If
  257. Next
  258. End If
  259.  
  260. 'subtract client area from window for border sizes
  261. GetWindowRect f.hWnd, win
  262. GetClientRect f.hWnd, client
  263. tb.t.bx = (win.right - win.Left - client.right) * tb.t.x
  264. tb.t.by = (win.bottom - win.Top - client.bottom) * tb.t.y
  265. End Sub
  266.  
  267.