简单地，用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 LongUI设计界面代码
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下载
