新增多种信息框全新的字体渲染（DEMO）全新Builder UI

buger404 · Feb 8, 2020 · 6050d10 · 6050d10
1 parent 26722d5
commit 6050d10
Show file tree

Hide file tree

Showing 23 changed files with 790 additions and 548 deletions.
diff --git a/Builder.exe b/Builder.exe
diff --git a/Builder/BuilderCore.bas b/Builder/BuilderCore.bas
@@ -5,6 +5,7 @@ Public OPath As String, PackPos As Long
 Public WelcomePage As WelcomePage, TitleBar As TitleBar, SetupPage As SetupPage
 Public ToNewPage As ToNewPage
 Public LnkSwitch As Boolean
+Public NowY As Long, TargetY As Long
 Public Type EmrPConfig
     AFileHeader As String
     Name As String
@@ -44,6 +45,7 @@ Public Sub Main()
     OPath = Replace(Trim(Command$), """", "")
     'OPath = "E:\Error 404\Muing III"
     'OPath = "E:\Error 404\Emerald 动画包含资源提取工具\"
+    'OPath = "E:\Projects\Moristory2"
     'OPath = "E:\Projects\Rainbow"
     'OPath = "D:\Test\"
 

diff --git a/Builder/MainWindow.frm b/Builder/MainWindow.frm
@@ -35,6 +35,13 @@ Attribute VB_Exposed = False
 '==================================================
 Private Sub DrawTimer_Timer()
     '绘制
+    NowY = NowY + (TargetY - NowY) / 10
+    If Me.top <> NowY Then Me.top = NowY
+    If Me.top > Screen.Height + Me.Height * 1.5 Then
+        Unload Me
+        End
+    End If
+
     If EC.ActivePage = "" Then Exit Sub
     EC.Display
 End Sub
@@ -49,7 +56,7 @@ Private Sub Form_Load()
     If SetupMode Then
         StartEmerald Me.Hwnd, 401, 613
     Else
-        StartEmerald Me.Hwnd, 991, 754
+        StartEmerald Me.Hwnd, 701 * 0.8, 661 * 0.8
     End If
     'ScaleGame 1.2, ScaleDefault
 
@@ -82,11 +89,15 @@ Private Sub Form_Load()
         Set SetupPage = New SetupPage
     End If
 
-    ECore.FreezeMode = True
+    'ECore.FreezeMode = True
 
     '设置活动页面
     If PackPos = -1 Then EC.ActivePage = "WelcomePage"
 
+    Me.Show
+    NowY = Screen.Height + Me.Height
+    TargetY = Me.top
+    Me.top = Screen.Height + Me.Height
     DrawTimer.Enabled = True
 End Sub
 

diff --git a/Builder/SetupPackage.bas b/Builder/SetupPackage.bas
@@ -120,15 +120,15 @@ Public Sub MakePackage(ByVal path As String, GMaker As String, GName As String,
                 .Files(UBound(.Files)).Data = Data
                 .Files(UBound(.Files)).path = Files(I)
             End With
-            If PackPos = -1 Then WelcomePage.PackText = "正在打包 '" & Files(I) & "' ..."
+            If PackPos = -1 Then WelcomePage.PackText = "打包 '" & Files(I) & "' ..."
         Else
-            If PackPos = -1 Then WelcomePage.PackText = "正在移除 '" & Files(I) & "' ..."
+            If PackPos = -1 Then WelcomePage.PackText = "排除 '" & Files(I) & "' ..."
         End If
         ECore.Display: DoEvents
     Next
 
     '导出.emrpack文件
-    If PackPos = -1 Then WelcomePage.PackText = "正在导出包 ..."
+    If PackPos = -1 Then WelcomePage.PackText = "导出包 ..."
     If Dir(VBA.Environ("temp") & "\emrpack.empack") <> "" Then Kill VBA.Environ("temp") & "\emrpack.empack"
     Open VBA.Environ("temp") & "\emrpack.empack" For Binary As #1
     Put #1, , Package

diff --git a/Builder/TitleBar.cls b/Builder/TitleBar.cls
@@ -14,33 +14,30 @@ Attribute VB_Exposed = False
 '======================================
 '   页面绘制器
     Dim Page As GPage
+    Dim SX As Long, SY As Long
 '======================================
 
 Public Sub Update()
     '绘制事件
 
     Page.Clear 0 '清空画布
-
-    Dim m As Integer
-    m = CheckMouse(GW - 50 - 19, 30, 36, 36)
-    If Page.ShowColorButton(1, GW - 50 - 19, 30, 36, 36, "×", IIf(m = 0, argb(255, 128, 128, 128), argb(255, 255, 255, 255)), argb(0, 254, 84, 57), argb(255, 254, 84, 57), size:=18) = 2 Then
-        Unload MainWindow
-        End
-    End If
-
-    m = CheckMouse(GW - 110 - 19, 30, 36, 36)
-    If Page.ShowColorButton(1, GW - 110 - 19, 30, 36, 36, "-", IIf(m = 0, argb(255, 128, 128, 128), argb(255, 255, 255, 255)), argb(0, 128, 128, 128), argb(100, 128, 128, 128), size:=18) = 2 Then
-        MainWindow.WindowState = 1
-        Mouse.State = 0
-    End If
 
-    m = CheckMouse(0, 12, GW - 120, 30 + 16 / 0.75)
+    m = CheckMouse(231, 8, 98, 94)
     If m >= 1 And Mouse.button = 1 Then
+        If SX = -1 Then
+            SX = MainWindow.Left: SY = MainWindow.top
+        End If
         ReleaseCapture
         SendMessageA MainWindow.Hwnd, WM_SYSCOMMAND, SC_MOVE Or HTCAPTION, 0
+        NowY = MainWindow.top: TargetY = MainWindow.top
         Mouse.State = 0
     End If
-    If m = 3 Then Mouse.State = 0
+    If m = 2 Then
+        If MainWindow.Left = SX And MainWindow.top = SY Then
+            TargetY = Screen.Height + MainWindow.Height * 2
+        End If
+        SX = -1: Mouse.State = 0: Mouse.button = 0
+    End If
 End Sub
 Public Sub Wheel(Direction As Integer, Depth As Single)
     '鼠标滚轮事件
@@ -70,7 +67,7 @@ Private Sub Class_Initialize()
     Page.TopPage = True '置顶页面
     '创建页面
     ECore.Add Page, "TitleBar"
-
+    SX = -1
     '===============================================
     '   如果需要添加动画，请放置在此处
 

diff --git a/Builder/ToNewPage.cls b/Builder/ToNewPage.cls
@@ -116,18 +116,18 @@ Public Sub DrawPage4()
     End If
 End Sub
 Public Sub DrawPage5()
-    Page.Writes "欢迎使用 Emerald 游戏创建向导", 70, 104, 18, argb(255, 64, 64, 64)
-    Page.Writes "使用此向导快速创建您的游戏", 70, 128, 18, argb(255, 96, 96, 96)
+    Page.Writes "Emerald·创造", RGW / 2, 120, 18, argb(255, 0, 0, 0), align:=StringAlignmentCenter, style:=FontStyleBold
+    Page.Writes "使用此向导快速创建您的工程", RGW / 2, 160, 18, argb(200, 16, 16, 30), align:=StringAlignmentCenter
 
-    Page.Writes "欲创建游戏的名称", 70, 200, 18, argb(255, 35, 170, 242)
-    Page.ShowEdit ProjectName, 0, 70, 240, 500, 30, argb(255, 96, 96, 96), argb(0, 255, 255, 255), argb(255, 242, 242, 242), argb(255, 35, 170, 242), size:=18
+    Page.Writes "工程名称", 85, 200, 18, argb(255, 0, 0, 0)
+    Page.ShowEdit ProjectName, 0, 200, 200, 250, 30, argb(200, 32, 32, 36), argb(0, 255, 255, 255), argb(255, 242, 242, 242), argb(255, 62, 206, 196), size:=18
 
-    Page.Writes "选项", 70, 320, 18, argb(255, 35, 170, 242)
-    Page.ShowColorCheckBox InitWindow, 73, 360, 500, 20, "创建好一个游戏窗口", argb(255, 198, 198, 198), argb(255, 35, 170, 242), argb(255, 96, 96, 96), 18
-    Page.ShowColorCheckBox InitPage, 73, 390, 500, 20, "创建好一个游戏页面", argb(255, 198, 198, 198), argb(255, 35, 170, 242), argb(255, 96, 96, 96), 18
-    Page.ShowColorCheckBox OpenPro, 73, 420, 500, 20, "在我创建完之后打开工程", argb(255, 198, 198, 198), argb(255, 35, 170, 242), argb(255, 96, 96, 96), 18
+    Page.Writes "选项", 85, 240, 18, argb(255, 0, 0, 0)
+    Page.ShowColorCheckBox InitWindow, 85 + 3, 280, 500, 20, "创建好一个游戏窗口", argb(255, 200, 200, 200), argb(255, 60, 205, 195), argb(200, 32, 32, 36), 18
+    Page.ShowColorCheckBox InitPage, 85 + 3, 320, 500, 20, "创建好一个游戏页面", argb(255, 200, 200, 200), argb(255, 60, 205, 195), argb(200, 32, 32, 36), 18
+    Page.ShowColorCheckBox OpenPro, 85 + 3, 360, 500, 20, "在我创建完之后打开工程", argb(255, 200, 200, 200), argb(255, 60, 205, 195), argb(200, 32, 32, 36), 18
 
-    If Page.ShowColorButton(0, GW / 2 - 70, GH - 120, 140, 40, "好的", argb(255, 255, 255, 255), argb(255, 35, 170, 242), argb(255, 75, 210, 255), 40, size:=18, style:=FontStyleBold) = 3 Then
+    If Page.ShowColorButton(2, GW / 2 - 200, GH - 110, 400, 40, "开始创造", argb(255, 255, 255, 255), argb(255, 105, 227, 218), argb(255, 59, 205, 195), 40, size:=18, style:=FontStyleBold) = 3 Then
         If CheckFileName(ProjectName) = False Or ProjectName = "" Then MsgBox "这个游戏名称不能被接受呢。换一个吧。", 64: Exit Sub
 
         If Dir(OPath & "\core", vbDirectory) = "" Then MkDir OPath & "\core"
@@ -191,7 +191,7 @@ Public Sub Update()
     '游戏每一帧的过程（绘制过程请放在此处）
 
     Page.Clear 0 '清空画布
-    Page.DrawImage "background2.png", 0, 0, alpha:=1
+    Page.DrawImage "background.png", 0, 0, alpha:=1
 
     CallByName Me, "DrawPage" & PageIndex, VbMethod
 End Sub
@@ -206,8 +206,17 @@ Public Sub Enter()
     '页面进入事件
     Page.StartAnimation 1, 500
     Page.StartAnimation 2, 750
-    ProjectName = "Project1"
     Maker = ESave.GetData("Maker")
+    Dim temp() As String
+    temp = Split(OPath, "\")
+    If UBound(temp) > 0 Then
+        If temp(UBound(temp)) = "" Then ReDim Preserve temp(UBound(temp) - 1)
+    End If
+    If UBound(temp) > 0 Then
+        ProjectName = temp(UBound(temp))
+    Else
+        ProjectName = "MyProject"
+    End If
 End Sub
 Public Sub Leave()
     '页面离开事件
@@ -227,7 +236,7 @@ Private Sub Class_Initialize()
     Set Page = New GPage
     Page.Create Me
     '导入游戏资源
-    If PackPos = -1 Then Page.Res.NewImages App.path & "\assets", 0.75
+    If PackPos = -1 Then Page.Res.NewImages App.path & "\assets", 0.8
     '创建页面
     ECore.Add Page, "ToNewPage"