试写UI界面设计器

Mongnewer2026-02-09 14:20

简单地，用VB6把它写成了这个样子。一个设计用的FORM，一个组件的PALTTE，一个属性列表(没有方法和事件列表)。

组件周围做了六个Caret，通过它缩放组件，按住鼠标拖动组件，同时更新属性列表显示。

可以保存设计、装载设计、生成代码RAPIDQ代码

组件模板挺简陋的，没有针对性的设计一些用户控件，然后设置它们的Parent在设计界面上有针对性的缩放，连简单的图像也没做。试练，就简简单单吧。

比如：设计下面的一个界面吧

点击Code生成代码

复制代码 
CREATE Design AS QFORM
    Width = 754
    Height = 495
    CREATE Edit1 AS QEDIT
        Text = "TextBox01"
        Width = 270
        Height = 64
        Left = 317
        Top = 58
        Font.Size = 10.8
    END CREATE
    CREATE Label2 AS QLABEL
        Caption = "Label02"
        Width = 133
        Height = 63
        Left = 142
        Top = 58
        Font.Size = 10.8
    END CREATE
    CREATE Button3 AS QBUTTON
        Caption = "Button03"
        Width = 442
        Height = 91
        Left = 142
        Top = 150
        Font.Size = 10.8
    END CREATE
    CREATE Button4 AS QBUTTON
        Caption = "Button04"
        Width = 234
        Height = 51
        Left = 142
        Top = 275
        Font.Size = 10.8
    END CREATE
    CREATE Button5 AS QBUTTON
        Caption = "Button05"
        Width = 191
        Height = 49
        Left = 392
        Top = 275
        Font.Size = 10.8
    END CREATE
    CREATE Button6 AS QBUTTON
        Caption = "Button06"
        Width = 133
        Height = 42
        Left = 300
        Top = 367
        Font.Size = 10.8
    END CREATE
    CREATE Button7 AS QBUTTON
        Caption = "Button07"
        Width = 133
        Height = 42
        Left = 450
        Top = 367
        Font.Size = 10.8
    END CREATE
END CREATE

'Insert your initialization code here

Design.ShowModal

用RC.EXE编译生成执行文件 frmCode.exe

运行执行文件frmCode.exe显示的界面

生成的代码是UPX压缩的，用UPX -d解开后，再用resHacker把 Theme.xml写入frmCode.exe文件。xp样式不起作用，DPI感知起作用。

全局模块的代码

复制代码 
Option Explicit

Global TPPPx As Single
Global TPPPy As Single
Public Const HWND_DESKTOP As Long = 0
Public Const LOGPIXELSX As Long = 88
Public Const LOGPIXELSY As Long = 90

'Grid isEditable
Global EditableFlag As Boolean
Global isCaretsShow As Boolean
Global isCompChanged As Boolean
Global GridSpaceV As Long
Global GridSpaceH As Long

Type gUIComps
    Name As String
    Caption As String
    FontSize As Single
    Width As Single
    Height As Single
    Left As Single
    Top As Single
End Type

Global UIComps(1000) As gUIComps
Global CompMoveID As Integer                                                    'Value 0/1, Hide carets when Component moves, and then show carets when MouseUP
Global CompFocusID As Integer                                                   'It is the Component INDEX when get focus
Global CompSelID As Integer                                                     'It is the selection ID of Component palete at "Components" form
Global CompDisplayID As Integer                                                 'It is for loading Components in the Components Array

'For components drag
Global BtnOldX1 As Long: Global BtnOldY1 As Long
Global BtnNewX1 As Long: Global BtnNewY1 As Long

'For carets drag
Global BtnOldX2 As Long: Global BtnOldY2 As Long
Global BtnNewX2 As Long: Global BtnNewY2 As Long

Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

UI设计界面代码

复制代码 
Option Explicit

