Skip to content
This repository has been archived by the owner on Jun 22, 2022. It is now read-only.

Commit

Permalink
全新卷轴模式
Browse files Browse the repository at this point in the history
  • Loading branch information
@buger404
buger404 committed Jan 29, 2020
1 parent 47d35d0 commit 26722d5
Show file tree
Hide file tree
Showing 8 changed files with 197 additions and 159 deletions.
Binary file modified Builder.exe
View file
Binary file not shown.
3 changes: 3 additions & 0 deletions Builder/BuilderCore.bas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -97,6 +97,7 @@ Public Sub Main()
MainWindow.WindowState = 1
MainWindow.WindowState = 0
MainWindow.SetFocus
ShowWindow MainWindow.Hwnd, SW_SHOW

If SPackage.Files(0).path <> "" Then
Open tempPath & "\setupappicon.png" For Binary As #1
Expand Down Expand Up @@ -139,6 +140,8 @@ UninstallGame:
MainWindow.WindowState = 1
MainWindow.WindowState = 0
MainWindow.SetFocus
ShowWindow MainWindow.Hwnd, SW_SHOW

Kill tempPath & "\setuppack.emrpack"
SetupPage.Step = 4
ECore.ActivePage = "SetupPage"
Expand Down
26 changes: 13 additions & 13 deletions Builder/WelcomePage.cls
View file
Original file line number Diff line number Diff line change
Expand Up @@ -366,13 +366,13 @@ Public Sub DrawProject()
max = Int(UBound(UFiles) / 6) + 1
Page.Writes FileIndex + 1 & "/" & max, 600, 430 + 30 * 7 + 5, 18, argb(255, 242, 242, 242), 120, 20, align:=StringAlignmentCenter
If FileIndex + 1 > 1 Then
If Page.ShowColorButton(1, 600, 430 + 30 * 7 + 5, 20, 20, "<", argb(255, 255, 255, 255), argb(255, 35, 170, 242), argb(255, 64, 255, 226), 40, size:=16) = 3 Then
If Page.ShowColorButton(1, 600, 430 + 30 * 7 + 5, 20, 20, "<", argb(255, 255, 255, 255), argb(255, 35, 170, 242), argb(255, 75, 210, 255), 40, size:=16) = 3 Then
FileIndex = FileIndex - 1
ECore.NewTransform
End If
End If
If FileIndex + 1 < max Then
If Page.ShowColorButton(1, 700, 430 + 30 * 7 + 5, 20, 20, ">", argb(255, 255, 255, 255), argb(255, 35, 170, 242), argb(255, 64, 255, 226), 40, size:=16) = 3 Then
If Page.ShowColorButton(1, 700, 430 + 30 * 7 + 5, 20, 20, ">", argb(255, 255, 255, 255), argb(255, 35, 170, 242), argb(255, 75, 210, 255), 40, size:=16) = 3 Then
FileIndex = FileIndex + 1
ECore.NewTransform
End If
Expand All @@ -381,7 +381,7 @@ Public Sub DrawProject()

Page.ShowColorCheckBox BackupSwitch, 384, GH - 80, 200, 20, "同时创建备份", argb(255, 242, 242, 242), argb(255, 35, 170, 242), argb(255, 242, 242, 242), 18

