home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / code / database / c_dbsuch / 3d_ctl.bas next >
Encoding:
BASIC Source File  |  1995-01-25  |  14.5 KB  |  375 lines
  1. '============================================================
  2. ' Moduldatei  : 3D_CTL.BAS
  3. ' Aufgabe     : Verschiedene 3D-Effekte fⁿr VB-Standard-
  4. '               Controls wie Eingabefelder, Combo-Boxen,
  5. '               Rollbalken u.a. Auch VBX-Controls k÷nnnen
  6. '               mit 3D-Effekten versehen werden.
  7. ' Copyright   : Arthur Burda
  8. ' Compiler    : Visual Basic 3.0 fⁿr Windows
  9. ' erstellt am : 26.01.1995
  10. '============================================================
  11.  
  12. Option Explicit
  13.  
  14. '============================================================
  15. ' Routine : FrameControl
  16. '============================================================
  17. ' Aufgabe : Zeichnet einen Rahmen um ein Control herum.
  18. ' Eingabe : Ctl        = Control
  19. '           Thickness  = Rahmendicke in Pixel
  20. '           FrameColor = Rahmenfarbe
  21. ' Ausgabe : keine
  22. '------------------------------------------------------------
  23. '
  24. Sub FrameControl (Ctl As Control, Thickness As Integer, FrameColor As Long)
  25.  
  26.     Dim OrigScaleMode
  27.     Dim i
  28.  
  29.     ' Original-Skaliermodus in OrigScaleMode speichern
  30.     OrigScaleMode = Ctl.Parent.ScaleMode
  31.  
  32.     ' Pixel-Skaliermodus setzen
  33.     Ctl.Parent.ScaleMode = 3
  34.  
  35.     If Thickness < 1 Then Thickness = 1
  36.     If Thickness > 10 Then Thickness = 10
  37.  
  38.     For i = 1 To Thickness
  39.     
  40.         ' linken Teil des Rahmens zeichnen
  41.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top - i)-(Ctl.Left - i, Ctl.Top + Ctl.Height + i), FrameColor
  42.         ' oberen Teil des Rahmens zeichnen
  43.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top - i)-(Ctl.Left + Ctl.Width + i, Ctl.Top - i), FrameColor
  44.         ' unteren Teil des Rahmens zeichnen
  45.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top + Ctl.Height + i - 1)-(Ctl.Left + Ctl.Width + i - 1, Ctl.Top + Ctl.Height + i - 1), FrameColor
  46.         ' rechten Teil des Rahmens zeichnen
  47.         Ctl.Parent.Line (Ctl.Left + Ctl.Width + i - 1, Ctl.Top - i + 1)-(Ctl.Left + Ctl.Width + i - 1, Ctl.Top + Ctl.Height + i), FrameColor
  48.  
  49.     Next i
  50.  
  51.     ' Original-Skaliermodus wieder setzen
  52.     Ctl.Parent.ScaleMode = OrigScaleMode
  53.  
  54. End Sub
  55.  
  56. '============================================================
  57. ' Routine : FrameControl_Fast
  58. '============================================================
  59. ' Aufgabe : Zeichnet einen Rahmen um ein Control herum (be-
  60. '           sonders schnell durch die Verwendung der BF-Option
  61. '           in der Line-Methode der Parent-Eigenschaft des
  62. '           Controls)
  63. ' Eingabe : Ctl        = Control
  64. '           Thickness  = Rahmendicke in Pixel
  65. '           FrameColor = Rahmenfarbe
  66. ' Ausgabe : keine
  67. '------------------------------------------------------------
  68. '
  69. Sub FrameControl_Fast (Ctl As Control, Thickness As Integer, FrameColor As Long)
  70.  
  71.     Dim OrigScaleMode
  72.     Dim i
  73.  
  74.     ' Original-Skaliermodus in OrigScaleMode speichern
  75.     OrigScaleMode = Ctl.Parent.ScaleMode
  76.  
  77.     ' Pixel-Skaliermodus setzen
  78.     Ctl.Parent.ScaleMode = 3
  79.  
  80.     If Thickness < 1 Then Thickness = 1
  81.     If Thickness > 10 Then Thickness = 10
  82.  
  83.     Ctl.Parent.Line (Ctl.Left - Thickness, Ctl.Top - Thickness)-(Ctl.Left + Ctl.Width + Thickness - 1, Ctl.Top + Ctl.Height + Thickness - 1), FrameColor, BF
  84.  
  85.     ' Original-Skaliermodus wieder setzen
  86.     Ctl.Parent.ScaleMode = OrigScaleMode
  87.  
  88. End Sub
  89.  
  90. '============================================================
  91. ' Routine : InsetControl
  92. '============================================================
  93. ' Aufgabe : Stellt ein Control versunken dar, indem ein Rahmen
  94. '           um das Control gezeichnet wird.
  95. ' Eingabe : Ctl       = Control
  96. '           Thickness = Rahmendicke in Pixel
  97. ' Ausgabe : keine
  98. '------------------------------------------------------------
  99. '
  100. Sub InsetControl (Ctl As Control, Thickness As Integer)
  101.  
  102.     Dim OrigScaleMode
  103.     Dim i
  104.  
  105.     ' Original-Skaliermodus in OrigScaleMode speichern
  106.     OrigScaleMode = Ctl.Parent.ScaleMode
  107.  
  108.     ' Pixel-Skaliermodus setzen
  109.     Ctl.Parent.ScaleMode = 3
  110.  
  111.     If Thickness < 1 Then Thickness = 1
  112.     If Thickness > 10 Then Thickness = 10
  113.  
  114.     For i = 1 To Thickness
  115.     
  116.         ' linken Teil des Rahmens zeichnen
  117.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top - i)-(Ctl.Left - i, Ctl.Top + Ctl.Height + i), &H808080
  118.         ' oberen Teil des Rahmens zeichnen
  119.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top - i)-(Ctl.Left + Ctl.Width + i, Ctl.Top - i), &H808080
  120.         ' unteren Teil des Rahmens zeichnen
  121.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top + Ctl.Height + i - 1)-(Ctl.Left + Ctl.Width + i - 1, Ctl.Top + Ctl.Height + i - 1), &HFFFFFF
  122.         ' rechten Teil des Rahmens zeichnen
  123.         Ctl.Parent.Line (Ctl.Left + Ctl.Width + i - 1, Ctl.Top - i + 1)-(Ctl.Left + Ctl.Width + i - 1, Ctl.Top + Ctl.Height + i), &HFFFFFF
  124.  
  125.     Next i
  126.  
  127.     ' Original-Skaliermodus wieder setzen
  128.     Ctl.Parent.ScaleMode = OrigScaleMode
  129.  
  130. End Sub
  131.  
  132. '============================================================
  133. ' Routine : InsetRaisedControl
  134. '============================================================
  135. ' Aufgabe : Versieht ein Control mit einem effektvollen Rahmen
  136. '           (Kombination aus erhoben und versunken).
  137. ' Eingabe : Ctl       = Control
  138. '           Thickness = Rahmendicke
  139. ' Ausgabe : keine
  140. '------------------------------------------------------------
  141. '
  142. Sub InsetRaisedControl (Ctl As Control, Thickness As Integer)
  143.  
  144.     Dim OrigScaleMode
  145.     Dim i
  146.  
  147.     ' Original-Skaliermodus in OrigScaleMode speichern
  148.     OrigScaleMode = Ctl.Parent.ScaleMode
  149.  
  150.     ' Pixel-Skaliermodus setzen
  151.     Ctl.Parent.ScaleMode = 3
  152.  
  153.     If Thickness Mod 2 <> 0 Then Thickness = Thickness + 1
  154.     If Thickness < 2 Then Thickness = 2
  155.     If Thickness > 10 Then Thickness = 10
  156.  
  157.     ' Innenteil des Rahmens zeichnen (erhoben)
  158.     For i = 1 To Thickness / 2
  159.     
  160.         ' linken Teil des Rahmens zeichnen
  161.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top - i)-(Ctl.Left - i, Ctl.Top + Ctl.Height + i), &HFFFFFF
  162.         ' oberen Teil des Rahmens zeichnen
  163.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top - i)-(Ctl.Left + Ctl.Width + i, Ctl.Top - i), &HFFFFFF
  164.         ' unteren Teil des Rahmens zeichnen
  165.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top + Ctl.Height + i - 1)-(Ctl.Left + Ctl.Width + i - 1, Ctl.Top + Ctl.Height + i - 1), &H808080
  166.         ' rechten Teil des Rahmens zeichnen
  167.         Ctl.Parent.Line (Ctl.Left + Ctl.Width + i - 1, Ctl.Top - i + 1)-(Ctl.Left + Ctl.Width + i - 1, Ctl.Top + Ctl.Height + i), &H808080
  168.  
  169.     Next i
  170.  
  171.     ' Au▀enteil des Rahmens zeichnen (versunken)
  172.     For i = Thickness / 2 + 1 To Thickness
  173.     
  174.         ' linken Teil des Rahmens zeichnen
  175.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top - i)-(Ctl.Left - i, Ctl.Top + Ctl.Height + i), &H808080
  176.         ' oberen Teil des Rahmens zeichnen
  177.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top - i)-(Ctl.Left + Ctl.Width + i, Ctl.Top - i), &H808080
  178.         ' unteren Teil des Rahmens zeichnen
  179.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top + Ctl.Height + i - 1)-(Ctl.Left + Ctl.Width + i - 1, Ctl.Top + Ctl.Height + i - 1), &HFFFFFF
  180.         ' rechten Teil des Rahmens zeichnen
  181.         Ctl.Parent.Line (Ctl.Left + Ctl.Width + i - 1, Ctl.Top - i + 1)-(Ctl.Left + Ctl.Width + i - 1, Ctl.Top + Ctl.Height + i), &HFFFFFF
  182.  
  183.     Next i
  184.  
  185.     ' Original-Skaliermodus wieder setzen
  186.     Ctl.Parent.ScaleMode = OrigScaleMode
  187.  
  188. End Sub
  189.  
  190. '============================================================
  191. ' Routine : RaisedControl
  192. '============================================================
  193. ' Aufgabe : Stellt ein Control erhoben dar, indem ein Rahmen
  194. '           um das Control gezeichnet wird.
  195. ' Eingabe : Ctl       = Control
  196. '           Thickness = Rahmendicke in Pixel
  197. ' Ausgabe : keine
  198. '------------------------------------------------------------
  199. '
  200. Sub RaisedControl (Ctl As Control, Thickness As Integer)
  201.  
  202.     Dim OrigScaleMode
  203.     Dim i
  204.  
  205.     ' Original-Skaliermodus in OrigScaleMode speichern
  206.     OrigScaleMode = Ctl.Parent.ScaleMode
  207.  
  208.     ' Pixel-Skaliermodus setzen
  209.     Ctl.Parent.ScaleMode = 3
  210.  
  211.     If Thickness < 1 Then Thickness = 1
  212.     If Thickness > 10 Then Thickness = 10
  213.  
  214.     For i = 1 To Thickness
  215.     
  216.         ' linken Teil des Rahmens zeichnen
  217.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top - i)-(Ctl.Left - i, Ctl.Top + Ctl.Height + i), &HFFFFFF
  218.         ' oberen Teil des Rahmens zeichnen
  219.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top - i)-(Ctl.Left + Ctl.Width + i, Ctl.Top - i), &HFFFFFF
  220.         ' unteren Teil des Rahmens zeichnen
  221.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top + Ctl.Height + i - 1)-(Ctl.Left + Ctl.Width + i - 1, Ctl.Top + Ctl.Height + i - 1), &H808080
  222.         ' rechten Teil des Rahmens zeichnen
  223.         Ctl.Parent.Line (Ctl.Left + Ctl.Width + i - 1, Ctl.Top - i + 1)-(Ctl.Left + Ctl.Width + i - 1, Ctl.Top + Ctl.Height + i), &H808080
  224.  
  225.     Next i
  226.  
  227.     ' Original-Skaliermodus wieder setzen
  228.     Ctl.Parent.ScaleMode = OrigScaleMode
  229.  
  230. End Sub
  231.  
  232. '============================================================
  233. ' Routine : RaisedInsetControl
  234. '============================================================
  235. ' Aufgabe : Versieht ein Control mit einem effektvollen Rahmen
  236. '           (Kombination aus versunken und erhoben).
  237. ' Eingabe : Ctl       = Control
  238. '           Thickness = Rahmendicke
  239. ' Ausgabe : keine
  240. '------------------------------------------------------------
  241. '
  242. Sub RaisedInsetControl (Ctl As Control, Thickness As Integer)
  243.  
  244.     Dim OrigScaleMode
  245.     Dim i
  246.  
  247.     ' Original-Skaliermodus in OrigScaleMode speichern
  248.     OrigScaleMode = Ctl.Parent.ScaleMode
  249.  
  250.     ' Pixel-Skaliermodus setzen
  251.     Ctl.Parent.ScaleMode = 3
  252.  
  253.     If Thickness Mod 2 <> 0 Then Thickness = Thickness + 1
  254.     If Thickness < 2 Then Thickness = 2
  255.     If Thickness > 10 Then Thickness = 10
  256.  
  257.     ' Innenteil des Rahmens zeichnen (versunken)
  258.     For i = 1 To Thickness / 2
  259.     
  260.         ' linken Teil des Rahmens zeichnen
  261.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top - i)-(Ctl.Left - i, Ctl.Top + Ctl.Height + i), &H808080
  262.         ' oberen Teil des Rahmens zeichnen
  263.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top - i)-(Ctl.Left + Ctl.Width + i, Ctl.Top - i), &H808080
  264.         ' unteren Teil des Rahmens zeichnen
  265.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top + Ctl.Height + i - 1)-(Ctl.Left + Ctl.Width + i - 1, Ctl.Top + Ctl.Height + i - 1), &HFFFFFF
  266.         ' rechten Teil des Rahmens zeichnen
  267.         Ctl.Parent.Line (Ctl.Left + Ctl.Width + i - 1, Ctl.Top - i + 1)-(Ctl.Left + Ctl.Width + i - 1, Ctl.Top + Ctl.Height + i), &HFFFFFF
  268.  
  269.     Next i
  270.  
  271.     ' Au▀enteil des Rahmens zeichnen (erhoben)
  272.     For i = Thickness / 2 + 1 To Thickness
  273.     
  274.         ' linken Teil des Rahmens zeichnen
  275.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top - i)-(Ctl.Left - i, Ctl.Top + Ctl.Height + i), &HFFFFFF
  276.         ' oberen Teil des Rahmens zeichnen
  277.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top - i)-(Ctl.Left + Ctl.Width + i, Ctl.Top - i), &HFFFFFF
  278.         ' unteren Teil des Rahmens zeichnen
  279.         Ctl.Parent.Line (Ctl.Left - i, Ctl.Top + Ctl.Height + i - 1)-(Ctl.Left + Ctl.Width + i - 1, Ctl.Top + Ctl.Height + i - 1), &H808080
  280.         ' rechten Teil des Rahmens zeichnen
  281.         Ctl.Parent.Line (Ctl.Left + Ctl.Width + i - 1, Ctl.Top - i + 1)-(Ctl.Left + Ctl.Width + i - 1, Ctl.Top + Ctl.Height + i), &H808080
  282.  
  283.     Next i
  284.  
  285.     ' Original-Skaliermodus wieder setzen
  286.     Ctl.Parent.ScaleMode = OrigScaleMode
  287.  
  288. End Sub
  289.  
  290. '============================================================
  291. ' Routine : ShadowControl
  292. '============================================================
  293. ' Aufgabe : Versieht ein Control mit Schatten.
  294. ' Eingabe : Ctl             = Control
  295. '           ShadowThickness = Schattendicke
  296. '           BlackShadow     = True, wenn der Schatten schwarz
  297. '                             gezeichnet werden soll
  298. ' Ausgabe : keine
  299. '------------------------------------------------------------
  300. '
  301. Sub ShadowControl (Ctl As Control, ShadowThickness As Integer, BlackShadow As Integer)
  302.  
  303.     Dim OrigScaleMode
  304.     Dim i
  305.  
  306.     ' Original-Skaliermodus in OrigScaleMode speichern
  307.     OrigScaleMode = Ctl.Parent.ScaleMode
  308.  
  309.     ' Pixel-Skaliermodus setzen
  310.     Ctl.Parent.ScaleMode = 3
  311.  
  312.     If ShadowThickness < 1 Then ShadowThickness = 1
  313.     If ShadowThickness > 10 Then ShadowThickness = 10
  314.  
  315.     For i = 1 To ShadowThickness
  316.  
  317.         If BlackShadow Then ' Schatten schwarz
  318.             Ctl.Parent.Line (Ctl.Left + ShadowThickness, Ctl.Top + Ctl.Height + i - 1)-(Ctl.Left + Ctl.Width + ShadowThickness, Ctl.Top + Ctl.Height + i - 1), &H0&
  319.         Else
  320.             Ctl.Parent.Line (Ctl.Left + ShadowThickness, Ctl.Top + Ctl.Height + i - 1)-(Ctl.Left + Ctl.Width + ShadowThickness, Ctl.Top + Ctl.Height + i - 1), &H808080
  321.         End If
  322.  
  323.         If BlackShadow Then ' Schatten schwarz
  324.             Ctl.Parent.Line (Ctl.Left + Ctl.Width + i - 1, Ctl.Top + ShadowThickness)-(Ctl.Left + Ctl.Width + i - 1, Ctl.Top + Ctl.Height + ShadowThickness), &H0&
  325.         Else
  326.             Ctl.Parent.Line (Ctl.Left + Ctl.Width + i - 1, Ctl.Top + ShadowThickness)-(Ctl.Left + Ctl.Width + i - 1, Ctl.Top + Ctl.Height + ShadowThickness), &H808080
  327.         End If
  328.  
  329.     Next i
  330.  
  331.     ' Original-Skaliermodus wieder setzen
  332.     Ctl.Parent.ScaleMode = OrigScaleMode
  333.  
  334. End Sub
  335.  
  336. '============================================================
  337. ' Routine : ShadowControl_Fast
  338. '============================================================
  339. ' Aufgabe : Versieht ein Control mit Schatten (besonders
  340. '           schnell durch die Verwendung der BF-Option in
  341. '           der Line-Methode der Parent-Eigenschaft des
  342. '           Controls)
  343. ' Eingabe : Ctl             = Control
  344. '           ShadowThickness = Schattendicke
  345. '           BlackShadow     = True, wenn der Schatten schwarz
  346. '                             gezeichnet werden soll
  347. ' Ausgabe : keine
  348. '------------------------------------------------------------
  349. '
  350. Sub ShadowControl_Fast (Ctl As Control, ShadowThickness As Integer, BlackShadow As Integer)
  351.  
  352.     Dim OrigScaleMode
  353.     Dim i
  354.  
  355.     ' Original-Skaliermodus in OrigScaleMode speichern
  356.     OrigScaleMode = Ctl.Parent.ScaleMode
  357.  
  358.     ' Pixel-Skaliermodus setzen
  359.     Ctl.Parent.ScaleMode = 3
  360.  
  361.     If ShadowThickness < 1 Then ShadowThickness = 1
  362.     If ShadowThickness > 10 Then ShadowThickness = 10
  363.  
  364.     If BlackShadow Then ' Schatten schwarz
  365.         Ctl.Parent.Line (Ctl.Left + ShadowThickness, Ctl.Top + ShadowThickness)-(Ctl.Left + Ctl.Width + ShadowThickness - 1, Ctl.Top + Ctl.Height + ShadowThickness - 1), &H0&, BF
  366.     Else
  367.         Ctl.Parent.Line (Ctl.Left + ShadowThickness, Ctl.Top + ShadowThickness)-(Ctl.Left + Ctl.Width + ShadowThickness - 1, Ctl.Top + Ctl.Height + ShadowThickness - 1), &H808080, BF
  368.     End If
  369.  
  370.     ' Original-Skaliermodus wieder setzen
  371.     Ctl.Parent.ScaleMode = OrigScaleMode
  372.  
  373. End Sub
  374.  
  375.