Private Sub Carets_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim RemainsToGridH As Long
    Dim RemainsToGridV As Long
    If isCompChanged = True Then
        isCompChanged = False
        RemainsToGridH = CompDisplay(CompFocusID).Left Mod GridSpaceH
        If RemainsToGridH < GridSpaceH / 2 Then
            CompDisplay(CompFocusID).Left = CompDisplay(CompFocusID).Left - CompDisplay(CompFocusID).Left Mod GridSpaceH
            UIComps(CompFocusID).Left = CompDisplay(CompFocusID).Left
        Else
            CompDisplay(Index).Left = CompDisplay(CompFocusID).Left - CompDisplay(CompFocusID).Left Mod GridSpaceH + GridSpaceH
            UIComps(CompFocusID).Left = CompDisplay(CompFocusID).Left
        End If
        RemainsToGridV = CompDisplay(CompFocusID).Top Mod GridSpaceV
        If RemainsToGridV < GridSpaceV / 2 Then
            CompDisplay(CompFocusID).Top = CompDisplay(CompFocusID).Top - CompDisplay(CompFocusID).Top Mod GridSpaceV
            UIComps(CompFocusID).Top = CompDisplay(CompFocusID).Top
        Else
            CompDisplay(CompFocusID).Top = CompDisplay(CompFocusID).Top - CompDisplay(CompFocusID).Top Mod GridSpaceV + GridSpaceV
            UIComps(CompFocusID).Top = CompDisplay(CompFocusID).Top
        End If
    End If
End Sub

Private Sub CompDisplay_Click(Index As Integer)
    CaretsShow
    CompFocusID = Index
    CaretsRePos (CompFocusID)
    CompProps.Text1.Text = ""
End Sub

Private Sub CompDisplay_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim RemainsToGridH As Long
    Dim RemainsToGridV As Long
    If isCompChanged = True Then
        isCompChanged = False
        RemainsToGridH = CompDisplay(CompFocusID).Left Mod GridSpaceH
        If RemainsToGridH < GridSpaceH / 2 Then
            CompDisplay(CompFocusID).Left = CompDisplay(CompFocusID).Left - CompDisplay(CompFocusID).Left Mod GridSpaceH
            UIComps(CompFocusID).Left = CompDisplay(CompFocusID).Left
        Else
            CompDisplay(CompFocusID).Left = CompDisplay(CompFocusID).Left - CompDisplay(CompFocusID).Left Mod GridSpaceH + GridSpaceH
            UIComps(CompFocusID).Left = CompDisplay(CompFocusID).Left
        End If
        RemainsToGridV = CompDisplay(CompFocusID).Top Mod GridSpaceV
        If RemainsToGridV < GridSpaceV / 2 Then
            CompDisplay(CompFocusID).Top = CompDisplay(CompFocusID).Top - CompDisplay(CompFocusID).Top Mod GridSpaceV
            UIComps(CompFocusID).Top = CompDisplay(CompFocusID).Top
        Else
            CompDisplay(CompFocusID).Top = CompDisplay(CompFocusID).Top - CompDisplay(CompFocusID).Top Mod GridSpaceV + GridSpaceV
            UIComps(CompFocusID).Top = CompDisplay(CompFocusID).Top
        End If
    End If
    If CompMoveID = 1 Then
        CompMoveID = 0
        CaretsShow
    End If
End Sub

Private Sub Form_Click()
    CaretsHide
    CompFocusNone
End Sub

Private Sub Form_DblClick()
    CaretsHide
    CompFocusNone
    If Components.CompSel(0).Value = True Then
        Exit Sub
    End If
    CompDisplayID = CompDisplayID + 1
    CompFocusID = CompDisplayID
    Load CompDisplay(CompDisplayID)
    CompDisplay(CompDisplayID).Caption = Components.CompSel(CompSelID).Caption + Format$(CompDisplayID, "00")
    CompDisplay(CompDisplayID).Width = 1600: CompDisplay(CompDisplayID).Height = 500
    CompDisplay(CompDisplayID).Move 300, 300
    
    CompDisplay(CompDisplayID).FontSize = 11
    CompDisplay(CompDisplayID).ZOrder (0)
    
    'Store common properties of the created component
    UIComps(CompDisplayID).Name = Components.CompSel(CompSelID).Caption
    UIComps(CompDisplayID).Caption = CompDisplay(CompDisplayID).Caption
    UIComps(CompDisplayID).FontSize = CompDisplay(CompDisplayID).FontSize
    UIComps(CompDisplayID).Width = CompDisplay(CompDisplayID).Width
    UIComps(CompDisplayID).Height = CompDisplay(CompDisplayID).Height
    UIComps(CompDisplayID).Left = CompDisplay(CompDisplayID).Left
    UIComps(CompDisplayID).Top = CompDisplay(CompDisplayID).Top
    
    'To DO
    'Store extra properties of the created component
    
    PropsShow (CompDisplayID)
    
    CompDisplay(CompDisplayID).Visible = True
    CaretsRePos (CompDisplayID)
    CaretsShow
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    'Escape KEY
    If KeyCode = 27 Then
        CaretsHide
        Exit Sub
    End If
    'Delete KEY
    If KeyCode = 46 Then
        If isCaretsShow = True Then
            Unload CompDisplay(CompFocusID)
            UICompDelete (CompFocusID)
            CaretsHide
        End If
    End If