If Page.ShowColorButton(0, GW - 180, GH - 82, 120, 30, IIf(ReplaceAccept = 0, "替换代码", "确认替换 (" & Round(5 - (GetTickCount - ReplaceAccept) / 1000) & "s)"), argb(255, 255, 255, 255), IIf(ReplaceAccept = 0, argb(255, 35, 170, 242), argb(255, 254, 84, 57)), IIf(ReplaceAccept = 0, argb(255, 64, 255, 226), argb(255, 255, 124, 97)), 40, size:=18) = 3 Then
If Page.ShowColorButton(0, GW - 180, GH - 82, 120, 30, IIf(ReplaceAccept = 0, "替换代码", "确认替换 (" & Round(5 - (GetTickCount - ReplaceAccept) / 1000) & "s)"), argb(255, 255, 255, 255), IIf(ReplaceAccept = 0, argb(255, 35, 170, 242), argb(255, 254, 84, 57)), IIf(ReplaceAccept = 0, argb(255, 75, 210, 255), argb(255, 255, 124, 97)), 40, size:=18) = 3 Then
If ReplaceAccept > 0 Then
ReplaceAccept = -1
Call ReplaceProject
Expand Down Expand Up @@ -417,7 +417,7 @@ Public Sub DrawBackup()
End If
Page.Writes Left(BackupList(I).Name, 22) & IIf(Len(BackupList(I).Name) > 22, "...", "") & " (" & BackupList(I).FileCount & " 个文件)", 392, 120 + 70 * (I - BackupIndex * 6) - 2, 18, argb(255, 255, 255, 255)
Page.Writes BackupList(I).Date & " (" & BackupList(I).size & "字节)", 392, 120 + 70 * (I - BackupIndex * 6) - 2 + 25, 18, argb(255, 192, 192, 192)
If Page.ShowColorButton(0, GW - 170, 117 + 70 * (I - BackupIndex * 6) + 8, 100, 30, IIf(BackupList(I).UseTime = 0, "还原", "确认 (" & Round(5 - (GetTickCount - BackupList(I).UseTime) / 1000) & "s)"), argb(255, 255, 255, 255), IIf(BackupList(I).UseTime = 0, argb(255, 35, 170, 242), argb(255, 254, 84, 57)), IIf(BackupList(I).UseTime = 0, argb(255, 64, 255, 226), argb(255, 255, 124, 97)), 40, size:=18) = 3 Then
If Page.ShowColorButton(0, GW - 170, 117 + 70 * (I - BackupIndex * 6) + 8, 100, 30, IIf(BackupList(I).UseTime = 0, "还原", "确认 (" & Round(5 - (GetTickCount - BackupList(I).UseTime) / 1000) & "s)"), argb(255, 255, 255, 255), IIf(BackupList(I).UseTime = 0, argb(255, 35, 170, 242), argb(255, 254, 84, 57)), IIf(BackupList(I).UseTime = 0, argb(255, 75, 210, 255), argb(255, 255, 124, 97)), 40, size:=18) = 3 Then
If BackupList(I).UseTime > 0 Then
If BackupList(I).size = -1 Then
ShellExecuteA 0, "open", OPath & "\.emr\backup\", "", "", SW_SHOW
Expand Down Expand Up @@ -464,13 +464,13 @@ Public Sub DrawBackup()
max = Int(UBound(BackupList) / 6) + 1
Page.Writes BackupIndex + 1 & "/" & max, 600, 430 + 30 * 7 + 5, 18, argb(255, 242, 242, 242), 120, 20, align:=StringAlignmentCenter
If BackupIndex + 1 > 1 Then
If Page.ShowColorButton(1, 600, 430 + 30 * 7 + 5, 20, 20, "<", argb(255, 255, 255, 255), argb(255, 35, 170, 242), argb(255, 64, 255, 226), 40, size:=16) = 3 Then
If Page.ShowColorButton(1, 600, 430 + 30 * 7 + 5, 20, 20, "<", argb(255, 255, 255, 255), argb(255, 35, 170, 242), argb(255, 75, 210, 255), 40, size:=16) = 3 Then
BackupIndex = BackupIndex - 1
ECore.NewTransform
End If
End If
If BackupIndex + 1 < max Then
If Page.ShowColorButton(1, 700, 430 + 30 * 7 + 5, 20, 20, ">", argb(255, 255, 255, 255), argb(255, 35, 170, 242), argb(255, 64, 255, 226), 40, size:=16) = 3 Then
If Page.ShowColorButton(1, 700, 430 + 30 * 7 + 5, 20, 20, ">", argb(255, 255, 255, 255), argb(255, 35, 170, 242), argb(255, 75, 210, 255), 40, size:=16) = 3 Then
BackupIndex = BackupIndex + 1
ECore.NewTransform
End If
Expand Down Expand Up @@ -506,7 +506,7 @@ Public Sub DrawPackage()
Page.Writes "我们无法继续制作安装包。", 381, 205, 18, argb(255, 242, 242, 242)
Else
Page.Writes "一切准备就绪！", 381, 205, 18, argb(255, 242, 242, 242)
If Page.ShowColorButton(0, GW - 220, GH - 112, 150, 40, "制作", argb(255, 255, 255, 255), argb(255, 35, 170, 242), argb(255, 64, 255, 226), 40, size:=18) = 3 Then
If Page.ShowColorButton(0, GW - 220, GH - 112, 150, 40, "制作", argb(255, 255, 255, 255), argb(255, 35, 170, 242), argb(255, 75, 210, 255), 40, size:=18) = 3 Then
PackState = 1: PackText = "正在准备..."
Call BuildInstaller
PackState = 0
Expand Down Expand Up @@ -622,7 +622,7 @@ Public Sub Update()
End If

