3D formulář

Postup:
Založte nový projekt a do formuláře definujte následující proceduru:

Private Sub ThreeDForm(frmForm As Form)

    Const cPi = 3.1415926
     Dim intLineWidth As Integer
     intLineWidth = 5
      'uložení scale módů
     Dim intSaveScaleMode As Integer
     intSaveScaleMode = frmForm.ScaleMode
     frmForm.ScaleMode = 3
     Dim intScaleWidth As Integer
     Dim intScaleHeight As Integer
     intScaleWidth = frmForm.ScaleWidth
     intScaleHeight = frmForm.ScaleHeight
     'vyčištění formuláře
     frmForm.Cls
     'vykreslení bílých čar
    frmForm.Line (0, intScaleHeight)-(intLineWidth, 0), &HFFFFFF, BF
     frmForm.Line (0, intLineWidth)-(intScaleWidth, 0), &HFFFFFF, BF
     'vykreslení šedivých čar
    frmForm.Line (intScaleWidth, 0)-(intScaleWidth - intLineWidth, intScaleHeight), &H808080, BF
     frmForm.Line (intScaleWidth, intScaleHeight - intLineWidth)-(0, intScaleHeight), &H808080, BF
     'vykreslení rohů
    Dim intCircleWidth As Integer
     intCircleWidth = Sqr(intLineWidth * intLineWidth + intLineWidth * intLineWidth)
     frmForm.FillStyle = 0
     frmForm.FillColor = QBColor(15)
     frmForm.Circle (intLineWidth, intScaleHeight - intLineWidth), intCircleWidth, QBColor(15), -3.1415926, -3.90953745777778 '-180 * cPi / 180, -224 * cPi / 180
     frmForm.Circle (intScaleWidth - intLineWidth, intLineWidth), intCircleWidth, QBColor(15), -0.78539815, -1.5707963 ' -45 * cPi / 180, -90 * cPi / 180
     'vykreslení černého rámečku
    frmForm.Line (0, intScaleHeight)-(0, 0), 0
     frmForm.Line (0, 0)-(intScaleWidth - 1, 0), 0
     frmForm.Line (intScaleWidth - 1, 0)-(intScaleWidth - 1, intScaleHeight - 1), 0
     frmForm.Line (0, intScaleHeight - 1)-(intScaleWidth - 1, intScaleHeight - 1), 0
     frmForm.ScaleMode = intSaveScaleMode

End Sub

Na událost Form_Resize zapište volání procedury:

Call ThreeDForm (Me)

Spusťte projekt.

Zpět