End Sub

Private Sub Form_Load()
    Dim DesignLeft As Long
    GridSpaceV = 100
    GridSpaceH = 100
    isCompChanged = False
    
    TwipsPerPixelX
    TwipsPerPixelY
    
    DesignLeft = 350
    If Design.Left > DesignLeft Then
        Design.Left = DesignLeft
    End If
    CompDisplayID = 0
    Components.Show
    Components.Top = Design.Top
    Components.Left = Design.Left + Design.Width
    CompProps.Show
    CompProps.Top = Design.Top
    CompProps.Left = Design.Left + Design.Width + Components.Width
    CaretsHide
    
    DrawDesignGrid
End Sub

Sub CaretsRePos(compnum As Integer)
    Carets(0).Left = CompDisplay(compnum).Left - 2 * Carets(0).Width: Carets(0).Top = CompDisplay(compnum).Top - 2 * Carets(0).Height
    Carets(1).Left = CompDisplay(compnum).Left - 2 * Carets(1).Width: Carets(1).Top = CompDisplay(compnum).Top + CompDisplay(compnum).Height / 2 - Carets(1).Height / 2
    Carets(2).Left = CompDisplay(compnum).Left - 2 * Carets(2).Width: Carets(2).Top = CompDisplay(compnum).Top + CompDisplay(compnum).Height + Carets(2).Height
    
    Carets(3).Left = CompDisplay(compnum).Left + CompDisplay(compnum).Width / 2 - Carets(3).Width / 2: Carets(3).Top = CompDisplay(compnum).Top + CompDisplay(compnum).Height + Carets(3).Height
    
    Carets(4).Left = CompDisplay(compnum).Left + CompDisplay(compnum).Width + Carets(4).Width: Carets(4).Top = CompDisplay(compnum).Top + CompDisplay(compnum).Height + Carets(4).Height
    Carets(5).Left = CompDisplay(compnum).Left + CompDisplay(compnum).Width + Carets(5).Width: Carets(5).Top = CompDisplay(compnum).Top + CompDisplay(compnum).Height / 2 - Carets(5).Height / 2
    Carets(6).Left = CompDisplay(compnum).Left + CompDisplay(compnum).Width + Carets(6).Width: Carets(6).Top = CompDisplay(compnum).Top - 2 * Carets(6).Height
    
    Carets(7).Left = CompDisplay(compnum).Left + CompDisplay(compnum).Width / 2 - Carets(7).Width / 2: Carets(7).Top = CompDisplay(compnum).Top - 2 * Carets(7).Height
End Sub

Private Sub Carets_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Carets(Index).SetFocus
    If Button = 1 Then
        BtnOldX2 = X: BtnOldY2 = Y
        CaretsRePos (CompFocusID)
    End If
End Sub