Page.Clear argb(0, 0, 0, 0)
Page.DrawImage "background" & IIf((ESave.GetData("Emerald 3.1") = "") Or (ReadProject = False And OPath <> "" And Dir(OPath & "\.emerald") = ""), "2", "") & ".png", 0, 0, alpha:=1
Page.DrawImage "background" & IIf((ESave.GetData("Emerald 3.1") = "") Or (ReadProject = False And OPath <> "" And Dir(OPath & "\.emerald") = ""), "2", "") & ".png", 0, 0, Alpha:=1
If Cliped = 0 Then Cliped = 1

'Page.PaintLine 342, 32 + 24, 342, GH - 40 - 24 + 1, argb(255, 235, 235, 235), 1
Expand Down Expand Up @@ -657,19 +657,19 @@ Public Sub Update()
SkipThis:
Next

Page.DrawImage "project.png", 60, 135, alpha:=1
Page.DrawImage "project.png", 60, 135, Alpha:=1
Page.Writes "工程", 110, 135, 18, argb(255, 255, 255, 255)

Page.DrawImage "backup.png", 60, 135 + 50, alpha:=1
Page.DrawImage "backup.png", 60, 135 + 50, Alpha:=1
Page.Writes "备份", 110, 135 + 50, 18, argb(255, 255, 255, 255)

Page.DrawImage "package.png", 60, 135 + 50 * 2, alpha:=1
Page.DrawImage "package.png", 60, 135 + 50 * 2, Alpha:=1
Page.Writes "打包", 110, 135 + 50 * 2, 18, argb(255, 255, 255, 255)

Page.DrawImage "settings.png", 60, 135 + 50 * 3, alpha:=1
Page.DrawImage "settings.png", 60, 135 + 50 * 3, Alpha:=1
Page.Writes "设置", 110, 135 + 50 * 3, 18, argb(255, 255, 255, 255)

Page.DrawImage "information.png", 60, 135 + 50 * 4, alpha:=1
Page.DrawImage "information.png", 60, 135 + 50 * 4, Alpha:=1
Page.Writes "关于", 110, 135 + 50 * 4, 18, argb(255, 255, 255, 255)

Select Case PageIndex
Expand Down
3 changes: 3 additions & 0 deletions Core/AboutMe.bas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -52,6 +52,9 @@ Attribute VB_Name = "AboutMe"
'========================================================
' 更新日志
'========================================================
' 更新内容(ver.200129)
' -全新的卷轴模式
' -不加载错误资源
' 更新内容(ver.200128)
' -永久移除卷轴模式的相关代码（因为其功能已经过时）
' -修复系统页面被冻结的问题
Expand Down
87 changes: 59 additions & 28 deletions Core/GCore.bas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ Attribute VB_Name = "GCore"
State As Integer
button As Integer
X As Single
y As Single
Y As Single
End Type
Public Enum PlayStateMark
musStopped = 0
Expand Down Expand Up @@ -84,7 +84,7 @@ Attribute VB_Name = "GCore"
End Enum
Public Type GraphicsBound
X As Single
y As Single
Y As Single
Width As Single
Height As Single
WSc As Single
Expand Down Expand Up @@ -112,6 +112,12 @@ Attribute VB_Name = "GCore"
ScaleFullScreen = 1
ScaleSuitable = 2
End Enum
Public Type ScrollArea
Width As Long
Height As Long
Graphics As Long
DC As Long
End Type
Public SGS() As Suggestion, SGTime As Long
Public ColorLists() As ColorCollection
Public ECore As GMan, EF As GFont, EAni As Object, ESave As GSaving, EMusic As GMusicList
Expand All @@ -123,7 +129,7 @@ Attribute VB_Name = "GCore"
Public FPSWarn As Long
Public EmeraldInstalled As Boolean
Public BassInstalled As Boolean
Public Const Version As Long = 20012801 'oka
Public Const Version As Long = 20012901 'okayy
Public TextHandle As Long, WaitChr As String
Public XPMode As Boolean
Public Scales As Single
Expand Down Expand Up @@ -167,6 +173,31 @@ Attribute VB_Name = "GCore"
Data.PutData "UpdateCheckInterval", UpdateCheckInterval
Data.PutData "UpdateTimeOut", UpdateTimeOut
End Sub
Public Function CreateScrollArea(ByVal Width As Long, ByVal Height As Long) As ScrollArea
With CreateScrollArea
.DC = CreateCDC(Width, Height)
PoolCreateFromHdc .DC, .Graphics
.Width = Width
.Height = Height
GdipSetSmoothingMode .Graphics, SmoothingModeAntiAlias
GdipSetTextRenderingHint .Graphics, TextRenderingHintAntiAlias
End With
End Function
Public Sub StartScrollArea(Page As GPage, Area As ScrollArea)
If Page.ScrollMode Then Suggest "请先结束上一个卷轴区域。", ClearOnUpdate, 1: Exit Sub
Page.OODC = Page.CDC: Page.OOGG = Page.GG
Page.CDC = Area.DC: Page.GG = Area.Graphics
Page.ScrollWidth = Area.Width: Page.ScrollHeight = Area.Height
Page.ScrollMode = True
End Sub
Public Sub EndScrollArea(Page As GPage, ByVal X As Long, ByVal Y As Long, ByVal CX As Long, ByVal CY As Long, Optional ByVal Width As Long = -1, Optional ByVal Height As Long = -1, Optional ByVal Alpha As Single = 1)
If Not Page.ScrollMode Then Suggest "请先启动一个卷轴区域。", ClearOnUpdate, 1: Exit Sub
If Width = -1 Then Width = Page.ScrollWidth
If Height = -1 Then Height = Page.ScrollHeight
PaintDC Page.CDC, Page.OODC, X, Y, CX, CY, Width, Height, Alpha
Page.CDC = Page.OODC: Page.GG = Page.OOGG
Page.ScrollMode = False
End Sub
Public Sub GetSettings(Optional SkipDebug As Boolean = False)
If App.LogMode <> 0 And SkipDebug = False Then Exit Sub

