PC World 1999 July/PCWorld_1999-07_cd.bin/602/WBPERSON/data1.cab/SDK_Files/Vbasic/PROG/MDIFORM1.FRM

Text File | 1999-06-09 | 10KB | 351 lines

VERSION 4.00
Begin VB.MDIForm MDIForm1
   BackColor       =   &H8000000C&
   Caption         =   "Vzorovß aplikace WinBase602 ve Visual Basicu"
   ClientHeight    =   5940
   ClientLeft      =   1470
   ClientTop       =   1815
   ClientWidth     =   6690
   Height          =   6630
   Left            =   1410
   LinkTopic       =   "MDIForm1"
   Top             =   1185
   Width           =   6810
   Begin VB.Menu Open
      Caption         =   "O&tev°φt"
      Begin VB.Menu Frm
         Caption         =   "&Okno VB"
      End
      Begin VB.Menu View
         Caption         =   "&Pohled WinBase"
      End
   End
   Begin VB.Menu Data
      Caption         =   "&Data"
      Begin VB.Menu ReadTable
         Caption         =   "╚t&enφ z tabulky"
      End
      Begin VB.Menu WriteTable
         Caption         =   "&Zßpis do tabulky"
      End
   End
   Begin VB.Menu Window
      Caption         =   "&Okna"
      WindowList      =   -1  'True
      Begin VB.Menu Kask
         Caption         =   "&Kaskßda"
      End
      Begin VB.Menu Moza
         Caption         =   "&Mozaika"
      End
   End
   Begin VB.Menu Help
      Caption         =   "&Nßpov∞da"
      Begin VB.Menu Nap
         Caption         =   "Napovφdat se nemß"
      End
   End
   Begin VB.Menu TheEnd
      Caption         =   "&Konec"
   End
End
Attribute VB_Name = "MDIForm1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False


'
' OÜet°enφ p°φkazu "Okno" z menu Otev°φt
' ======================================
'
Private Sub Frm_Click()
    Static i As Integer
    Dim NewForm As New Form1   ' Otev°i nov² MDI child
    i = i + 1
    NewForm.caption = "MDI " + Str$(i)
End Sub

'
' OÜet°enφ p°φkazu "Kaskßda" z menu Okna
' ======================================
'
Private Sub Kask_Click()
    MDIForm1.Arrange 0
End Sub


'
' Aktivace hlavnφho okna aplikace
' ===============================
'
Private Sub MDIForm_Activate()
    '
    ' PrihlßÜenφ u₧ivatele
    '
    sts = Alogin(MDIForm1.hWnd)
    If (sts = 0) Then
        Unload MDIForm1
        End
    End If
    '
    ' Nastavenφ aplikace
    '
    sts = Set_application("VBasic")
    If (sts <> 0) Then
        MsgBox "Zadanß aplikace v databßzi nenφ!" + Chr$(13) + Chr$(10) + Chr$(10) + "          Je naimportovanß?", 16, "VBasic"
        Unload MDIForm1
        End
    End If
End Sub

'
' Zavedenφ hlavnφho okna aplikace
' ===============================
'
Private Sub MDIForm_Load()
    '
    ' Napojenφ na WinBaseFrameProc
    '
    ConWinBaseFrameProc hWnd, 1
    '
    ' Inicializace vnit°nφch struktur
    '
    cdp = cdp_init_vb()
    '
    ' SpuÜt∞nφ serveru
    '
    If (Command = "") Then
        MsgBox "Na p°φkazovΘ °ßdce nenφ zadßn ₧ßdn² server", 16, "VBasic"
        Unload MDIForm1
        End
    End If

    sts = link_kernel(Command, SW_MINIMIZE)
    If (sts <> KSE_OK) Then
        Kernel_error_box (sts)
        Unload MDIForm1
        End
    End If
    '
    ' Inicializace spojenφ
    '
    sts = interf_init(cdp, 0)
    If (sts <> KSE_OK) Then
        MsgBox "Nejde inicializovat spojenφ s jßdrem databßze", 16, "VBasic"
        Unload MDIForm1
        End
    End If
End Sub

