تأثير ثلاثي الأبعاد

إضافة تأثير ثلاثي الأبعاد علي مكونات الفورم وعلي الفورم

'Form 3D objects code Copyright © 2003 Ahmad farag.
    'All Rights Reserved. ahm_farag@hotmail.com
' First I need to thank the owner of the site for this service

Sub PaintControl3D(frm As Form, Ctl As Control)
    ' This Sub draws lines around controls to make them 3d
    ' Like this in objects in the toolbars
    
    'Horizontal lines
    ' darkgrey, upper - horizontal
    frm.Line (Ctl.Left, Ctl.Top - 15)-(Ctl.Left + _
          Ctl.Width, Ctl.Top - 15), &HFFFFFF, BF
    ' white, lower - horizontal
    frm.Line (Ctl.Left, Ctl.Top + Ctl.Height)- _
    (Ctl.Left + Ctl.Width, Ctl.Top + Ctl.Height), &H808080, BF
    
    'Vertical lines
    ' darkgrey, left - vertical
    frm.Line (Ctl.Left - 15, Ctl.Top)-(Ctl.Left - 15, _
         Ctl.Top + Ctl.Height), &HFFFFFF, BF
    ' white, right - vertical
    frm.Line (Ctl.Left + Ctl.Width, Ctl.Top)- _
      (Ctl.Left + Ctl.Width, Ctl.Top + Ctl.Height), &H808080, BF

End Sub

Sub PaintForm3D(frm As Form)
    ' This Sub draws lines around the Form to make it 3d
    
    'Horizontal lines
    ' white, upper - horizontal
    frm.Line (0, 0)-(frm.ScaleWidth, 0), &HFFFFFF, BF
    ' darkgrey, lower - horizontal
    frm.Line (0, frm.ScaleHeight - 15)-(frm.ScaleWidth, _
      frm.ScaleHeight - 15), &H808080, BF
    
    'Vertical lines
    ' white, left - vertical
    frm.Line (0, 0)-(0, frm.ScaleHeight), &HFFFFFF, BF
    ' darkgrey, right - vertical
    frm.Line (frm.ScaleWidth - 15, 0)-(frm.ScaleWidth - 15, _
       frm.Height), &H808080, BF

End Sub

Private Sub Form_Load()

    Dim Con As Control
    
'Set form's AutoRedraw property to True, or leave it to code
    Me.AutoRedraw = True
    PaintForm3D Me
    'To make 3D effect all controls in the form
    For Each Con In Me.Controls
    'For labels Only, you can use this code
        'If TypeOf Con Is Label Then
            PaintControl3D Me, Con
        'End If
    Next
    
'You can change labels to everything you need
'Or make it like this one by one
'PaintControl3D Me, Label1  'Label1 is name of label
'PaintControl3D Me, Text1   'Text1 is name of textbox

End Sub

هذا الكود ليس ملكي ولكنني قمت بعمل تعديلات كثيرة عليه ليصبح في هذه الصورة