三项更新

Builder/WelcomePage.cls

@@ -114,7 +114,12 @@ Public Sub Update()
                 'Page.DrawAnimation "test", 400, 250
                 'Page.DrawAnimation "test", 100, 0
 
-                'Page.ShowEdit test, 2, 100, 100, 300, 40, argb(255, 255, 255, 255), argb(180, 32, 32, 32), argb(255, 32, 32, 32), argb(255, 64, 64, 64), 64, 0, 28
+                'If Page.ShowEdit(test, 2, 100, 100, 300, 40, argb(255, 0, 0, 0), argb(180, 255, 255, 255), argb(255, 255, 255, 255), argb(255, 210, 210, 210), 64, 0, 28) = 4 Then
+                '    MsgBox "文本框内容：" & test
+                'End If
+                'If Page.ShowEdit(test, 0, 100, 160, 300, 40, argb(255, 0, 0, 0), argb(180, 255, 255, 255), argb(255, 255, 255, 255), argb(255, 210, 210, 210), 0, 0, 28) = 4 Then
+                '    MsgBox "文本框内容：" & test
+                'End If
 
                 Page.DrawImage "404.png", 165, GH / 2, alpha:=1 - pro, pos:=posOnCenter, animation:=1
 
@@ -210,12 +215,30 @@ Private Sub Class_Initialize()
     Page.Create Me
     '导入游戏资源
     If PackPos = -1 Then
-        Page.Res.NewImages App.path & "\assets"
-        Page.Res.NewImages App.path & "\assets\debug"
+        Page.Res.NewImages App.Path & "\assets"
+        Page.Res.NewImages App.Path & "\assets\debug"
         '导入动画
         'Page.LoadAnimationsFromDir App.path & "\animation"
         'Page.CreatePlayAnimation   "test", "test", "Default"
     End If
+    Dim m(4, 4) As Single
+    m(0, 0) = 1: m(0, 1) = 0: m(0, 2) = 0: m(0, 3) = 0
+    m(1, 0) = 0: m(1, 1) = 0: m(1, 2) = 0: m(1, 3) = 0
+    m(2, 0) = 0: m(2, 1) = 0: m(2, 2) = 0: m(2, 3) = 0
+    m(3, 0) = 1: m(3, 1) = 0: m(3, 2) = 0: m(3, 3) = 1
+
+    'Page.Res.ClipCircle "404.png"
+    '笔记
+    'Page.Res.ApplyBlurEffect 模糊半径，四周阴影
+    'ApplyBrightnessContrastEffect 亮度，对比度
+    'ApplyColorBalanceEffect 红色调，绿色调，蓝色调
+    'ApplyColorCurveEffect 对指定颜色通道应用某个特殊效果
+    'ApplyColorMatrixEffect 反正颜色矩阵就对了
+    'ApplyHueSaturationLightnessEffect 色相，亮度，饱和度
+    'ApplyLevelsEffect 高光，中间色，暗调
+    'ApplySharpenEffect 数量，锐化半径
+    'ApplyTintEffect 程度，色调
+
     '创建页面
     ECore.Add Page, "WelcomePage"
 

Core/AboutMe.bas

@@ -40,6 +40,10 @@ Attribute VB_Name = "AboutMe"
 '========================================================
 '   更新日志
 '========================================================
+'   更新内容(ver.625)
+'   -完善文本框
+'   -添加图片特效
+'   -添加图片圆形裁剪
 '   更新内容(ver.624)
 '   -添加滑条
 '   -修复文本框越界问题

Core/GCore.bas

@@ -63,7 +63,7 @@ Attribute VB_Name = "GCore"
     End Type
     Public Type AssetsTree
         files() As GMem
-        path As String
+        Path As String
         arg1 As Variant
         arg2 As Variant
     End Type
@@ -82,7 +82,7 @@ Attribute VB_Name = "GCore"
     Public FPSWarn As Long
     Public EmeraldInstalled As Boolean
     Public BassInstalled As Boolean
-    Public Const Version As Long = 19062403
+    Public Const Version As Long = 19062503
     Public TextHandle As Long, WaitChr As String
     Dim AssetsTrees() As AssetsTree
     Dim LastKeyUpRet As Boolean
@@ -236,7 +236,7 @@ sth:
 
         GetWinNTVersion = Left(strOSversion, 3)
     End Function
