Programming Tool Box/SIMS_2.iso/tool/various/kalend/test3.frm

Text File | 1995-02-27 | 8KB | 274 lines

VERSION 2.00
Begin Form Form3
   BackColor       =   &H00C0C0C0&
   Caption         =   "Drag 'N Drop (and DrawOnDay event)"
   ClientHeight    =   3780
   ClientLeft      =   3210
   ClientTop       =   645
   ClientWidth     =   6450
   Height          =   4710
   Left            =   3150
   LinkTopic       =   "Form3"
   ScaleHeight     =   3780
   ScaleWidth      =   6450
   Top             =   -225
   Width           =   6570
   Begin PictureBox pctTop
      Align           =   1  'Align Top
      BackColor       =   &H00C0C0C0&
      Height          =   600
      Left            =   0
      ScaleHeight     =   570
      ScaleWidth      =   6420
      TabIndex        =   1
      Top             =   0
      Width           =   6450
      Begin TextBox Text1
         DragIcon        =   TEST3.FRX:0000
         Height          =   300
         Left            =   4290
         TabIndex        =   2
         Text            =   "Text1"
         Top             =   0
         Width           =   2010
      End
      Begin Label Label2
         BackColor       =   &H00C0C0C0&
         Caption         =   "Or, drag a date from the Kalendar to the Text Box or another date."
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   210
         Left            =   60
         TabIndex        =   4
         Top             =   300
         Width           =   5775
      End
      Begin Label Label1
         BackColor       =   &H00C0C0C0&
         Caption         =   "Type something here and drag it to the Kalendar."
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   210
         Left            =   75
         TabIndex        =   3
         Top             =   60
         Width           =   4230
      End
   End
   Begin Kalendar Kalendar1
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      DateDispStyle   =   2  'User
      DayAlignment    =   0  'Upper Left
      DOWAlign        =   2  'Center
      DOWBackColor    =   &H00808080&
      DOWBorder       =   -1  'True
      DOWDispStyle    =   2  'Medium
      DOWFontBold     =   0   'False
      DOWFontItalic   =   0   'False
      DOWFontName     =   "Arial"
      DOWFontSize     =   10
      DOWFontStrikeThru=   0   'False
      DOWFontUnderline=   0   'False
      DOWForeColor    =   &H00FFFFFF&
      DragIcon        =   TEST3.FRX:0302
      EnableKeys      =   0   'False
      FirstDOW        =   0  'Sunday
      FixedDayHeight  =   0   'False
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Arial"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   3255
      Left            =   0
      LineColor       =   &H00000000&
      MonAlign        =   2  'Center
      MonBackColor    =   &H00C0C0C0&
      MonDispStyle    =   2  'Month/Year
      MonFontBold     =   0   'False
      MonFontItalic   =   0   'False
      MonFontName     =   "Times New Roman"
      MonFontSize     =   14
      MonFontStrikeThru=   0   'False
      MonFontUnderline=   0   'False
      MonForeColor    =   &H00000000&
      OtherMonBackColor=   &H00C0C0C0&
      OtherMonForeColor=   &H00FFFFFF&
      SelDayBackColor =   &H00C0C0C0&
      SelDayForeColor =   &H00000000&
      ShowAllDays     =   0   'False
      ShowArrows      =   -1  'True
      ShowLines       =   -1  'True
      ShowSelection   =   0   'False
      TabIndex        =   0
      Text            =   "06/16/94"
      Top             =   585
      Width           =   6435
   End
   Begin Menu mnuFile
      Caption         =   "&File"
      Begin Menu mnuFPrint
         Caption         =   "&Print"
      End
   End
End
Option Explicit

Dim draggingDay As Variant

Dim couldDrag As Integer
Dim downAtX As Single, downAtY As Single

Dim txtHeight As Long       ' Used to determine how much space is required to show the day numbers.
                ' It is set differently for the printer and the screen.

Sub Form_Activate ()
    SetDescription Sample3Description()
End Sub

Sub Form_Load ()
    Kalendar1.Text = Date

    txtHeight = TextHeight("I") / Screen.TwipsPerPixelY
End Sub