Expand Down Expand Up @@ -385,28 +416,28 @@ sth:
'画~
PoolDeleteEffect e '垃圾处理
End Sub
Public Sub PaintDC(DC As Long, destDC As Long, Optional X As Long = 0, Optional y As Long = 0, Optional cx As Long = 0, Optional cy As Long = 0, Optional cw, Optional ch, Optional alpha)
Public Sub PaintDC(DC As Long, destDC As Long, Optional X As Long = 0, Optional Y As Long = 0, Optional CX As Long = 0, Optional CY As Long = 0, Optional cw, Optional ch, Optional Alpha)
Dim B As BLENDFUNCTION, index As Integer, bl As Long

If Not IsMissing(alpha) Then
If alpha < 0 Then alpha = 0
If alpha > 1 Then alpha = 1
If Not IsMissing(Alpha) Then
If Alpha < 0 Then Alpha = 0
If Alpha > 1 Then Alpha = 1
With B
.AlphaFormat = &H1
.BlendFlags = &H0
.BlendOp = 0
.SourceConstantAlpha = Int(alpha * 255)
.SourceConstantAlpha = Int(Alpha * 255)
End With
CopyMemory bl, B, 4
End If

If IsMissing(cw) Then cw = RGW - cx
If IsMissing(ch) Then ch = RGH - cy
If IsMissing(cw) Then cw = RGW - CX
If IsMissing(ch) Then ch = RGH - CY