-    Public Sub BlurTo(DC As Long, srcDC As Long, buffWin As Form, Optional Radius As Long = 60)
+    Public Sub BlurTo(DC As Long, srcDC As Long, buffWin As Form, Optional radius As Long = 60)
         Dim i As Long, g As Long, e As Long, b As BlurParams, w As Long, h As Long
         '粘贴到缓冲窗口
         buffWin.AutoRedraw = True
@@ -246,7 +246,7 @@ sth:
         GdipCreateBitmapFromHBITMAP buffWin.Image.handle, buffWin.Image.hpal, i
 
         '模糊操作
-        GdipCreateEffect2 GdipEffectType.Blur, e: b.Radius = Radius: GdipSetEffectParameters e, b, LenB(b)
+        GdipCreateEffect2 GdipEffectType.Blur, e: b.radius = radius: GdipSetEffectParameters e, b, LenB(b)
         GdipGetImageWidth i, w: GdipGetImageHeight i, h
         GdipBitmapApplyEffect i, e, NewRectL(0, 0, w, h), 0, 0, 0
 
@@ -256,12 +256,12 @@ sth:
         GdipDisposeImage i: GdipDeleteGraphics g: GdipDeleteEffect e '垃圾处理
         buffWin.AutoRedraw = False
     End Sub
-    Public Sub BlurImg(img As Long, Radius As Long)
+    Public Sub BlurImg(img As Long, radius As Long)
         Dim b As BlurParams, e As Long, w As Long, h As Long
 
         '模糊操作
 
-        GdipCreateEffect2 GdipEffectType.Blur, e: b.Radius = Radius: GdipSetEffectParameters e, b, LenB(b)
+        GdipCreateEffect2 GdipEffectType.Blur, e: b.radius = radius: GdipSetEffectParameters e, b, LenB(b)
         GdipGetImageWidth img, w: GdipGetImageHeight img, h
         GdipBitmapApplyEffect img, e, NewRectL(0, 0, w, h), 0, 0, 0
 
@@ -411,10 +411,10 @@ sth:
         ReDim Preserve AssetsTrees(UBound(AssetsTrees) + 1)
         AssetsTrees(UBound(AssetsTrees)) = Tree
     End Function
-    Public Function FindAssetsTree(path As String, arg1 As Variant, arg2 As Variant) As Integer
+    Public Function FindAssetsTree(Path As String, arg1 As Variant, arg2 As Variant) As Integer
         On Error Resume Next
         For i = 1 To UBound(AssetsTrees)
-            If AssetsTrees(i).path = path And AssetsTrees(i).arg1 = arg1 And AssetsTrees(i).arg2 = arg2 Then
+            If AssetsTrees(i).Path = Path And AssetsTrees(i).arg1 = arg1 And AssetsTrees(i).arg2 = arg2 Then
                 If Err.Number <> 0 Then
                     Err.Clear
                 Else
@@ -423,9 +423,9 @@ sth:
             End If
         Next
     End Function
-    Public Function GetAssetsTree(path As String) As AssetsTree
+    Public Function GetAssetsTree(Path As String) As AssetsTree
         For i = 1 To UBound(AssetsTrees)
-            If AssetsTrees(i).path = path Then GetAssetsTree = AssetsTrees(i): Exit For
+            If AssetsTrees(i).Path = Path Then GetAssetsTree = AssetsTrees(i): Exit For
         Next
     End Function
 '========================================================

Core/GFont.cls

