home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / aphotheek_201099842006.psc / EINDWERK!! / frmarts.frm < prev    next >
Text File  |  2004-05-15  |  17KB  |  540 lines
  1. VERSION 5.00
  2. Begin VB.Form frmarts 
  3.    Caption         =   "Arts"
  4.    ClientHeight    =   7260
  5.    ClientLeft      =   60
  6.    ClientTop       =   450
  7.    ClientWidth     =   11880
  8.    LinkTopic       =   "Form1"
  9.    MDIChild        =   -1  'True
  10.    ScaleHeight     =   7260
  11.    ScaleWidth      =   11880
  12.    WindowState     =   2  'Maximized
  13.    Begin VB.TextBox txttelefoon 
  14.       Height          =   375
  15.       Left            =   240
  16.       TabIndex        =   22
  17.       Text            =   "Text5"
  18.       Top             =   5640
  19.       Width           =   4695
  20.    End
  21.    Begin VB.CommandButton cmdsluiten 
  22.       Caption         =   "&Sluiten"
  23.       BeginProperty Font 
  24.          Name            =   "MS Sans Serif"
  25.          Size            =   9.75
  26.          Charset         =   0
  27.          Weight          =   700
  28.          Underline       =   0   'False
  29.          Italic          =   0   'False
  30.          Strikethrough   =   0   'False
  31.       EndProperty
  32.       Height          =   975
  33.       Left            =   9840
  34.       Picture         =   "frmarts.frx":0000
  35.       Style           =   1  'Graphical
  36.       TabIndex        =   20
  37.       Top             =   6120
  38.       Width           =   1695
  39.    End
  40.    Begin VB.Frame fracommand 
  41.       BorderStyle     =   0  'None
  42.       Height          =   3015
  43.       Left            =   9720
  44.       TabIndex        =   16
  45.       Top             =   240
  46.       Width           =   1935
  47.       Begin VB.CommandButton cmdwis 
  48.          Caption         =   "&Wissen"
  49.          BeginProperty Font 
  50.             Name            =   "MS Sans Serif"
  51.             Size            =   9.75
  52.             Charset         =   0
  53.             Weight          =   700
  54.             Underline       =   0   'False
  55.             Italic          =   0   'False
  56.             Strikethrough   =   0   'False
  57.          EndProperty
  58.          Height          =   975
  59.          Left            =   120
  60.          Picture         =   "frmarts.frx":0442
  61.          Style           =   1  'Graphical
  62.          TabIndex        =   19
  63.          Top             =   1920
  64.          Width           =   1695
  65.       End
  66.       Begin VB.CommandButton cmdzoek 
  67.          Caption         =   "&Zoeken"
  68.          BeginProperty Font 
  69.             Name            =   "MS Sans Serif"
  70.             Size            =   9.75
  71.             Charset         =   0
  72.             Weight          =   700
  73.             Underline       =   0   'False
  74.             Italic          =   0   'False
  75.             Strikethrough   =   0   'False
  76.          EndProperty
  77.          Height          =   975
  78.          Left            =   120
  79.          Picture         =   "frmarts.frx":0544
  80.          Style           =   1  'Graphical
  81.          TabIndex        =   18
  82.          Top             =   960
  83.          Width           =   1695
  84.       End
  85.       Begin VB.CommandButton cmdbewaar 
  86.          Caption         =   "&Bewaren"
  87.          BeginProperty Font 
  88.             Name            =   "MS Sans Serif"
  89.             Size            =   9.75
  90.             Charset         =   0
  91.             Weight          =   700
  92.             Underline       =   0   'False
  93.             Italic          =   0   'False
  94.             Strikethrough   =   0   'False
  95.          EndProperty
  96.          Height          =   975
  97.          Left            =   120
  98.          Picture         =   "frmarts.frx":0986
  99.          Style           =   1  'Graphical
  100.          TabIndex        =   17
  101.          Top             =   0
  102.          Width           =   1695
  103.       End
  104.    End
  105.    Begin VB.TextBox txtemail 
  106.       Height          =   375
  107.       Left            =   5760
  108.       TabIndex        =   15
  109.       Text            =   "Text12"
  110.       Top             =   5640
  111.       Width           =   3495
  112.    End
  113.    Begin VB.TextBox txtgemeente 
  114.       Height          =   375
  115.       Left            =   5760
  116.       TabIndex        =   13
  117.       Text            =   "Text8"
  118.       Top             =   4320
  119.       Width           =   3495
  120.    End
  121.    Begin VB.TextBox txthuisnr 
  122.       Height          =   375
  123.       Left            =   5760
  124.       TabIndex        =   9
  125.       Text            =   "Text7"
  126.       Top             =   3120
  127.       Width           =   3495
  128.    End
  129.    Begin VB.TextBox txtnaam 
  130.       Height          =   375
  131.       Left            =   5760
  132.       TabIndex        =   5
  133.       Text            =   "Text6"
  134.       Top             =   1920
  135.       Width           =   3495
  136.    End
  137.    Begin VB.TextBox txtpostcode 
  138.       Height          =   375
  139.       Left            =   240
  140.       TabIndex        =   12
  141.       Text            =   "Text4"
  142.       Top             =   4320
  143.       Width           =   4695
  144.    End
  145.    Begin VB.TextBox txtstraat 
  146.       Height          =   375
  147.       Left            =   240
  148.       TabIndex        =   8
  149.       Text            =   "Text3"
  150.       Top             =   3120
  151.       Width           =   4695
  152.    End
  153.    Begin VB.TextBox txtvoornaam 
  154.       Height          =   375
  155.       Left            =   240
  156.       TabIndex        =   4
  157.       Text            =   "Text2"
  158.       Top             =   1920
  159.       Width           =   4695
  160.    End
  161.    Begin VB.TextBox txtartsid 
  162.       Height          =   375
  163.       Left            =   240
  164.       TabIndex        =   1
  165.       Text            =   "Text1"
  166.       Top             =   720
  167.       Width           =   3495
  168.    End
  169.    Begin VB.Label lbltelefoon 
  170.       Caption         =   "&Telefoon"
  171.       BeginProperty Font 
  172.          Name            =   "MS Sans Serif"
  173.          Size            =   9.75
  174.          Charset         =   0
  175.          Weight          =   700
  176.          Underline       =   0   'False
  177.          Italic          =   0   'False
  178.          Strikethrough   =   0   'False
  179.       EndProperty
  180.       Height          =   375
  181.       Left            =   240
  182.       TabIndex        =   21
  183.       Top             =   5040
  184.       Width           =   1935
  185.    End
  186.    Begin VB.Label lblemail 
  187.       Caption         =   "E-mail"
  188.       BeginProperty Font 
  189.          Name            =   "MS Sans Serif"
  190.          Size            =   9.75
  191.          Charset         =   0
  192.          Weight          =   700
  193.          Underline       =   0   'False
  194.          Italic          =   0   'False
  195.          Strikethrough   =   0   'False
  196.       EndProperty
  197.       Height          =   255
  198.       Left            =   5760
  199.       TabIndex        =   14
  200.       Top             =   5040
  201.       Width           =   1935
  202.    End
  203.    Begin VB.Label lblgemeente 
  204.       Caption         =   "Gemeente"
  205.       BeginProperty Font 
  206.          Name            =   "MS Sans Serif"
  207.          Size            =   9.75
  208.          Charset         =   0
  209.          Weight          =   700
  210.          Underline       =   0   'False
  211.          Italic          =   0   'False
  212.          Strikethrough   =   0   'False
  213.       EndProperty
  214.       Height          =   255
  215.       Left            =   5760
  216.       TabIndex        =   11
  217.       Top             =   3840
  218.       Width           =   1695
  219.    End
  220.    Begin VB.Label lblhuisnummer 
  221.       Caption         =   "Huisnummer"
  222.       BeginProperty Font 
  223.          Name            =   "MS Sans Serif"
  224.          Size            =   9.75
  225.          Charset         =   0
  226.          Weight          =   700
  227.          Underline       =   0   'False
  228.          Italic          =   0   'False
  229.          Strikethrough   =   0   'False
  230.       EndProperty
  231.       Height          =   255
  232.       Left            =   5760
  233.       TabIndex        =   7
  234.       Top             =   2640
  235.       Width           =   1455
  236.    End
  237.    Begin VB.Label Label6 
  238.       Caption         =   "Naam"
  239.       BeginProperty Font 
  240.          Name            =   "MS Sans Serif"
  241.          Size            =   9.75
  242.          Charset         =   0
  243.          Weight          =   700
  244.          Underline       =   0   'False
  245.          Italic          =   0   'False
  246.          Strikethrough   =   0   'False
  247.       EndProperty
  248.       Height          =   255
  249.       Left            =   5760
  250.       TabIndex        =   3
  251.       Top             =   1440
  252.       Width           =   2175
  253.    End
  254.    Begin VB.Label lblpostcode 
  255.       Caption         =   "Postcode"
  256.       BeginProperty Font 
  257.          Name            =   "MS Sans Serif"
  258.          Size            =   9.75
  259.          Charset         =   0
  260.          Weight          =   700
  261.          Underline       =   0   'False
  262.          Italic          =   0   'False
  263.          Strikethrough   =   0   'False
  264.       EndProperty
  265.       Height          =   255
  266.       Left            =   240
  267.       TabIndex        =   10
  268.       Top             =   3840
  269.       Width           =   1815
  270.    End
  271.    Begin VB.Label lblstraat 
  272.       Caption         =   "Straat"
  273.       BeginProperty Font 
  274.          Name            =   "MS Sans Serif"
  275.          Size            =   9.75
  276.          Charset         =   0
  277.          Weight          =   700
  278.          Underline       =   0   'False
  279.          Italic          =   0   'False
  280.          Strikethrough   =   0   'False
  281.       EndProperty
  282.       Height          =   255
  283.       Left            =   240
  284.       TabIndex        =   6
  285.       Top             =   2640
  286.       Width           =   1815
  287.    End
  288.    Begin VB.Label lblvoornaam 
  289.       Caption         =   "Voornaam"
  290.       BeginProperty Font 
  291.          Name            =   "MS Sans Serif"
  292.          Size            =   9.75
  293.          Charset         =   0
  294.          Weight          =   700
  295.          Underline       =   0   'False
  296.          Italic          =   0   'False
  297.          Strikethrough   =   0   'False
  298.       EndProperty
  299.       Height          =   255
  300.       Left            =   240
  301.       TabIndex        =   2
  302.       Top             =   1440
  303.       Width           =   1695
  304.    End
  305.    Begin VB.Label lblartsID 
  306.       Caption         =   "ArtsID"
  307.       BeginProperty Font 
  308.          Name            =   "MS Sans Serif"
  309.          Size            =   9.75
  310.          Charset         =   0
  311.          Weight          =   700
  312.          Underline       =   0   'False
  313.          Italic          =   0   'False
  314.          Strikethrough   =   0   'False
  315.       EndProperty
  316.       Height          =   375
  317.       Left            =   360
  318.       TabIndex        =   0
  319.       Top             =   120
  320.       Width           =   1695
  321.    End
  322. End
  323. Attribute VB_Name = "frmarts"
  324. Attribute VB_GlobalNameSpace = False
  325. Attribute VB_Creatable = False
  326. Attribute VB_PredeclaredId = True
  327. Attribute VB_Exposed = False
  328. Private dbklant As DAO.Database
  329. Private rsklant As DAO.Recordset
  330. Private blnnewrec As Boolean
  331. Private lngmaxrec As Long
  332.  
  333. Private Function fnewid() As Long
  334.     Dim rsnewid As DAO.Recordset
  335.     Set rsnewid = dbklant.OpenRecordset("tblarts", dbOpenTable)
  336.     With rsnewid
  337.     .MoveLast
  338.     fnewid = .Fields("artsid").Value + 1
  339.     .Close
  340.     End With
  341.     Set rsnewid = Nothing
  342.     
  343. End Function
  344.  
  345.  
  346. Public Sub Sleesrec(rslees As DAO.Recordset)
  347.     Dim dbklant As DAO.Database
  348.     Dim rsklant As DAO.Recordset
  349.    Set dbklant = OpenDatabase(App.Path & "\klanten.mdb")
  350.    Set rsklant = dbklant.OpenRecordset("tblarts", dbOpenTable)
  351.  
  352.     txtartsid.Text = rslees.Fields("artsid").Value
  353.     txtnaam.Text = rslees.Fields("Anaam").Value
  354.     txtvoornaam.Text = rslees.Fields("Avoornaam").Value
  355.     txtstraat.Text = rslees.Fields("Astraat").Value
  356.     txthuisnr.Text = rslees.Fields("Ahuisnummer").Value
  357.     txtpostcode.Text = rslees.Fields("Apostcode").Value
  358.     txtgemeente.Text = rslees.Fields("Agemeente").Value
  359.     txttelefoon.Text = rslees.Fields("Atelefoon").Value
  360.     txtemail.Text = rslees.Fields("Aemail").Value
  361.  
  362.  
  363. End Sub
  364.  
  365. Private Sub cmdbewaar_Click()
  366. Dim blnonvolledigeinput As Boolean
  367. Dim dbklant As DAO.Database
  368. Dim rsklant As DAO.Recordset
  369. Set dbklant = OpenDatabase(App.Path & "\klanten.mdb")
  370. Set rsklant = dbklant.OpenRecordset("tblarts", dbOpenTable)
  371.  
  372. If Len(Trim(txtartsid.Text)) = 0 Then
  373.     txtartsid.BackColor = vbRed
  374.     txtartsid.ToolTipText = "Het artsidnr is verplicht"
  375.     blnonvolledigeinput = True
  376.     End If
  377.     
  378. If Len(Trim(txtvoornaam.Text)) = 0 Then
  379.     txtvoornaam.BackColor = vbRed
  380.     txtvoornaam.ToolTipText = "Het veld voornaam is verplicht"
  381.     blnonvolledigeinput = True
  382.     End If
  383.  
  384. If Len(Trim(txtnaam.Text)) = 0 Then
  385.     txtnaam.BackColor = vbRed
  386.     txtnaam.ToolTipText = "Het veld naam is verplicht"
  387.     blnonvolledigeinput = True
  388.     End If
  389.     
  390. If blnonvolledigeinput Then
  391.     MsgBox "Sorry, maar gelieve de invoer van de rood gekleurde velden" & vbCrLf & "aan te passen.", vbOKOnly + vbInformation, "Ingave fout"
  392.     
  393.     Else
  394.     If blnnewrec Then
  395.     rsklant.AddNew
  396.     rsklant.Fields("artsid").Value = Trim(txtartsid.Text) & " "
  397.     Else
  398.     rsklant.Index = "primarykey"
  399.     rsklant.Seek "=", Trim(txtartsid.Text)
  400.     If Not rsklant.NoMatch Then
  401.     rsklant.Edit
  402.     Else
  403.     Exit Sub
  404.     End If
  405. End If
  406.      rsklant.Fields("artsid").Value = Trim(txtartsid.Text) & " "
  407.      rsklant.Fields("Anaam").Value = Trim(txtnaam.Text) & " "
  408.      rsklant.Fields("Avoornaam").Value = Trim(txtvoornaam.Text) & " "
  409.      rsklant.Fields("Astraat").Value = Trim(txtstraat.Text) & " "
  410.      rsklant.Fields("Ahuisnummer").Value = Trim(txthuisnr.Text) & " "
  411.      rsklant.Fields("Apostcode").Value = Trim(txtpostcode.Text) & " "
  412.      rsklant.Fields("Agemeente").Value = Trim(txtgemeente.Text) & " "
  413.      rsklant.Fields("Atelefoon").Value = Trim(txttelefoon.Text) & " "
  414.      rsklant.Fields("Aemail").Value = Trim(txtemail.Text) & " "
  415.           MsgBox "input ok", vbOKOnly + vbInformation, "naam opslaan"
  416.  
  417.      
  418.      rsklant.Update
  419.      
  420.      
  421.      
  422.     End If
  423.  
  424. End Sub
  425.  
  426. Private Sub cmdsluiten_Click()
  427. If MsgBox("opgelet zijn de bestanden reeds BEWAART", vbYesNo) = vbYes Then
  428.  
  429. Unload Me
  430. End If
  431.  
  432.  
  433. End Sub
  434.  
  435. Private Sub cmdwis_Click()
  436. Dim dbklant As DAO.Database
  437. Dim rsklant As DAO.Recordset
  438.     Set dbklant = OpenDatabase(App.Path & "\klanten.mdb")
  439.     Set rsklant = dbklant.OpenRecordset("tblarts", dbOpenTable)
  440.     With rsklant
  441.     .Index = "primarykey"
  442.     .Seek "=", Trim(txtartsid.Text)
  443.     If Not .NoMatch Then
  444.         Call Sleesrec(rslees:=rsklant)
  445.         If MsgBox("wil je record met ID " & txtartsid, vbYesNo + vbQuestion + vbDefaultButton2, "SCHRAPPEN") = vbYes Then
  446.         .Delete
  447.         End If
  448.     Else
  449.     MsgBox "er is geen adres gevonden met id " & txtidnr.Text, vbOKOnly + vbInformation, "Zoekresultaat"
  450.     End If
  451.     .MoveLast
  452.     Call gsClearText(frm:=Me)
  453.     txtartsid.Text = .Fields("artsid").Value
  454.     blnnewrec = True
  455.     End With
  456.     rsklant.Close
  457.     dbklant.Close
  458.     Set rsklant = Nothing
  459.     Set dbklant = Nothing
  460.  
  461. End Sub
  462.  
  463. Private Sub cmdzoek_Click()
  464. Dim dbklant As DAO.Database
  465. Dim rsklant As DAO.Recordset
  466.     Set dbklant = OpenDatabase(App.Path & "\klanten.mdb")
  467.     Set rsklant = dbklant.OpenRecordset("tblarts", dbOpenTable)
  468.     
  469.     With rsklant
  470.     .Index = "primarykey"
  471.     .Seek "=", Trim(txtartsid.Text)
  472.     If Not .NoMatch Then
  473.         Call Sleesrec(rslees:=rsklant)
  474.         blnnewrec = False
  475.         Else
  476.     MsgBox "er is geen adres gevonden met id &  txtidnr.Text, vbOKOnly + vbInformation, zoekresultaat"
  477.     .MoveLast
  478.     Call gsClearText(frm:=Me)
  479.     txtartsid.Text = .Fields("artsid").Value + 1
  480.     blnnewrec = True
  481.     End If
  482.     End With
  483.     rsklant.Close
  484.     dbklant.Close
  485.     Set rsklant = Nothing
  486.     Set dbklant = Nothing
  487.     
  488.  
  489. End Sub
  490.  
  491. Private Sub Form_Load()
  492.     Dim ctrl As Control
  493.         For Each ctrl In Me.Controls
  494.     If TypeOf ctrl Is TextBox Then
  495.         ctrl.Text = vbNullString
  496.     End If
  497.     Next ctrl
  498.  
  499. Dim dbklant As DAO.Database
  500. Dim rsklant As DAO.Recordset
  501.  
  502. blnnewrec = True
  503.  
  504. Set dbklant = OpenDatabase(App.Path & "\klanten.mdb")
  505. Set rsklant = dbklant.OpenRecordset("tblarts", dbOpenTable)
  506.  
  507. rsklant.MoveLast
  508. lngmaxrec = rsklant.RecordCount
  509. txtartsid.Text = rsklant.Fields("artsid").Value
  510. rsklant.MoveNext
  511.  
  512. Set rsklant = dbklant.OpenRecordset("tblafnemer", dbOpenTable)
  513. Set rsklant = dbklant.OpenRecordset("tblklant", dbOpenTable)
  514.  
  515. End Sub
  516.  
  517. Private Sub txtartsid_KeyPress(KeyAscii As Integer)
  518.     Select Case KeyAscii
  519.         Case Asc("0") To Asc("9")
  520.         Case Else
  521.         KeyAscii = 0
  522.         
  523.         MsgBox "Sorry alleen getallen zijn geldig", vbOKOnly + vbInformation, "Foutieve ingave"
  524.     End Select
  525.  
  526. End Sub
  527.  
  528. Private Sub txtartsid_Validate(Cancel As Boolean)
  529.     If Len(Trim(ActiveControl)) > 0 Then
  530.         ActiveControl.BackColor = vbWhite
  531.         ActiveControl.ToolTipText = ""
  532.     Else
  533.         ActiveControl.BackColor = vbRed
  534.         ActiveControl.ToolTipText = "Dit is een verplicht veld"
  535.         Cancel = True
  536.         End If
  537.  
  538. End Sub
  539.  
  540.