If IsMissing(alpha) Then
BitBlt destDC, X, y, cw, ch, DC, cx, cy, vbSrcCopy
If IsMissing(Alpha) Then
BitBlt destDC, X, Y, cw, ch, DC, CX, CY, vbSrcCopy
Else
AlphaBlend destDC, X, y, cw, ch, DC, cx, cy, cw, ch, bl
AlphaBlend destDC, X, Y, cw, ch, DC, CX, CY, cw, ch, bl
End If
End Sub
Function Cubic(t As Single, arg0 As Single, arg1 As Single, arg2 As Single, arg3 As Single) As Single
Expand All @@ -416,36 +447,36 @@ sth:
End Function
'========================================================
' Mouse
Public Sub UpdateMouse(X As Single, y As Single, State As Long, button As Integer)
Public Sub UpdateMouse(X As Single, Y As Single, State As Long, button As Integer)
With Mouse
.X = X
.y = y
.Y = Y
.State = State
.button = button
End With
End Sub
Public Function CheckMouse(ByVal X As Long, ByVal y As Long, ByVal W As Long, ByVal H As Long) As MButtonState
Public Function CheckMouse(ByVal X As Long, ByVal Y As Long, ByVal W As Long, ByVal H As Long) As MButtonState
'Return Value:0=none,1=in,2=down,3=up
If Scales <> 1 Then
X = X * Scales: y = y * Scales
X = X * Scales: Y = Y * Scales
W = W * Scales
H = H * Scales
End If
If Debug_mouse Then
GdipSetSolidFillColor ECore.pB, argb(20, 255, 0, 0)
GdipFillRectangle ECore.UPage.GG, ECore.pB, X, y, W, H
GdipFillRectangle ECore.UPage.GG, ECore.pB, X, Y, W, H
End If
If ECore.LockPage <> "" Then
If ECore.LockPage <> ECore.UpdatingPage Then Exit Function
End If
If Mouse.X >= X And Mouse.y >= y And Mouse.X <= X + W And Mouse.y <= y + H Then
If Mouse.X >= X And Mouse.Y >= Y And Mouse.X <= X + W And Mouse.Y <= Y + H Then
If ECore.FreezeMode Then ECore.FreezeResetBegin = True
If Debug_mouse Then
GdipSetSolidFillColor ECore.pB, argb(255, 27, 27, 27)
GdipFillEllipse ECore.UPage.GG, ECore.pB, X - 10, y - 10, 20, 20
GdipFillEllipse ECore.UPage.GG, ECore.pB, X - 10, Y - 10, 20, 20
GdipSetSolidFillColor ECore.pB, argb(80, 255, 0, 0)
GdipFillRectangle ECore.UPage.GG, ECore.pB, X, y, W, H
EF.Writes Mouse.State + 1, X - 10, y - 7, ECore.UPage.GG, argb(255, 255, 255, 255), 14, 20, 0, StringAlignmentCenter, FontStyleBold
GdipFillRectangle ECore.UPage.GG, ECore.pB, X, Y, W, H
EF.Writes Mouse.State + 1, X - 10, Y - 7, ECore.UPage.GG, argb(255, 255, 255, 255), 14, 20, 0, StringAlignmentCenter, FontStyleBold
End If
CheckMouse = Mouse.State + 1
If Mouse.State = 2 Then Mouse.State = 0
Expand All @@ -455,23 +486,23 @@ sth:
'Return Value:0=none,1=in,2=down,3=up
If Debug_mouse Then
GdipSetSolidFillColor ECore.pB, argb(20, 0, 0, 255)
GdipFillRectangle ECore.UPage.GG, ECore.pB, DrawF.X, DrawF.y, DrawF.Width, DrawF.Height
GdipFillRectangle ECore.UPage.GG, ECore.pB, DrawF.X, DrawF.Y, DrawF.Width, DrawF.Height
End If
If ECore.LockPage <> "" Then
If ECore.LockPage <> ECore.UpdatingPage Then Exit Function
End If
If Mouse.X >= DrawF.X And Mouse.y >= DrawF.y And Mouse.X <= DrawF.X + DrawF.Width And Mouse.y <= DrawF.y + DrawF.Height Then
If Mouse.X >= DrawF.X And Mouse.Y >= DrawF.Y And Mouse.X <= DrawF.X + DrawF.Width And Mouse.Y <= DrawF.Y + DrawF.Height Then
If ECore.FreezeMode Then ECore.FreezeResetBegin = True
If Debug_mouse Then
GdipSetSolidFillColor ECore.pB, argb(255, 27, 27, 27)
GdipFillEllipse ECore.UPage.GG, ECore.pB, DrawF.X - 10, DrawF.y - 10, 20, 20
GdipFillEllipse ECore.UPage.GG, ECore.pB, DrawF.X - 10, DrawF.Y - 10, 20, 20
GdipSetSolidFillColor ECore.pB, argb(80, 0, 0, 255)
GdipFillRectangle ECore.UPage.GG, ECore.pB, DrawF.X, DrawF.y, DrawF.Width, DrawF.Height
EF.Writes Mouse.State + 1, DrawF.X - 10, DrawF.y - 7, ECore.UPage.GG, argb(255, 255, 255, 255), 14, 20, 0, StringAlignmentCenter, FontStyleBold
GdipFillRectangle ECore.UPage.GG, ECore.pB, DrawF.X, DrawF.Y, DrawF.Width, DrawF.Height
EF.Writes Mouse.State + 1, DrawF.X - 10, DrawF.Y - 7, ECore.UPage.GG, argb(255, 255, 255, 255), 14, 20, 0, StringAlignmentCenter, FontStyleBold
End If
CheckMouse2 = Mouse.State + 1
If DrawF.CrashIndex <> 0 Then
If ColorLists(DrawF.CrashIndex).IsAlpha((Mouse.X - DrawF.X) * DrawF.WSc, (Mouse.y - DrawF.y) * DrawF.HSc) = False Then CheckMouse2 = mMouseOut: Exit Function
If ColorLists(DrawF.CrashIndex).IsAlpha((Mouse.X - DrawF.X) * DrawF.WSc, (Mouse.Y - DrawF.Y) * DrawF.HSc) = False Then CheckMouse2 = mMouseOut: Exit Function
End If
If Mouse.State = 2 Then Mouse.State = 0
End If
Expand Down
Loading

0 comments on commit 26722d5

Please sign in to comment.