Sub Form_Resize ()
    If Form3.ScaleWidth > 0 And Form3.ScaleHeight - pctTop.Height > 0 Then
    Kalendar1.Move 0, pctTop.Height, Form3.ScaleWidth, Form3.ScaleHeight - pctTop.Height
    End If
End Sub

Sub Kalendar1_DragDrop (Source As Control, x As Single, y As Single)
    Kalendar1.PointX = x
    Kalendar1.PointY = y

    If Kalendar1.DateAtPoint <> "" Then

    If TypeOf Source Is TextBox Then
        DateInfoAdd (Kalendar1.DateAtPointJul), (Text1.Text)
        Text1.Text = ""
    Else
        DateInfoMove (draggingDay), (Kalendar1.DateAtPointJul)
    End If
    Kalendar1.Refresh
    End If
End Sub

Sub Kalendar1_DrawOnDay (hDC As Integer, STATE As Integer, theDay As Long, x As Single, y As Single, x2 As Single, y2 As Single)
Dim retval As Integer
Dim r As Rect
Dim StrTmp As String
Dim oldColor As Long, oldTextColor As Long
Dim lx As Long
Dim oldBkMode As Integer
Dim OldFont As Integer
Dim HFont As Integer
Dim th As Long

    '--- Draw out some text
    StrTmp = GetDateInfo(theDay)

    If Len(StrTmp) > 0 Then
    '--- Make a Windows API rectangle to draw in.
    KalWindowAPIRect x, y, x2, y2, r
    InflateRect r, -1, -1

    r.top = r.top + txtHeight

    '--- Set up the drawing information
    oldBkMode = setBkMode(hDC, TRANSPARENT)
    oldTextColor = SetTextColor(hDC, RGB(0, 128, 0))

    ' Create an 8 point Arial font, and select into device context.
    HFont = CreateFont(-(8 * GetDeviceCaps(hDC, LOGPIXELSY) / 72), 0, 0, 0, FW_NORMAL, False, False, False, 0, 0, 0, 0, DEFAULT_PITCH Or FF_DONTCARE, "Arial")
    OldFont = SelectObject(hDC, HFont)

    retval = DrawText(hDC, StrTmp, Len(StrTmp), r, DT_LEFT Or DT_WORDBREAK)

    ' Clean up after myself.
    retval = SelectObject(hDC, OldFont)
    retval = DeleteObject(HFont)

    '--- Restore the old drawing information
    oldBkMode = setBkMode(hDC, oldBkMode)
    lx = SetTextColor(hDC, oldTextColor)
    End If
End Sub

Sub Kalendar1_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)

    Kalendar1.PointX = x
    Kalendar1.PointY = y

    If Kalendar1.DateAtPoint <> "" Then
    downAtX = x
    downAtY = y
    couldDrag = True
    End If
End Sub

Sub Kalendar1_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)

    If couldDrag And (Abs(downAtX - x) > 75 Or Abs(downAtY - y) > 75) Then
    couldDrag = False
    Kalendar1.Drag 1
    draggingDay = Kalendar1.DateAtPointJul
    End If
End Sub

Sub Kalendar1_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)

    couldDrag = False
    Kalendar1.Drag 2
End Sub

Sub mnuFPrint_Click ()
Dim saveBackColor As Long

    saveBackColor = Kalendar1.MonBackColor
    txtHeight = TextHeight("I") / Printer.TwipsPerPixelY

    Kalendar1.MonBackColor = RGB(255, 255, 255)
    Kalendar1.PrintHDC = Printer.hDC
    Kalendar1.PrintAction = KAL_PRINT_PORTRAIT

    Kalendar1.MonBackColor = saveBackColor
    txtHeight = TextHeight("I") / Screen.TwipsPerPixelY

    Printer.EndDoc
End Sub

Function Sample3Description () As String
Dim s As String

    s = "This sample shows drag and drop implemented in a Kalendar. The "
    s = s & "DrawOnDay event is used to display the text. " & CR
    s = s & "NOTE: Maximize the window to see more of the text."

    Sample3Description = s
End Function

Sub Text1_DragDrop (Source As Control, x As Single, y As Single)
    Text1.Text = GetDateInfo((draggingDay))
End Sub

Sub Text1_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
    Text1.Drag 1
End Sub

Sub Text1_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
    Text1.Drag 2
End Sub