Option Compare Database
Option Explicit

'項目の表示サイズを調整できるリストボックスです。
'項目名クリックでソートするため、スライダー用ラベルを作っています。
'Copyright(C) Loadsystem Inc. 2001

Const cSpan = 32

Private Sub Form_Open(Cancel As Integer)
    LabelSize
    ListSize
End Sub

Private Sub lblDate_Click()
    Static SortDesc As Boolean
    LsListBoxSort Me!lstHead, "受信日時", "qMail", SortDesc
End Sub

Private Sub lblDate_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Screen.MousePointer = 0
End Sub

Private Sub lblDateX_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Static preX As Single
    lblMouseMove Button, Shift, X, Y, Me!lblDate, preX
End Sub

Private Sub lblDateX_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ListSize
End Sub

Private Sub lblDummy_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Screen.MousePointer = 0
End Sub

Private Sub lblFrom_Click()
    Static SortDesc As Boolean
    LsListBoxSort Me!lstHead, "送信者", "qMail", SortDesc
End Sub

Private Sub lblFrom_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Screen.MousePointer = 0
End Sub

Private Sub lblFromX_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Static preX As Single
    lblMouseMove Button, Shift, X, Y, Me!lblFrom, preX
End Sub

Private Sub lblFromX_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ListSize
End Sub

Private Sub lblSubject_Click()
    Static SortDesc As Boolean
    LsListBoxSort Me!lstHead, "件名", "qMail", SortDesc
End Sub

Private Sub lblSubject_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Screen.MousePointer = 0
End Sub

Private Sub lblSubjectX_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Static preX As Single
    lblMouseMove Button, Shift, X, Y, Me!lblSubject, preX
End Sub

Private Sub lblSubjectX_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ListSize
End Sub

Private Sub lblTenp_Click()
    Static SortDesc As Boolean
    LsListBoxSort Me!lstHead, "添付", "qMail", SortDesc
End Sub

Private Sub lblTenpX_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Static preX As Single
    lblMouseMove Button, Shift, X, Y, Me!lblTenp, preX
End Sub

Private Sub lblTenpX_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ListSize
End Sub

Private Sub lblTo_Click()
    Static SortDesc As Boolean
    LsListBoxSort Me!lstHead, "受信者", "qMail", SortDesc
End Sub

Private Sub lblTo_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Screen.MousePointer = 0
End Sub

Private Sub lblToX_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Static preX As Single
    lblMouseMove Button, Shift, X, Y, Me!lblTo, preX
End Sub

Private Sub lblToX_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ListSize
End Sub

Private Sub lstHead_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Static preY As Single, j As Single
    
    With Me!lstHead
        If (Button And acLeftButton) > 0 Then
            If preY <> Y Then
                j = Y - preY
                If (.Height + j) >= cSpan Then
                    Application.Echo False
                    .Height = .Height + j
                    With Me!lblBody1
                        .Height = .Height - j
                        .Top = .Top + j
                    End With
                    With Me!lblBodyHead
                        .Top = .Top + j
                    End With
                    With Me!txtBody
                        .Height = .Height - j
                        .Top = .Top + j
                    End With
                    With Me!cmdTenpu
                        .Top = .Top + j
                    End With
                    Application.Echo True
                End If
            End If
        End If
        Screen.MousePointer = 0
    End With
    preY = Y
End Sub

Private Sub LsListBoxSort(ByVal LstB As ListBox, ByVal SortStr As String, QueryName As String, SortDesc As Boolean)
    'LstB       リストボックス
    'SortStr    ソートする項目名(ソートする項目名は値集合ソース内に存在すること)
    'QueryName  値集合ソース名
    'SortDesc   昇順(False)降順(True)のフラグ
    '例
    '   Private Sub lblSubject_Click()
    '       Static SortDesc As Boolean
    '       LsListBoxSort Me!lstHead, "件名", "qMail", SortDesc
    '   End Sub
    Dim strDESC As String
    
    If SortStr = "" Then Exit Sub
    DoCmd.Hourglass True
    LstB.RowSource = "select * from " & QueryName & " order by [" & SortStr & "]" & IIf(SortDesc, " DESC", "")
    LstB.Requery
    SortDesc = Not SortDesc
    DoCmd.Hourglass False
End Sub

Private Sub LabelSize()
    Dim s As Single
    
    Me!lblTo.Left = Me!lblSubject.Left + Me!lblSubject.Width + cSpan
    Me!lblFrom.Left = Me!lblTo.Left + Me!lblTo.Width + cSpan
    Me!lblDate.Left = Me!lblFrom.Left + Me!lblFrom.Width + cSpan
    Me!lblTenp.Left = Me!lblDate.Left + Me!lblDate.Width + cSpan
    Me!lblDummy.Left = Me!lblTenp.Left + Me!lblTenp.Width + cSpan
    s = Me!lblTenp.Left + Me!lblTenp.Width - cSpan * 3
    If s < Me!lstHead.Width Then
        s = Me!lstHead.Width - s + cSpan * 3 '2
    Else
        s = 0
    End If
    Me!lblDummy.Width = s
End Sub

Private Sub ListSize()
    '分母の数字は見た目だけで、何ら論理性はありません　^_^;
    Me!lstHead.ColumnWidths = "0;" & Me!lblSubject.Width + cSpan / 2 & ";" & Me!lblTo.Width + cSpan / 1.3 & ";" & Me!lblFrom.Width + cSpan / 1.2 & ";" & Me!lblDate.Width + cSpan & ";" & Me!lblTenp.Width & ";0"
    Me!lblSubjectX.Left = Me!lblSubject.Left + Me!lblSubject.Width - 56
    Me!lblToX.Left = Me!lblTo.Left + Me!lblTo.Width - 56
    Me!lblFromX.Left = Me!lblFrom.Left + Me!lblFrom.Width - 56
    Me!lblDateX.Left = Me!lblDate.Left + Me!lblDate.Width - 56
    Me!lblTenpX.Left = Me!lblTenp.Left + Me!lblTenp.Width - 56
End Sub

Private Sub lblMouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single, lbl As Label, preX As Single)
    If (Button And acLeftButton) > 0 Then
        If preX <> X Then
            With lbl
                If (.Width + X - preX) >= cSpan Then .Width = .Width + X - preX
            End With
            LabelSize
        End If
    End If
    Screen.MousePointer = 9 * Abs(0 < X And X < 102)
    preX = X
End Sub

Private Sub 詳細_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Screen.MousePointer = 0
End Sub