Private Sub Carets_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim diffWidth As Single
    Dim diffHeight As Single
    If Button = 1 Then
        BtnNewX2 = X: BtnNewY2 = Y
        diffWidth = BtnNewX2 - BtnOldX2
        diffHeight = BtnNewY2 - BtnOldY2
        
        Select Case Index
        Case 0
            CompDisplay(CompFocusID).Width = CompDisplay(CompFocusID).Width - diffWidth
            CompDisplay(CompFocusID).Left = CompDisplay(CompFocusID).Left + diffWidth
            CompDisplay(CompFocusID).Height = CompDisplay(CompFocusID).Height - diffHeight
            CompDisplay(CompFocusID).Top = CompDisplay(CompFocusID).Top + diffHeight
        Case 1
            CompDisplay(CompFocusID).Width = CompDisplay(CompFocusID).Width - diffWidth
            CompDisplay(CompFocusID).Left = CompDisplay(CompFocusID).Left + diffWidth
        Case 2
            CompDisplay(CompFocusID).Width = CompDisplay(CompFocusID).Width - diffWidth
            CompDisplay(CompFocusID).Left = CompDisplay(CompFocusID).Left + diffWidth
            CompDisplay(CompFocusID).Height = CompDisplay(CompFocusID).Height + diffHeight
        Case 3
            CompDisplay(CompFocusID).Height = CompDisplay(CompFocusID).Height + diffHeight
        Case 4
            CompDisplay(CompFocusID).Width = CompDisplay(CompFocusID).Width + diffWidth
            CompDisplay(CompFocusID).Height = CompDisplay(CompFocusID).Height + diffHeight
        Case 5
            CompDisplay(CompFocusID).Width = CompDisplay(CompFocusID).Width + diffWidth
        Case 6
            CompDisplay(CompFocusID).Width = CompDisplay(CompFocusID).Width + diffWidth
            CompDisplay(CompFocusID).Height = CompDisplay(CompFocusID).Height - diffHeight
            CompDisplay(CompFocusID).Top = CompDisplay(CompFocusID).Top + diffHeight
        Case 7
            CompDisplay(CompFocusID).Height = CompDisplay(CompFocusID).Height - diffHeight
            CompDisplay(CompFocusID).Top = CompDisplay(CompFocusID).Top + diffHeight
        End Select
        
        UIComps(CompFocusID).Width = CompDisplay(CompFocusID).Width
        UIComps(CompFocusID).Height = CompDisplay(CompFocusID).Height
        UIComps(CompFocusID).Left = CompDisplay(CompFocusID).Left
        UIComps(CompFocusID).Top = CompDisplay(CompFocusID).Top
        PropsShowData (CompFocusID)
        
        CaretsRePos (CompFocusID)
        isCompChanged = True
    End If
End Sub

Sub CaretsHide()
    Dim i As Integer
    isCaretsShow = False
    For i = 0 To 7
        Carets(i).Visible = False
    Next i
End Sub

Sub CaretsShow()
    Dim i As Integer
    isCaretsShow = True
    For i = 0 To 7
        Carets(i).Visible = True
    Next i
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    MainQuit
End Sub

Sub MainQuit()
    Unload Components
    Unload CompProps
    End
End Sub

Private Sub CompDisplay_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        BtnOldX1 = X: BtnOldY1 = Y
        CompFocusID = Index
        CaretsRePos (CompFocusID)
        
        PropsShow (CompFocusID)
    End If
End Sub

Private Sub CompDisplay_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        CompMoveID = 1
        CaretsHide
        
        CompFocusID = Index
        BtnNewX1 = CompDisplay(CompFocusID).Left + (X - BtnOldX1)
        BtnNewY1 = CompDisplay(CompFocusID).Top + (Y - BtnOldY1)
        
        If BtnNewX1 < 0 Then BtnNewX1 = 0
        If BtnNewY1 < 0 Then BtnNewY1 = 0
        
        CompDisplay(CompFocusID).Move BtnNewX1, BtnNewY1
        If (CompDisplay(CompFocusID).Left + CompDisplay(CompFocusID).Width) > Design.ScaleWidth Then BtnNewX1 = Design.ScaleWidth - CompDisplay(CompFocusID).Width
        If (CompDisplay(CompFocusID).Top + CompDisplay(CompFocusID).Height) > Design.ScaleHeight Then BtnNewY1 = Design.ScaleHeight - CompDisplay(CompFocusID).Height
        
        CompDisplay(CompFocusID).Move BtnNewX1, BtnNewY1
        
        UIComps(CompFocusID).Width = CompDisplay(CompFocusID).Width
        UIComps(CompFocusID).Height = CompDisplay(CompFocusID).Height
        UIComps(CompFocusID).Left = CompDisplay(CompFocusID).Left
        UIComps(CompFocusID).Top = CompDisplay(CompFocusID).Top
        PropsShowData (CompFocusID)
        
        CaretsRePos (CompFocusID)
        isCompChanged = True
    End If
End Sub

Sub CompFocusNone()
    CompProps.MSFlexGrid1.Clear
    CompProps.gridTitle
    CompProps.Text1.Text = ""
    EditableFlag = False: CompProps.Label1.BackColor = RGB(255, 0, 0)
    Design.SetFocus
End Sub