@@ -24,9 +24,13 @@ Dim brush As Long, fFile As String, fFam As Long, strF(2) As Long, Font(8, 1 To
         If fFam = 0 Then GdipCreateFontFamilyFromName StrPtr("ËÎÌå"), 0, fFam
         If fFam = 0 Then GdipCreateFontFamilyFromName StrPtr("System"), 0, fFam
 
+        Dim Flag As Long
         For i = 0 To 2
             GdipCreateStringFormat 0, 0, strF(i)
             GdipSetStringFormatAlign strF(i), i
+            'GdipStringFormatGetGenericTypographic strF(i)
+            GdipGetStringFormatFlags strF(i), Flag
+            GdipSetStringFormatFlags strF(i), (Flag Or StringFormatFlagsMeasureTrailingSpaces)
         Next
         GdipCreateSolidFill argb(255, 64, 64, 64), brush
 

Core/GPage.cls

@@ -445,7 +445,7 @@ Public TopPage As Boolean
             GdipDrawRectangle GG, Pen, DrawF.Left, DrawF.top, DrawF.Right + 1, DrawF.Bottom + 1
         End If
     End Sub
-    Public Sub Paint(ByVal shape As Integer, x As Long, y As Long, w As Long, h As Long, Optional Color As Long, Optional Radius As Long, Optional size As Long = 1, Optional style As Integer = 0, Optional pos As PosAlign = posNormal, Optional animation As Integer = 0)
+    Public Sub Paint(ByVal shape As Integer, x As Long, y As Long, w As Long, h As Long, Optional Color As Long, Optional radius As Long, Optional size As Long = 1, Optional style As Integer = 0, Optional pos As PosAlign = posNormal, Optional animation As Integer = 0)
         'shape:0=rect,1=ellipse,2=rectr
         'style:0=fill,1=border
         'If OutOfScroll Then Exit Sub
@@ -489,17 +489,17 @@ ReShape:
         If shape = 1 Then GdipAddPathEllipse path, ox, oy, ow - 1, oh - 1
         If shape = 2 Then
 
-            If Radius = 0 Then
+            If radius = 0 Then
                 shape = 0: GoTo ReShape
             End If
 
-            If Radius > ow Then Radius = ow
-            If Radius > oh Then Radius = oh
+            If radius > ow Then radius = ow
+            If radius > oh Then radius = oh
 
-            GdipAddPathArc path, ox, oy, Radius, Radius, 180, 90
-            GdipAddPathArc path, ox + ow - Radius, oy, Radius, Radius, 270, 90
-            GdipAddPathArc path, ox + ow - Radius, oy + oh - Radius, Radius, Radius, 0, 90
-            GdipAddPathArc path, ox, oy + oh - Radius, Radius, Radius, 90, 90
+            GdipAddPathArc path, ox, oy, radius, radius, 180, 90
+            GdipAddPathArc path, ox + ow - radius, oy, radius, radius, 270, 90
+            GdipAddPathArc path, ox + ow - radius, oy + oh - radius, radius, radius, 0, 90
+            GdipAddPathArc path, ox, oy + oh - radius, radius, radius, 90, 90
             GdipClosePathFigure path
 
         End If
@@ -671,11 +671,11 @@ ReShape:
     End Function
 '========================================================
     'Control
-    Public Function ShowEdit(text As String, shape As Integer, x As Long, y As Long, w As Long, h As Long, TextColor As Long, Color As Long, HoverColor As Long, LineColor As Long, Optional Radius As Long = 0, Optional ShapeStyle As Integer = 0, Optional size As Long = 14, Optional style As FontStyle = FontStyleRegular) As Integer
+    Public Function ShowEdit(text As String, shape As Integer, x As Long, y As Long, w As Long, h As Long, TextColor As Long, Color As Long, HoverColor As Long, LineColor As Long, Optional radius As Long = 0, Optional ShapeStyle As Integer = 0, Optional size As Long = 14, Optional style As FontStyle = FontStyleRegular) As Integer
         Dim m As Integer, r As RECT
 
-        m = CheckMouse(x, y, w, h)
-        Paint shape, x, y, w, h, IIf(m <> 0 Or TextHandle = VarPtr(text), HoverColor, Color), Radius, style:=ShapeStyle
+        m = CheckMouse(x, y, w - IIf(TextHandle = VarPtr(text), h, 0), h)
+        Paint shape, x, y, w, h, IIf(m <> 0 Or TextHandle = VarPtr(text), HoverColor, Color), radius, style:=ShapeStyle
         If m = 3 Then TextHandle = VarPtr(text)
 
         Dim CtrlPressed As Boolean
@@ -684,6 +684,7 @@ ReShape:
         If VarPtr(text) = TextHandle And WaitChr <> "" Then
             If WaitChr = Chr(vbKeyReturn) Then
                 TextHandle = 0
+                m = 4
             ElseIf WaitChr = Chr(vbKeyBack) Then
                 If Len(text) > 0 Then text = Left(text, Len(text) - 1)
             ElseIf Asc(WaitChr) = 22 Then '粘贴
@@ -706,17 +707,15 @@ ReShape:
             WaitChr = ""
         End If
 
-        If Mouse.state = 2 And m = 0 Then TextHandle = 0
-
-        Writes text, x + Radius / 4, y + h / 2 - size / 0.75 / 2 - 1, size, TextColor, w - Radius / 2, size / 0.75, StringAlignmentNear, style
+        Writes text, x + radius / 4, y + h / 2 - size / 0.75 / 2 - 1, size, TextColor, w - radius / 2 - h, size / 0.75, StringAlignmentNear, style
 
         If TextHandle = VarPtr(text) Then
             Dim w2 As Long, pro As Long, alpha As Single
             w2 = EF.GetWidth(GG, text, size, StringAlignmentNear, style)
-            If w2 > w - Radius / 2 Then
+            If w2 > w - radius / 2 - h Then
                 If Len(text) > 0 Then text = Left(text, Len(text) - 1): VBA.Beep
             End If
-            Paint shape, x - 1, y - 1, w + 2, h + 2, LineColor, size:=2, Radius:=Radius, style:=1
+            Paint shape, x, y, w, h, LineColor, size:=2, radius:=radius, style:=1
             pro = GetTickCount Mod 1000
             If pro <= 700 Then
                 alpha = 1 - Cubic(pro / 700, 0, 1, 1, 1)
@@ -726,10 +725,26 @@ ReShape:
             Dim co(3) As Byte, co2 As Long
             co2 = IIf(m <> 0 Or TextHandle = VarPtr(text), HoverColor, Color)
             CopyMemory co(0), co2, 4
-            If alpha <> 0 Then Paint 0, x + w2 + Radius / 4, y + h / 2 - size / 2, 3, size, argb(Int(alpha * 255), 255 - co(2), 255 - co(1), 255 - co(0))
+            If w2 = 0 Then w2 = size / 4
+            If alpha <> 0 Then Paint 0, x + w2 + radius / 4 - size / 8, y + h / 2 - size / 2, 3, size, argb(Int(alpha * 255), 255 - co(2), 255 - co(1), 255 - co(0))
+
+            Paint shape, x + w - h, y, h, h, LineColor, radius:=radius
+            If CheckMouse2 = mMouseUp Then
+                TextHandle = 0
+                m = 4
+            End If
+
+            If shape = 2 Then
+                Writes ">", x + w - h, y + h / 2 - size / 0.75 / 2 - 1, size, TextColor, h + 6, size / 0.75, StringAlignmentCenter, FontStyleBold
+            Else
+                Writes ">", x + w - h, y + h / 2 - size / 0.75 / 2 - 2, size, TextColor, h + 3, size / 0.75, StringAlignmentCenter, FontStyleBold
+            End If
         End If
 
+        If Mouse.state = 2 And m = 0 Then TextHandle = 0: m = 4
+
         ShowEdit = m
+
     End Function
     Public Sub ShowLoading(x As Long, y As Long, w As Long, h As Long, size As Long, color1 As Long, color2 As Long, color3 As Long)
 
@@ -762,11 +777,11 @@ ReShape:
 
         ShowSimpleButton = m
     End Function
-    Public Function ShowColorButton(shape As Integer, x As Long, y As Long, w As Long, h As Long, text As String, TextColor As Long, Color As Long, HoverColor As Long, Optional Radius As Long = 0, Optional ShapeStyle As Integer = 0, Optional size As Long = 14, Optional style As FontStyle = FontStyleRegular) As Integer
+    Public Function ShowColorButton(shape As Integer, x As Long, y As Long, w As Long, h As Long, text As String, TextColor As Long, Color As Long, HoverColor As Long, Optional radius As Long = 0, Optional ShapeStyle As Integer = 0, Optional size As Long = 14, Optional style As FontStyle = FontStyleRegular) As Integer
         Dim m As Integer
 
         m = CheckMouse(x, y, w, h)
-        Paint shape, x, y, w, h, IIf(m, HoverColor, Color), Radius, style:=ShapeStyle
+        Paint shape, x, y, w, h, IIf(m, HoverColor, Color), radius, style:=ShapeStyle
 
         Writes text, x, y + h / 2 - size / 0.75 / 2, size, TextColor, w, size / 0.75, StringAlignmentCenter, style