四方图.frm

四方图 用于股市走势分析

        LX = LX + i行宽
    Next
End Sub

Private Sub FindinBuff()
    Dim mini As Single '内圈最大数
    Dim X As Long, Y As Long, L As Long, K As Long
    
    Dim x步进 As Single
    Dim x目标 As Long
    Dim y目标 As Long
    Dim z目标 As Long
    Dim x起点 As Long
    Dim x100 As Boolean
    Dim y100 As Boolean
    
    Dim iABuff(80) As Single
    Dim iBBuff(80) As Single
    Dim iCBuff(80) As Single
    
    x目标 = Val(Text4.Text)
    y目标 = Val(Text5.Text)
    z目标 = 994
    
    x起点 = Val(Text1.Text)
    
    Combo1.Clear
    
    For I = 1 To 10
        mini = I * 4 * (I - 1) + 1
        For L = 1 To 8
        X = (I - 1) * 8 + L: Y = (mini + I * L) - 1
        iABuff(X) = (x目标 - x起点) / Y
        iBBuff(X) = (y目标 - x起点) / Y
        iCBuff(X) = (z目标 - x起点) / Y
        'Debug.Print iBBuff(X) & " " & CStr(X)
        Next
    Next
    
    For I = 1 To 80
        For L = 1 To 80
            If iABuff(I) > 0 And iBBuff(L) > 0 Then
            x100 = Abs(iABuff(I) - iBBuff(L)) / iABuff(I) < 0.005
            If x100 Then
                Combo1.AddItem iABuff(I)
            End If
            End If
        Next
    Next
End Sub

Private Sub inDrawBuff()
    Dim mini As Single '内圈最大数
    Dim X As Long, Y As Long, L As Long
    Dim LX As Long, LY As Long
    Dim LpStr As String
    Dim lngReturn As Long
    
    CreateDrawFont Picture1.hDC
    
    lngReturn = GetTextExtentPoint32(Picture1.hDC, "5", 1, typSize)
    
    i总数 = (i圈数 + 1) * 4 * i圈数 + 1
    
    ReDim Preserve inBuff(i总数) As SF
    
    inBuff(1).X = FX
    inBuff(1).Y = FY + i行高
    inBuff(1).i角度 = 9
    
    For I = 1 To i圈数
        mini = I * 4 * (I - 1) + 1
        '求2象限数值
        '4 3 2
        '5 0 1
        '6 7 8
        i0 = mini + I * 0
        i1 = mini + I * 1
        i2 = mini + I * 2
        i3 = mini + I * 3
        i4 = mini + I * 4
        i5 = mini + I * 5
        i6 = mini + I * 6
        i7 = mini + I * 7
        i8 = mini + I * 8
        
        i边长 = (I + I + 1)
        
        Y = FY + I * i行高: X = FX + I * i行宽
        
        '右边
        For L = i0 + 1 To i2
            inBuff(L).X = X: inBuff(L).Y = Y
            Y = Y - i行高
        Next
        
        inBuff(i1).i角度 = 1: inBuff(i2).i角度 = 2
        If (i1 + i2) Mod 2 <= 0 Then
            inBuff((i1 + i2) / 2).i角度 = 10
        End If
        If (i1 + mini) Mod 2 <= 0 Then
            inBuff((i1 + mini) / 2).i角度 = 10
        End If
        
        Y = Y + i行高
        
        '上边
        For L = i2 + 1 To i4
            X = X - i行宽
            inBuff(L).X = X: inBuff(L).Y = Y
        Next
        
        inBuff(i3).i角度 = 3: inBuff(i4).i角度 = 5
        If (i3 + i4) Mod 2 <= 0 Then
            inBuff((i3 + i4) / 2).i角度 = 10
        End If
        If (i2 + i3) Mod 2 <= 0 Then
            inBuff((i2 + i3) / 2).i角度 = 10
        End If
        
        '左边
        For L = i4 + 1 To i6
            Y = Y + i行高
            inBuff(L).X = X: inBuff(L).Y = Y
        Next
        
        inBuff(i5).i角度 = 5: inBuff(i6).i角度 = 7
        If (i5 + i6) Mod 2 <= 0 Then
            inBuff((i5 + i6) / 2).i角度 = 10
        End If
        If (i4 + i5) Mod 2 <= 0 Then
            inBuff((i4 + i5) / 2).i角度 = 10
        End If
        
        '下边
        For L = i6 + 1 To i8
            X = X + i行宽
            inBuff(L).X = X: inBuff(L).Y = Y
        Next
    
        inBuff(i7).i角度 = 7: inBuff(i8).i角度 = 8
        If (i7 + i8) Mod 2 <= 0 Then
            inBuff((i7 + i8) / 2).i角度 = 10
        End If
        If (i6 + i7) Mod 2 <= 0 Then
            inBuff((i6 + i7) / 2).i角度 = 10
        End If
    Next
End Sub

Private Sub Command1_Click()
    Dim I As Long
    For I = 1 To i总数
        inBuff(I).i选择 = False
        inBuff(I).Color = &HC0FFFF
    Next
    DrawTextStr Val(Text1.Text)
    DrawLineSub
End Sub

Private Sub Command2_Click()
FindinBuff
End Sub