Sub PropsShow(comp As Integer)
    'All properties are in TEXT format
    'Show Grid Title
    CompProps.gridTitle
    'Show Grid data
    CompProps.MSFlexGrid1.TextMatrix(1, 1) = Trim(Str(comp))
    CompProps.MSFlexGrid1.TextMatrix(2, 1) = UIComps(comp).Name
    CompProps.MSFlexGrid1.TextMatrix(3, 1) = UIComps(comp).Caption
    CompProps.MSFlexGrid1.TextMatrix(4, 1) = Trim(Str(UIComps(comp).Width))
    CompProps.MSFlexGrid1.TextMatrix(5, 1) = Trim(Str(UIComps(comp).Height))
    CompProps.MSFlexGrid1.TextMatrix(6, 1) = Trim(Str(UIComps(comp).Left))
    CompProps.MSFlexGrid1.TextMatrix(7, 1) = Trim(Str(UIComps(comp).Top))
End Sub

Sub PropsShowData(comp As Integer)
    'Show Grid data
    CompProps.MSFlexGrid1.TextMatrix(1, 1) = Trim(Str(comp))
    CompProps.MSFlexGrid1.TextMatrix(2, 1) = UIComps(comp).Name
    CompProps.MSFlexGrid1.TextMatrix(3, 1) = UIComps(comp).Caption
    CompProps.MSFlexGrid1.TextMatrix(4, 1) = Trim(Str(UIComps(comp).Width))
    CompProps.MSFlexGrid1.TextMatrix(5, 1) = Trim(Str(UIComps(comp).Height))
    CompProps.MSFlexGrid1.TextMatrix(6, 1) = Trim(Str(UIComps(comp).Left))
    CompProps.MSFlexGrid1.TextMatrix(7, 1) = Trim(Str(UIComps(comp).Top))
End Sub

Sub UICompDelete(comno As Integer)
    UIComps(comno).Name = ""
    UIComps(comno).Caption = ""
    UIComps(comno).Width = 0
    UIComps(comno).Height = 0
    UIComps(comno).Left = 0
    UIComps(comno).Top = 0
    CompFocusNone
End Sub

Sub DrawDesignGrid()
    Dim i, j As Integer
    Design.DrawStyle = 0
    For i = Design.ScaleLeft To Design.ScaleWidth Step GridSpaceH
        For j = Design.ScaleTop To Design.ScaleHeight Step GridSpaceV
            Design.PSet (i, j), RGB(0, 0, 255)
        Next j
    Next i
    For i = Design.ScaleTop To Design.ScaleHeight Step GridSpaceV
        For j = Design.ScaleLeft To Design.ScaleWidth Step GridSpaceH
            Design.PSet (j, i), RGB(0, 0, 255)
        Next j
    Next i
End Sub

Private Sub Form_Resize()
    Design.Cls
    DrawDesignGrid
End Sub

Sub UIwriteout()
    Dim i As Integer
    Open "Projects\UIform\frmUI.frm" For Output Shared As #1
    Write #1, "UIschemar=" + Trim(Str(Design.Width)) + "-" + Trim(Str(Design.Height))
    For i = 1 To CompDisplayID
        If UIComps(i).Name <> "" Then
            Write #1, "Name.Index=" + UIComps(i).Name + "." + Trim(Str(i))
            Write #1, "Caption=" + UIComps(i).Caption
            Write #1, "Width=" + Trim(Str(UIComps(i).Width))
            Write #1, "Height=" + Trim(Str(UIComps(i).Height))
            Write #1, "Left=" + Trim(Str(UIComps(i).Left))
            Write #1, "Top=" + Trim(Str(UIComps(i).Top))
            Write #1, "FontSize=" + Trim(Str(UIComps(i).FontSize))
            DoEvents
        End If
    Next i
    Close #1
End Sub

