PC World Komputer 1997 February/PCWK0297.iso/envelop/envelop.5/Tools/Arsenal/parts/sash/SASH.ETO

Text File | 1996-07-08 | 5KB | 216 lines

Type Sash From Label
  Dim p_FullDrag As Boolean
  Dim A As Window
  Dim B As Window
  Property FullDrag Get getFullDrag Set setFullDrag As Long
  Dim Markup As SashMarkup
  Dim rx As Single

  ' METHODS for object: Sash
  Function getFullDrag as Long
    getFullDrag = p_FullDrag
  End Function

  Sub setFullDrag(value as Long)
    p_FullDrag = value
    If value == False Then Setup
  End Sub

  Sub Setup()
    If p_FullDrag Then
    Else
      If Parent <> Nothing Then
        dim cache as long
        cache = Parent.Controls.EvalRequires
        Parent.Controls.EvalRequires = "MatchNone"
        Parent.Controls.FindSashMarkup(Me)
        Parent.Controls.EvalRequires = cache
        If Markup == Nothing Then
          Markup = EmbedObject(Parent, SashMarkup, UniqueEmbedName(Parent, "SashMarkup"))
        End If
      End If
    End If
  End Sub

End Type

Type VSash From Sash

  ' METHODS for object: VSash
  Sub MouseDown(button As Integer, shift As Integer, x As Single, y As Single)
    If button == 1 Then
      App.AutoBusySignal = False
      If p_FullDrag Then
        rx = x
      Else
        Markup.Start(Me, x)
      End If
    End If
  End Sub

  Sub MouseMove(button As Integer, shift As Integer, x As Single, y As Single)
    If button == 1 Then
      If p_FullDrag Then
        Left = Left - rx + x
        A.Width = Left - A.Left
        B.Move(Left + Width, B.Top, (B.Left + B.Width) - (Left + Width), B.Height)

      Else
        Markup.MoveRect(x)
      End If
    End If
  End Sub

  Sub MouseUp(button As Integer, shift As Integer, x As Single, y As Single)
    If button == 1 Then
      If p_FullDrag Then
      Else
        Markup.Finish
        Left = Markup.SashL
        A.Width = Left - A.Left
        B.Move(Left + Width, B.Top, (B.Left + B.Width) - (Left + Width), B.Height)

      End If
      App.AutoBusySignal = True
    End If
  End Sub

End Type

Type HSash From Sash

  ' METHODS for object: HSash
  Sub MouseDown(button As Integer, shift As Integer, x As Single, y As Single)
    If button == 1 Then
      App.AutoBusySignal = False
      If p_FullDrag Then
        rx = y
      Else
        Markup.Start(Me, y)
      End If
    End If
  End Sub

  Sub MouseMove(button As Integer, shift As Integer, x As Single, y As Single)
    If button == 1 Then
      If p_FullDrag Then
        Top = Top - rx + y
        A.Height = Top - A.Top
        B.Move(B.Left, Top + Height, B.Width, (B.Top + B.Height) - (Top + Height))
      Else
        Markup.MoveRect(y)
      End If
    End If
  End Sub

  Sub MouseUp(button As Integer, shift As Integer, x As Single, y As Single)
    If button == 1 Then
      If p_FullDrag Then
      Else
        Markup.Finish
        Top = Markup.SashT

        A.Height = Top - A.Top
        B.Move(B.Left, Top + Height, B.Width, (B.Top + B.Height) - (Top + Height))
      End If
      App.AutoBusySignal = True
    End If
  End Sub

End Type

Type SashMarkup From MarkupLayer
  Dim SashR As Single
  Dim SashT As Single
  Dim SashB As Single
  Dim SashL As Single
  Dim rx As Single
  Dim Hsash As Long

  ' METHODS for object: SashMarkup
  Sub FindSashMarkup(sash as Sash)
    sash.Markup = Me
  End Sub

  Sub Finish
    Rectangle(SashL, SashT, SashR, SashB)
    Enabled = False
  End Sub

  Sub MoveRect(x as single)
    If Hsash Then
      Dim dx, Sashheight as single
      dx = rx - x
      Rectangle(SashL, SashT, SashR, SashB)
      Sashheight = SashB - SashT
      SashT = SashT - dx
      SashB = SashT + Sashheight
      Rectangle(SashL, SashT, SashR, SashB)
      rx = x

    Else
      Dim dx, Sashwidth as single
      dx = x - rx
      Rectangle(SashL, SashT, SashR, SashB)
      Sashwidth = SashR - SashL
      SashL = SashL + dx
      SashR = SashL + Sashwidth
      Rectangle(SashL, SashT, SashR, SashB)
      rx = x
    End If
  End Sub

  Sub Start(sash as Sash, relx as single)
    Enabled = True
    Move(0, 0, Parent.ScaleWidth, Parent.ScaleHeight)
    If TypeOf sash Is HSash Then Hsash = True Else Hsash = False
    SashL = sash.Left
    SashT = sash.Top
    SashR = SashL + sash.Width
    SashB = SashT + sash.Height
    rx = relx
    Rectangle(SashL, SashT, SashR, SashB)
  End Sub

End Type

Begin Code
' Reconstruction commands for object: Sash
'
  With Sash
    .Move(0, 0, 0, 0)
    .BorderStyle := "Fixed Single"
    .p_FullDrag := False
    .A := Nothing
    .B := Nothing
    .FullDrag := 0
    .Markup := Nothing
    .rx := 0
  End With  'Sash
' Reconstruction commands for object: VSash
'
  With VSash
    .MousePointer := "Size W E"
    .Move(0, 0, 0, 0)
  End With  'VSash
' Reconstruction commands for object: HSash
'
  With HSash
    .MousePointer := "Size N S"
    .Move(0, 0, 0, 0)
  End With  'HSash
' Reconstruction commands for object: SashMarkup
'
  With SashMarkup
    .Move(0, 0, 0, 0)
    .SashR := 0
    .SashT := 0
    .SashB := 0
    .SashL := 0
    .rx := 1
    .Hsash := -1
    .DrawMode := "Xor Pen"
    .DrawColor := 0
  End With  'SashMarkup
End Code