Private Sub Form_Load()
    i字体 = 14
    i行高 = 16
    i行宽 = 27
    i圈数 = 7
    i反锯齿 = True

    Label2(0).BackColor = GetSetting("四方设置", "设置", "左键颜色", Label2(0).BackColor)
    Label2(1).BackColor = GetSetting("四方设置", "设置", "右键颜色", Label2(1).BackColor)
    Text1.Text = GetSetting("四方设置", "设置", "起点", Text1.Text)
    Text3.Text = GetSetting("四方设置", "设置", "步长", Text3.Text)
    Text2.Text = GetSetting("四方设置", "显示", "透明", 225)
    Me.Width = GetSetting("四方设置", "尺寸", "宽度", Me.Width)
    Me.Height = GetSetting("四方设置", "尺寸", "高度", Me.Height)
    Me.Left = GetSetting("四方设置", "尺寸", "Left", Me.Left)
    Me.Top = GetSetting("四方设置", "尺寸", "Top", Me.Top)
    
    CreateDrawFont Picture1.hDC
    SetTrayIcon Me.Icon, "四方图程序", "Add"
End Sub

Private Sub Form_Resize()
    Dim QW As Long, QH As Long
    Picture1.Move 0, 16, Me.ScaleWidth, Me.ScaleHeight - 16
    Check1.Left = Me.ScaleWidth - 70
    
    FX = Picture1.ScaleWidth / 2 - i行宽 / 2
    FY = Picture1.ScaleHeight / 2 - i行高 * 1.5
    QH = (Picture1.ScaleHeight) / i行高 / 2 - 1
    QW = Picture1.ScaleWidth / i行宽 / 2 - 1
    
    i圈数 = IIf(QH > QW, QW, QH)
    '初始化数组
    inDrawBuff
    DrawTextStr Val(Text1.Text)
    DrawLineSub
    Picture1.Refresh
End Sub

Private Sub CreateDrawFont(iHDC As Long)
    Dim I As Long
    
    SetBkMode iHDC, TRANSPARENT
    
    If hfntprev And hMasterFont Then
        '选择此字体
        hfntprev = SelectObject(iHDC, hMasterFont)
        '删除字体
        DeleteObject hMasterFont
    End If
    
    '创建一个字体
    If i反锯齿 Then
        hMasterFont = CreateFont_("", 0, 0, 0, 0, 14, ANTIALIASED_QUALITY, 0, 0)
    Else
        hMasterFont = CreateFont_("", 0, 0, 0, 0, 14, NONANTIALIASED_QUALITY, 0, 0)
    End If
    
    '选择此字体
    hfntprev = SelectObject(iHDC, hMasterFont)
End Sub

Private Sub DelDrawFont(iHDC As Long)
    If hfntprev And hMasterFont Then
        '选择此字体
        hfntprev = SelectObject(iHDC, hMasterFont)
        '删除字体
        DeleteObject hMasterFont
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SaveSetting "四方设置", "设置", "左键颜色", Label2(0).BackColor
    SaveSetting "四方设置", "设置", "右键颜色", Label2(1).BackColor
    SaveSetting "四方设置", "显示", "透明", Val(Text2.Text)
    SaveSetting "四方设置", "设置", "起点", Val(Text1.Text)
    SaveSetting "四方设置", "设置", "步长", Val(Text3.Text)
    SaveSetting "四方设置", "尺寸", "宽度", Me.Width
    SaveSetting "四方设置", "尺寸", "高度", Me.Height
    SaveSetting "四方设置", "尺寸", "Left", Me.Left
    SaveSetting "四方设置", "尺寸", "Top", Me.Top
    SetTrayIcon Me.Icon, "", "Exit"
    DelDrawFont Picture1.hDC
End Sub

Private Sub Label3_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
    Label2(0).BackColor = Label3(Index).BackColor
    Else
    Label2(1).BackColor = Label3(Index).BackColor
    End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim I As Long, iB As Boolean
    For I = 1 To i总数
        If X > inBuff(I).X And X < inBuff(I).X + i行宽 And Y > inBuff(I).Y And Y < inBuff(I).Y + i行高 And i索引 <> I Then
            i索引 = I
        End If
    Next
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If i索引 Then
        inBuff(i索引).i选择 = Not inBuff(i索引).i选择
        If Button = 1 Then
        inBuff(i索引).Color = Label2(0).BackColor
        Else
        inBuff(i索引).Color = Label2(1).BackColor
        End If
        DrawTextStr Val(Text1.Text)
        DrawLineSub
    End If
End Sub

Private Sub Text1_Change()
    DrawTextStr Val(Text1.Text)
    DrawLineSub
End Sub

Private Sub Text2_Change()
    Dim Color As Long, Index As Byte
    If Val(Text2.Text) > 255 Then Text2.Text = 255
    If Val(Text2.Text) < 15 Then Text2.Text = 15
    Index = Val(Text2.Text)
    Color = RGB(255, 255, 255)
    SetTranslucent frmMain.hWnd, Color, Index, LWA_ALPHA
End Sub

Private Sub Text3_Change()
    DrawTextStr Val(Text1.Text)
    DrawLineSub
End Sub

Private Sub Timer1_Timer()
    If Check1.Value = 1 Then
    Call SetWindowPos(Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE)
    End If
End Sub