Sub UIreadin()
    Dim i As Integer
    Dim Index As Integer
    Dim Name As String
    Dim Param As String
    Dim ParamArr() As String
    Dim ParamArrSibling() As String
    
    CaretsHide
    
    'Unload components first
    For i = 1 To CompDisplayID
        If UIComps(i).Name <> "" Then
            Unload CompDisplay(i)
            UICompDelete (i)
        End If
    Next i
    
    'Read in all components
    Open "Projects\UIform\frmUI.frm" For Input Shared As #1
    Do While Not EOF(1)
        Input #1, Param
        ParamArr = Split(Param, "=")
        Select Case ParamArr(0)
        Case "UIschemar"
            ParamArrSibling = Split(ParamArr(1), "-")
            Design.Width = Val(ParamArrSibling(0))
            Design.Height = Val(ParamArrSibling(1))
        Case "Name.Index"
            ParamArrSibling = Split(ParamArr(1), ".")
            Name = ParamArrSibling(0)
            Index = Val(ParamArrSibling(1))
            UIComps(Index).Name = Name
        Case "Caption"
            UIComps(Index).Caption = ParamArr(1)
        Case "Width"
            UIComps(Index).Width = Val(ParamArr(1))
        Case "Height"
            UIComps(Index).Height = Val(ParamArr(1))
        Case "Left"
            UIComps(Index).Left = Val(ParamArr(1))
        Case "Top"
            UIComps(Index).Top = Val(ParamArr(1))
        Case "FontSize"
            UIComps(Index).FontSize = Val(ParamArr(1))
        End Select
    Loop
    Close #1
    
    On Error Resume Next
    For i = 1 To Index
        Load CompDisplay(i)
        CompDisplay(i).Caption = UIComps(i).Caption
        CompDisplay(i).Width = UIComps(i).Width
        CompDisplay(i).Height = UIComps(i).Height
        CompDisplay(i).Left = UIComps(i).Left
        CompDisplay(i).Top = UIComps(i).Top
        CompDisplay(i).Visible = True
        CompDisplayID = i
    Next i
    Err.Clear
End Sub

Sub Codegen()
    Dim CurrComps As Integer
    Dim Name As String
    Dim Param As String
    Dim ParamArr() As String
    Dim ParamArrSibling() As String
    'Code file for write
    Open "Projects\src\frmCode.bas" For Output Shared As #2
    'Read in all components
    Open "Projects\UIform\frmUI.frm" For Input Shared As #1
    Do While Not EOF(1)
        Input #1, Param
        ParamArr = Split(Param, "=")
        Select Case ParamArr(0)
        Case "UIschemar"
            Print #2, "CREATE" + Space(1) + "Design" + Space(1) + "AS QFORM"
            ParamArrSibling = Split(ParamArr(1), "-")
            Print #2, Space(4) + "Width" + Space(1) + "=" + Space(1) + Format$((Val(ParamArrSibling(0)) / TPPPx), "#############")
            Print #2, Space(4) + "Height" + Space(1) + "=" + Space(1) + Format$((Val(ParamArrSibling(1)) / TPPPy), "#############")
            CurrComps = 0
        Case "Name.Index"
            CurrComps = CurrComps + 1
            ParamArrSibling = Split(ParamArr(1), ".")
            Name = ParamArrSibling(0)
            If CurrComps > 1 Then
                Print #2, Space(4) + "END CREATE"
            End If
            If Name = "Label" Then
                Print #2, Space(4) + "CREATE" + Space(1) + "Label" + ParamArrSibling(1) + Space(1) + "AS QLABEL"
            ElseIf Name = "TextBox" Then
                Print #2, Space(4) + "CREATE" + Space(1) + "Edit" + ParamArrSibling(1) + Space(1) + "AS QEDIT"
            ElseIf Name = "Button" Then
                Print #2, Space(4) + "CREATE" + Space(1) + "Button" + ParamArrSibling(1) + Space(1) + "AS QBUTTON"
            End If
        Case "Caption"
            If Name = "Label" Then
                Print #2, Space(8) + "Caption" + Space(1) + "=" + Space(1) + """" + ParamArr(1) + """"
            ElseIf Name = "TextBox" Then
                Print #2, Space(8) + "Text" + Space(1) + "=" + Space(1) + """" + ParamArr(1) + """"
            ElseIf Name = "Button" Then
                Print #2, Space(8) + "Caption" + Space(1) + "=" + Space(1) + """" + ParamArr(1) + """"
            End If
        Case "Width"
            Print #2, Space(8) + "Width" + Space(1) + "=" + Space(1) + Format$((Val(ParamArr(1)) / TPPPx), "#############")
        Case "Height"
            Print #2, Space(8) + "Height" + Space(1) + "=" + Space(1) + Format$((Val(ParamArr(1)) / TPPPy), "#############")
        Case "Left"
            Print #2, Space(8) + "Left" + Space(1) + "=" + Space(1) + Format$((Val(ParamArr(1)) / TPPPx), "#############")
        Case "Top"
            Print #2, Space(8) + "Top" + Space(1) + "=" + Space(1) + Format$((Val(ParamArr(1)) / TPPPy), "#############")
        Case "FontSize"
            Print #2, Space(8) + "Font.Size" + Space(1) + "=" + Space(1) + ParamArr(1)
        End Select
    Loop
    Close #1
    Print #2, Space(4) + "END CREATE"
    Print #2, "END CREATE"
    Print #2,
    Print #2, "'Insert your initialization code here"
    Print #2,
    Print #2, "Design.ShowModal"
    Close #2