'
' Zavφrßnφ hlavnφho okna aplikace
' ===============================
'
Private Sub MDIForm_Unload(Cancel As Integer)
    sts = Logout
    If (sts <> KSE_OK) Then
        MsgBox "Chyba p°i odlogovßnφ", 16, "VBasic"
        End
    End If
    interf_close
    unlink_kernel
End Sub


'
' OÜet°enφ p°φkazu "Mozaika" z menu Okna
' ======================================
'
Private Sub Moza_Click()
    MDIForm1.Arrange 1
End Sub






'=========================================
'      ╚tenφ z tabulky VBASIC
'       v²stup do Debug okna
'=========================================
Private Sub ReadTable_Click()

Dim tabnum As Integer, curnum As Integer
Dim pomstr As String * 12
Dim poznstr As String * 2048
Dim pomc As Long
Dim pomr As Double
Dim pomd As Date
Dim pommd As Long
Dim pocet As Long
Dim vel As Long
Dim pocb As Long
Dim mm As Integer, dd As Integer, rr As Integer
Dim pomb As Byte
Dim pomznak As String * 1
Dim pommon As monstr
Dim pomcr As Double

Const atr_ret = 1
      atr_cislo = 2
      atr_rcislo = 3
      atr_dat = 4
      atr_pozn = 5
      atr_bool = 6
      atr_znak = 7
      atr_pen = 8


'=========================================
' 1. zp∙sob - Φtenφ z prom∞nnΘho kurzoru
' nemusφ se kontrolovat platnost zßznamu
'=========================================
If Open_cursor_direct("SELECT * FROM VBASIC", curnum) Then
    Signalize
Else
   res = Rec_cnt(curnum, pocet)
   Debug.Print "----------------------------------"
   Debug.Print "Kurzor Φ. "; curnum
   For i = 0 To pocet - 1
       pomstr = ""
       res = Read_ind_str(curnum, i, atr_ret, NO_INDEX, pomstr)  ' p°eΦtenφ °et∞zce dΘlky 12
       If Asc(pomstr) = 0 Then pomstr = ""
       res = Read_ind(curnum, i, atr_cislo, NO_INDEX, pomc)      ' p°eΦtenφ Φφsla
       res = Read_ind(curnum, i, atr_rcislo, NO_INDEX, pomr)     ' p°eΦtenφ reßlnΘho Φφsla
       res = Read_ind(curnum, i, atr_dat, NO_INDEX, pommd)       ' p°eΦtenφ 4 bytovΘho datumu
       If pommd = NONEDATE Then
'         pomd =
       Else
         dd = WBDay(pommd)                                         ' extrakce dne
         mm = WBMonth(pommd)                                       ' extrakce m∞sφce
         yy = WBYear(pommd)                                        ' extrakce roku
         pomd = DateSerial(rr, mm, dd)                             ' vytvo°enφ datumu ve formßtu VB
       End If
       res = Read_len(curnum, i, atr_pozn, NO_INDEX, vel)        ' zjiÜt∞nφ dΘlky poznßmky
       poznstr = ""
       res = Read_var_str(curnum, i, atr_pozn, NO_INDEX, 0, vel, poznstr, pocb) ' p°eΦtenφ poznßmky do dΘlky 2048
       res = Read_ind(curnum, i, atr_bool, NO_INDEX, pomb)        ' p°eΦtenφ logickΘ hodnoty
       res = Read_ind_str(curnum, i, atr_znak, NO_INDEX, pomznak) ' p°eΦtenφ znaku
       res = Read_ind(curnum, i, atr_pen, NO_INDEX, pommon)       ' p°eΦtenφ 6 bytoveho typu penize
       pomcr = money2real(pommon)
       Debug.Print i, pomstr, pomc, pomr, pomd, pomb, pomznak, pomcr
       Debug.Print poznstr
       Debug.Print "---"
   Next i
   res = Close_cursor(curnum)
End If

'=========================================
' 2. zp∙sob - Φtenφ p°φmo z tabulky
' nutno testovat atr. DELETED
'=========================================

If Find_object("VBASIC", CATEG_TABLE, tabnum) <> 0 Then
   Signalize
