home *** CD-ROM | disk | FTP | other *** search
/ PC World 1999 July / PCWorld_1999-07_cd.bin / 602 / WBPERSON / data1.cab / SDK_Files / Vbasic / PROG / MDIFORM1.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-06-09  |  9.9 KB  |  384 lines
  1. VERSION 4.00
  2. Begin VB.MDIForm MDIForm1 
  3.    BackColor       =   &H8000000C&
  4.    Caption         =   "Vzorov
  5.  aplikace WinBase602 ve Visual Basicu"
  6.    ClientHeight    =   5940
  7.    ClientLeft      =   1470
  8.    ClientTop       =   1815
  9.    ClientWidth     =   6690
  10.    Height          =   6630
  11.    Left            =   1410
  12.    LinkTopic       =   "MDIForm1"
  13.    Top             =   1185
  14.    Width           =   6810
  15.    Begin VB.Menu Open 
  16.       Caption         =   "O&tev
  17.       Begin VB.Menu Frm 
  18.          Caption         =   "&Okno VB"
  19.       End
  20.       Begin VB.Menu View 
  21.          Caption         =   "&Pohled WinBase"
  22.       End
  23.    End
  24.    Begin VB.Menu Data 
  25.       Caption         =   "&Data"
  26.       Begin VB.Menu ReadTable 
  27.          Caption         =   "
  28.  z tabulky"
  29.       End
  30.       Begin VB.Menu WriteTable 
  31.          Caption         =   "&Z
  32. pis do tabulky"
  33.       End
  34.    End
  35.    Begin VB.Menu Window 
  36.       Caption         =   "&Okna"
  37.       WindowList      =   -1  'True
  38.       Begin VB.Menu Kask 
  39.          Caption         =   "&Kask
  40.       End
  41.       Begin VB.Menu Moza 
  42.          Caption         =   "&Mozaika"
  43.       End
  44.    End
  45.    Begin VB.Menu Help 
  46.       Caption         =   "&N
  47.       Begin VB.Menu Nap 
  48.          Caption         =   "Napov
  49. dat se nem
  50.       End
  51.    End
  52.    Begin VB.Menu TheEnd 
  53.       Caption         =   "&Konec"
  54.    End
  55. Attribute VB_Name = "MDIForm1"
  56. Attribute VB_Creatable = False
  57. Attribute VB_Exposed = False
  58. kazu "Okno" z menu Otev
  59. ' ======================================
  60. Private Sub Frm_Click()
  61.     Static i As Integer
  62.     Dim NewForm As New Form1   ' Otev
  63. i nov
  64.  MDI child
  65.     i = i + 1
  66.     NewForm.caption = "MDI " + Str$(i)
  67. End Sub
  68. kazu "Kask
  69. da" z menu Okna
  70. ' ======================================
  71. Private Sub Kask_Click()
  72.     MDIForm1.Arrange 0
  73. End Sub
  74. ' Aktivace hlavn
  75. ho okna aplikace
  76. ' ===============================
  77. Private Sub MDIForm_Activate()
  78.     '
  79.     ' Prihl
  80. ivatele
  81.     '
  82.     sts = Alogin(MDIForm1.hWnd)
  83.     If (sts = 0) Then
  84.         Unload MDIForm1
  85.         End
  86.     End If
  87.     '
  88.     ' Nastaven
  89.  aplikace
  90.     '
  91.     sts = Set_application("VBasic")
  92.     If (sts <> 0) Then
  93.         MsgBox "Zadan
  94.  aplikace v datab
  95. zi nen
  96. !" + Chr$(13) + Chr$(10) + Chr$(10) + "          Je naimportovan
  97. ?", 16, "VBasic"
  98.         Unload MDIForm1
  99.         End
  100.     End If
  101. End Sub
  102. ' Zaveden
  103.  hlavn
  104. ho okna aplikace
  105. ' ===============================
  106. Private Sub MDIForm_Load()
  107.     '
  108.     ' Napojen
  109.  na WinBaseFrameProc
  110.     '
  111.     ConWinBaseFrameProc hWnd, 1
  112.     '
  113.     ' Inicializace vnit
  114. ch struktur
  115.     '
  116.     cdp = cdp_init_vb()
  117.     '
  118.     ' Spu
  119.  serveru
  120.     '
  121.     If (Command = "") Then
  122.         MsgBox "Na p
  123. kazov
  124. dce nen
  125.  server", 16, "VBasic"
  126.         Unload MDIForm1
  127.         End
  128.     End If
  129.         
  130.     sts = link_kernel(Command, SW_MINIMIZE)
  131.     If (sts <> KSE_OK) Then
  132.         Kernel_error_box (sts)
  133.         Unload MDIForm1
  134.         End
  135.     End If
  136.     '
  137.     ' Inicializace spojen
  138.     '
  139.     sts = interf_init(cdp, 0)
  140.     If (sts <> KSE_OK) Then
  141.         MsgBox "Nejde inicializovat spojen
  142. drem datab
  143. ze", 16, "VBasic"
  144.         Unload MDIForm1
  145.         End
  146.     End If
  147. End Sub
  148. ' Zav
  149.  hlavn
  150. ho okna aplikace
  151. ' ===============================
  152. Private Sub MDIForm_Unload(Cancel As Integer)
  153.     sts = Logout
  154.     If (sts <> KSE_OK) Then
  155.         MsgBox "Chyba p
  156. i odlogov
  157. ", 16, "VBasic"
  158.         End
  159.     End If
  160.     interf_close
  161.     unlink_kernel
  162. End Sub
  163. kazu "Mozaika" z menu Okna
  164. ' ======================================
  165. Private Sub Moza_Click()
  166.     MDIForm1.Arrange 1
  167. End Sub
  168. '=========================================
  169. '      
  170.  z tabulky VBASIC
  171. '       v
  172. stup do Debug okna
  173. '=========================================
  174. Private Sub ReadTable_Click()
  175. Dim tabnum As Integer, curnum As Integer
  176. Dim pomstr As String * 12
  177. Dim poznstr As String * 2048
  178. Dim pomc As Long
  179. Dim pomr As Double
  180. Dim pomd As Date
  181. Dim pommd As Long
  182. Dim pocet As Long
  183. Dim vel As Long
  184. Dim pocb As Long
  185. Dim mm As Integer, dd As Integer, rr As Integer
  186. Dim pomb As Byte
  187. Dim pomznak As String * 1
  188. Dim pommon As monstr
  189. Dim pomcr As Double
  190. Const atr_ret = 1
  191.       atr_cislo = 2
  192.       atr_rcislo = 3
  193.       atr_dat = 4
  194.       atr_pozn = 5
  195.       atr_bool = 6
  196.       atr_znak = 7
  197.       atr_pen = 8
  198. '=========================================
  199. ' 1. zp
  200. sob - 
  201.  z prom
  202. ho kurzoru
  203. ' nemus
  204.  se kontrolovat platnost z
  205. znamu
  206. '=========================================
  207. If Open_cursor_direct("SELECT * FROM VBASIC", curnum) Then
  208.     Signalize
  209.    res = Rec_cnt(curnum, pocet)
  210.    Debug.Print "----------------------------------"
  211.    Debug.Print "Kurzor 
  212. . "; curnum
  213.    For i = 0 To pocet - 1
  214.        pomstr = ""
  215.        res = Read_ind_str(curnum, i, atr_ret, NO_INDEX, pomstr)  ' p
  216. zce d
  217. lky 12
  218.        If Asc(pomstr) = 0 Then pomstr = ""
  219.        res = Read_ind(curnum, i, atr_cislo, NO_INDEX, pomc)      ' p
  220.        res = Read_ind(curnum, i, atr_rcislo, NO_INDEX, pomr)     ' p
  221.        res = Read_ind(curnum, i, atr_dat, NO_INDEX, pommd)       ' p
  222.  4 bytov
  223. ho datumu
  224.        If pommd = NONEDATE Then
  225. '         pomd =
  226.        Else
  227.          dd = WBDay(pommd)                                         ' extrakce dne
  228.          mm = WBMonth(pommd)                                       ' extrakce m
  229.          yy = WBYear(pommd)                                        ' extrakce roku
  230.          pomd = DateSerial(rr, mm, dd)                             ' vytvo
  231.  datumu ve form
  232. tu VB
  233.        End If
  234.        res = Read_len(curnum, i, atr_pozn, NO_INDEX, vel)        ' zji
  235. lky pozn
  236.        poznstr = ""
  237.        res = Read_var_str(curnum, i, atr_pozn, NO_INDEX, 0, vel, poznstr, pocb) ' p
  238.  pozn
  239. mky do d
  240. lky 2048
  241.        res = Read_ind(curnum, i, atr_bool, NO_INDEX, pomb)        ' p
  242.  logick
  243.  hodnoty
  244.        res = Read_ind_str(curnum, i, atr_znak, NO_INDEX, pomznak) ' p
  245.  znaku
  246.        res = Read_ind(curnum, i, atr_pen, NO_INDEX, pommon)       ' p
  247.  6 bytoveho typu penize
  248.        pomcr = money2real(pommon)
  249.        Debug.Print i, pomstr, pomc, pomr, pomd, pomb, pomznak, pomcr
  250.        Debug.Print poznstr
  251.        Debug.Print "---"
  252.    Next i
  253.    res = Close_cursor(curnum)
  254. End If
  255. '=========================================
  256. ' 2. zp
  257. sob - 
  258. mo z tabulky
  259. ' nutno testovat atr. DELETED
  260. '=========================================
  261. If Find_object("VBASIC", CATEG_TABLE, tabnum) <> 0 Then
  262.    Signalize
  263.    res = Rec_cnt(tabnum, pocet)
  264.    Debug.Print "----------------------------------"
  265.    Debug.Print "Tabulka 
  266. . "; tabnum
  267.    For i = 0 To pocet - 1
  268.        pomstr = ""
  269.        res = Read_ind(tabnum, i, 0, NO_INDEX, pomb)
  270.        If pomb = 0 Then       ' test atributu DELETED, je-li z
  271. znam platn
  272.          res = Read_ind_str(tabnum, i, atr_ret, NO_INDEX, pomstr)  ' p
  273. zce d
  274. lky 12
  275.          If Asc(pomstr) = 0 Then pomstr = ""
  276. ' atd
  277.          Debug.Print i, pomstr
  278.        Else
  279.          Debug.Print i, "z
  280. znam je zru
  281.        End If
  282.        Debug.Print "---"
  283.    Next i
  284. End If
  285. End Sub
  286. Private Sub TheEnd_Click()
  287.     Unload MDIForm1
  288.     End
  289. End Sub
  290. kazu "Pohled" z menu Otev
  291. ' ========================================
  292. Private Sub View_Click()
  293.     sts = Open_view("*VBasic", NO_REDIR, 0, 0, 0, 0, 0)
  294. End Sub                     ' Otev
  295. i pohled
  296. '=========================================
  297. '      Z
  298. pis do tabulky VBASIC
  299. '=========================================
  300. Private Sub WriteTable_Click()
  301. Dim curnum As Integer
  302. Dim recnum As Long
  303. Dim pomstr As String * 12
  304. Dim pomc As Long
  305. Dim pomr As Double
  306. Dim pomd As Date
  307. Dim pommd As Long
  308. 'Dim mm As Long, dd As Long, rr As Long
  309. Dim mm As Integer, dd As Integer, rr As Integer
  310. Dim poznstr As String * 2048
  311. Const atr_ret = 1
  312.       atr_cislo = 2
  313.       atr_rcislo = 3
  314.       atr_dat = 4
  315.       atr_pozn = 5
  316.       atr_bool = 6
  317.       atr_znak = 7
  318.       atr_pen = 8
  319. If Open_cursor_direct("SELECT * FROM VBASIC", curnum) Then
  320.     Signalize
  321.    MsgBox ("Bude vlo
  322. znam a zaps
  323. ny do n
  324.  hodnoty")
  325.    recnum = Insert(curnum)        ' vlo
  326. znamu
  327.    If recnum = -1 Then
  328.      Signalize
  329.    Else
  330.      pomstr = "XXXXXXXXXX"
  331.      res = Write_ind_str(curnum, recnum, atr_ret, NO_INDEX, pomstr, Len(pomstr)) ' z
  332.      If res = 1 Then Signalize
  333.      pomc = 123
  334.      res = Write_ind(curnum, recnum, atr_cislo, NO_INDEX, pomc, 4)               ' z
  335. pis cel
  336.      pomr = 123.123
  337.      res = Write_ind(curnum, recnum, atr_rcislo, NO_INDEX, pomr, 8)              ' z
  338. pis re
  339.      pomd = Date                         ' dne
  340.  datum
  341.      rr = Year(pomd)                     ' extrakce roku
  342.      mm = Month(pomd)                    ' extrakce m
  343.      dd = Day(pomd)                      ' extrakce dne
  344.      pommd = Make_date(dd, mm, rr)       ' vytvo
  345.  datumu ve form
  346. tu WB (4 byty)
  347.      res = Write_ind(curnum, recnum, atr_dat, NO_INDEX, pommd, 4)            ' z
  348. pis datumu
  349.      res = Write_ind(curnum, recnum, atr_bool, NO_INDEX, 1, 1)               ' z
  350. pis logick
  351.  hodnoty (ANO)
  352.      res = Write_ind_str(curnum, recnum, atr_znak, NO_INDEX, "X", 1)         ' z
  353. pis znaku
  354.      poznstr = "prvn
  355. dek pozn
  356. mky" & Chr(13) & Chr(10) & "druh
  357. dek pozn
  358.      res = Write_var_str(curnum, recnum, atr_pozn, NO_INDEX, 0, Len(poznstr), poznstr) ' z
  359. pis dvou
  360.  pozn
  361.      If res = 1 Then Signalize
  362.      
  363.    End If
  364. End If
  365. MsgBox ("Spus
  366. te si WinBase, abyste se p
  367. ili, 
  368. znam byl vlo
  369. en." & Chr(13) & Chr(10) & "V dal
  370. m kroku bude z
  371. znam op
  372. t zru
  373. res = Delete(curnum, recnum)             ' zru
  374. znamu
  375. res = Close_cursor(curnum)               ' zav
  376.  kurzoru
  377. Dim tabnum As Integer
  378. If Find_object("VBASIC", CATEG_TABLE, tabnum) <> 0 Then
  379.    Signalize
  380.    res = Free_deleted(tabnum)
  381.    If res = 0 Then Signalize
  382. End If
  383. End Sub
  384.