End Sub

'Call for conversion of Twips vs Pixel.
Function TwipsPerPixelX() As Single
    '--------------------------------------------------
    'Returns the width of a pixel, in twips.
    '--------------------------------------------------
    Dim lngDC As Long
    lngDC = GetDC(HWND_DESKTOP)
    TwipsPerPixelX = 1440& / GetDeviceCaps(lngDC, LOGPIXELSX)
    TPPPx = TwipsPerPixelX
    ReleaseDC HWND_DESKTOP, lngDC
End Function

Function TwipsPerPixelY() As Single
    '--------------------------------------------------
    'Returns the height of a pixel, in twips.
    '--------------------------------------------------
    Dim lngDC As Long
    lngDC = GetDC(HWND_DESKTOP)
    TwipsPerPixelY = 1440& / GetDeviceCaps(lngDC, LOGPIXELSY)
    TPPPy = TwipsPerPixelY
    ReleaseDC HWND_DESKTOP, lngDC
End Function

组件选择模板代码

复制代码 
Option Explicit

Private Sub Command1_Click()
    Command1.Enabled = False
    Design.UIwriteout
    Command1.Enabled = True
End Sub

Private Sub Command2_Click()
    Command2.Enabled = False
    Design.UIreadin
    Command2.Enabled = True
End Sub

Private Sub Command3_Click()
    Command3.Enabled = False
    Design.Codegen
    Command3.Enabled = True
End Sub

Private Sub CompPal_Click(Index As Integer)
    Design.CaretsHide
    Design.CompFocusNone
    CompSel(Index).Value = True
    CompSelID = Index
End Sub

Private Sub CompSel_Click(Index As Integer)
    Design.CaretsHide
    CompSel(Index).Value = True
    CompSelID = Index
    EditableFlag = False
    CompProps.Label1.BackColor = RGB(255, 0, 0)
End Sub

Private Sub Form_Load()
    CompSel(0).Value = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Cancel = 1
    'Design.MainQuit
End Sub

属性列表窗体代码

复制代码 
Option Explicit

Private Sub Command1_Click()
    If EditableFlag = False Then
        Exit Sub
    End If
    If Trim(Text1.Text) <> "" Then
        MSFlexGrid1.Text = Text1.Text
        'Update components inner array
        UIComps(Val(MSFlexGrid1.TextMatrix(1, 1))).Name = MSFlexGrid1.TextMatrix(2, 1)
        UIComps(Val(MSFlexGrid1.TextMatrix(1, 1))).Caption = MSFlexGrid1.TextMatrix(3, 1)
        UIComps(Val(MSFlexGrid1.TextMatrix(1, 1))).Width = Val(MSFlexGrid1.TextMatrix(4, 1))
        UIComps(Val(MSFlexGrid1.TextMatrix(1, 1))).Height = Val(MSFlexGrid1.TextMatrix(5, 1))
        UIComps(Val(MSFlexGrid1.TextMatrix(1, 1))).Left = Val(MSFlexGrid1.TextMatrix(6, 1))
        UIComps(Val(MSFlexGrid1.TextMatrix(1, 1))).Top = Val(MSFlexGrid1.TextMatrix(7, 1))
        
        'Update visual components
        Design.CompDisplay(Val(MSFlexGrid1.TextMatrix(1, 1))).Caption = MSFlexGrid1.TextMatrix(3, 1)
        Design.CompDisplay(Val(MSFlexGrid1.TextMatrix(1, 1))).Width = Val(MSFlexGrid1.TextMatrix(4, 1))
        Design.CompDisplay(Val(MSFlexGrid1.TextMatrix(1, 1))).Height = Val(MSFlexGrid1.TextMatrix(5, 1))
        Design.CompDisplay(Val(MSFlexGrid1.TextMatrix(1, 1))).Left = Val(MSFlexGrid1.TextMatrix(6, 1))
        Design.CompDisplay(Val(MSFlexGrid1.TextMatrix(1, 1))).Top = Val(MSFlexGrid1.TextMatrix(7, 1))
    End If