Else
   res = Rec_cnt(tabnum, pocet)
   Debug.Print "----------------------------------"
   Debug.Print "Tabulka Φ. "; tabnum
   For i = 0 To pocet - 1
       pomstr = ""
       res = Read_ind(tabnum, i, 0, NO_INDEX, pomb)
       If pomb = 0 Then       ' test atributu DELETED, je-li zßznam platn²
         res = Read_ind_str(tabnum, i, atr_ret, NO_INDEX, pomstr)  ' p°eΦtenφ °et∞zce dΘlky 12
         If Asc(pomstr) = 0 Then pomstr = ""
' atd
         Debug.Print i, pomstr
       Else
         Debug.Print i, "zßznam je zruÜen²"
       End If
       Debug.Print "---"
   Next i
End If

End Sub

Private Sub TheEnd_Click()
    Unload MDIForm1
    End
End Sub

'
' OÜet°enφ p°φkazu "Pohled" z menu Otev°φt
' ========================================
'
Private Sub View_Click()
    sts = Open_view("*VBasic", NO_REDIR, 0, 0, 0, 0, 0)
End Sub                     ' Otev°i pohled


'=========================================
'      Zßpis do tabulky VBASIC
'=========================================
Private Sub WriteTable_Click()

Dim curnum As Integer
Dim recnum As Long
Dim pomstr As String * 12
Dim pomc As Long
Dim pomr As Double
Dim pomd As Date
Dim pommd As Long
'Dim mm As Long, dd As Long, rr As Long
Dim mm As Integer, dd As Integer, rr As Integer
Dim poznstr As String * 2048

Const atr_ret = 1
      atr_cislo = 2
      atr_rcislo = 3
      atr_dat = 4
      atr_pozn = 5
      atr_bool = 6
      atr_znak = 7
      atr_pen = 8

If Open_cursor_direct("SELECT * FROM VBASIC", curnum) Then
    Signalize
Else
   MsgBox ("Bude vlo₧en zßznam a zapsßny do n∞j n∞kterΘ hodnoty")
   recnum = Insert(curnum)        ' vlo₧enφ zßznamu
   If recnum = -1 Then
     Signalize
   Else
     pomstr = "XXXXXXXXXX"
     res = Write_ind_str(curnum, recnum, atr_ret, NO_INDEX, pomstr, Len(pomstr)) ' zßpis °et∞zce
     If res = 1 Then Signalize
     pomc = 123
     res = Write_ind(curnum, recnum, atr_cislo, NO_INDEX, pomc, 4)               ' zßpis celΘho Φφsla
     pomr = 123.123
     res = Write_ind(curnum, recnum, atr_rcislo, NO_INDEX, pomr, 8)              ' zßpis reßlnΘho Φφsla
     pomd = Date                         ' dneÜnφ datum
     rr = Year(pomd)                     ' extrakce roku
     mm = Month(pomd)                    ' extrakce m∞sφce
     dd = Day(pomd)                      ' extrakce dne
     pommd = Make_date(dd, mm, rr)       ' vytvo°enφ datumu ve formßtu WB (4 byty)
     res = Write_ind(curnum, recnum, atr_dat, NO_INDEX, pommd, 4)            ' zßpis datumu
     res = Write_ind(curnum, recnum, atr_bool, NO_INDEX, 1, 1)               ' zßpis logickΘ hodnoty (ANO)
     res = Write_ind_str(curnum, recnum, atr_znak, NO_INDEX, "X", 1)         ' zßpis znaku
     poznstr = "prvnφ °ßdek poznßmky" & Chr(13) & Chr(10) & "druh² °ßdek poznßmky"
     res = Write_var_str(curnum, recnum, atr_pozn, NO_INDEX, 0, Len(poznstr), poznstr) ' zßpis dvou°ßdkovΘ poznßmky
     If res = 1 Then Signalize

   End If
End If

MsgBox ("Spus¥te si WinBase, abyste se p°esv∞dΦili, ₧e zßznam byl vlo₧en." & Chr(13) & Chr(10) & "V dalÜφm kroku bude zßznam op∞t zruÜen")
res = Delete(curnum, recnum)             ' zruÜenφ zßznamu
res = Close_cursor(curnum)               ' zav°enφ kurzoru

Dim tabnum As Integer
If Find_object("VBASIC", CATEG_TABLE, tabnum) <> 0 Then
   Signalize
Else
   res = Free_deleted(tabnum)
   If res = 0 Then Signalize
End If

End Sub