End Sub

Private Sub Form_Load()
    EditableFlag = False: Label1.BackColor = RGB(255, 0, 0)
    MSFlexGrid1.Cols = 2
    MSFlexGrid1.Rows = 8
    MSFlexGrid1.FixedRows = 3
    MSFlexGrid1.AllowUserResizing = flexResizeColumns
    MSFlexGrid1.ColAlignment(1) = flexAlignLeftCenter
    
    MSFlexGrid1.RowHeight(0) = 400
    MSFlexGrid1.RowHeight(1) = 400
    MSFlexGrid1.RowHeight(2) = 400
    MSFlexGrid1.RowHeight(3) = 400
    MSFlexGrid1.RowHeight(4) = 400
    MSFlexGrid1.RowHeight(5) = 400
    MSFlexGrid1.RowHeight(6) = 400
    MSFlexGrid1.RowHeight(7) = 400
    MSFlexGrid1.ColWidth(0) = 2000
    MSFlexGrid1.ColWidth(1) = 3500
    gridTitle
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Cancel = 1
End Sub

Private Sub MSFlexGrid1_EnterCell()
    If MSFlexGrid1.TextMatrix(1, 1) = "" Then
        Exit Sub
    End If
    Text1.Text = MSFlexGrid1.Text
    EditableFlag = True:   Label1.BackColor = RGB(0, 255, 0)
End Sub

Sub gridTitle()
    MSFlexGrid1.TextMatrix(0, 1) = "Properties"
    MSFlexGrid1.TextMatrix(1, 0) = "Index"
    MSFlexGrid1.TextMatrix(2, 0) = "Name"
    MSFlexGrid1.TextMatrix(3, 0) = "Caption"
    MSFlexGrid1.TextMatrix(4, 0) = "Width"
    MSFlexGrid1.TextMatrix(5, 0) = "Height"
    MSFlexGrid1.TextMatrix(6, 0) = "Left"
    MSFlexGrid1.TextMatrix(7, 0) = "Top"
End Sub

全部代码都齐了，还有一个.res文件是vb6编译时用于感知DPI和做xp样式用的，直接作为资源文件加到项目中即可。

源代码打包上传到CSDN了

【免费】简单的UI界面设计程序VB6源代码资源-CSDN下载

相关推荐
TT哇10 小时前
【实习】数字营销系统 银行经理端（interact_bank）前端 Vue 移动端页面的 UI 重构与优化
java·前端·vue.js·ui
木斯佳10 小时前
周末杂谈：UI-UX Pro Max Skill：为AI编程助手注入专业设计智能的终极利器
ui·ai编程·ux
手揽回忆怎么睡10 小时前
opencode和TRAE使用Superpowers 和ui-ux-pro-max skillls
ide·ui·ai·ux
草莓熊Lotso12 小时前
Qt 主窗口核心组件实战：菜单栏、工具栏、状态栏、浮动窗口全攻略
运维·开发语言·人工智能·python·qt·ui
御承扬1 天前
鸿蒙NDK UI之文本自定义样式
ui·华为·harmonyos·鸿蒙ndk ui
一起养小猫1 天前
Flutter for OpenHarmony 实战_魔方应用UI设计与交互优化
flutter·ui·交互·harmonyos
会一点设计1 天前
6个优质春节海报模板网站推荐！轻松设计马年祝福海报
ui·ux
hudawei9962 天前
TweenAnimationBuilder和AnimatedBuilder两种动画的比较
flutter·ui·动画·tweenanimation·animatedbuilder
依米阳光082 天前
Playwright MCP AI实现自动化UI测试
ui·自动化·playwright·mcp
热门推荐
01GitHub 镜像站点02Claude Code + GLM4.7 避坑指南：解决 Unable to connect to Anthropic services03openclaw配置教程（linux+局域网ollama）04UV安装并设置国内源05AI 规范驱动开发“三剑客”深度对比：Spec-Kit、Kiro 与 OpenSpec 实战指南06Linux下V2Ray安装配置指南07openclaw使用nginx反代部署过程 与disconnected (1008): pairing required解决08在Trae中使用Pencil MCP09Claude Code Skills 实用使用手册10Vue-skills的中文文档