io Programmo 27

home *** CD-ROM | disk | FTP | other *** search

/ io Programmo 27 / IOPROG_27.ISO / SOFT / DATABASE.ZIP / VB6DB.ctl (.txt) < prev next >

Wrap

Visual Basic Form | 1999-05-23 | 41.8 KB | 1,213 lines

VERSION 5.00 Object = "{0BA686C6-F7D3-101A-993E-0000C0EF6F5E}#1.0#0"; "THREED32.OCX" Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "fm20.dll" Object = "{00025600-0000-0000-C000-000000000046}#4.6#0"; "crystl32.ocx" Object = "{D38910A8-E766-11D0-B2AE-444553540000}#1.0#0"; "OACTools.ocx" Begin VB.UserControl VB6DB Alignable = -1 'True AutoRedraw = -1 'True BackColor = &H00C0C0C0& BackStyle = 0 'Transparent ClientHeight = 4380 ClientLeft = 0 ClientTop = 0 ClientWidth = 7620 ControlContainer= -1 'True PropertyPages = "VB6DB.ctx":0000 ScaleHeight = 4380 ScaleWidth = 7620 ToolboxBitmap = "VB6DB.ctx":000E Begin VB.Data DBCR Caption = "Data1" Connect = "Access" DatabaseName = "" DefaultCursorType= 0 'DefaultCursor DefaultType = 2 'UseODBC Exclusive = 0 'False Height = 345 Left = 780 Options = 0 ReadOnly = 0 'False RecordsetType = 1 'Dynaset RecordSource = "" Top = 3480 Visible = 0 'False Width = 1275 End Begin Crystal.CrystalReport CR Bindings = "VB6DB.ctx":0320 Left = 2160 Top = 3360 _ExtentX = 741 _ExtentY = 741 _Version = 262150 ReportSource = 3 End Begin Threed.SSPanel SSPanel2 Align = 1 'Align Top Height = 1095 Left = 0 TabIndex = 2 Top = 0 Visible = 0 'False Width = 7620 _Version = 65536 _ExtentX = 13441 _ExtentY = 1931 _StockProps = 15 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty BorderWidth = 1 BevelInner = 1 Begin VB6database.axButton sdButton2 Height = 195 Left = 7380 TabIndex = 31 ToolTipText = "Chiudi e ripristina il database" Top = 60 Width = 195 _ExtentX = 344 _ExtentY = 344 BackColor = 12632256 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Picture = "VB6DB.ctx":0333 MaskColor = -2147483633 End Begin VB.OptionButton Option2 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "decrescente" ForeColor = &H00000000& Height = 195 Left = 4440 MouseIcon = "VB6DB.ctx":045F MousePointer = 99 'Custom TabIndex = 13 TabStop = 0 'False Top = 600 Visible = 0 'False Width = 1335 End Begin VB.OptionButton Option1 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "crescente" ForeColor = &H00000000& Height = 195 Left = 3060 MouseIcon = "VB6DB.ctx":05B1 MousePointer = 99 'Custom TabIndex = 12 TabStop = 0 'False Top = 600 Visible = 0 'False Width = 1035 End Begin VB.ListBox List1 Appearance = 0 'Flat BackColor = &H00C0FFFF& Columns = 5 ForeColor = &H00FF0000& Height = 615 Left = 4800 MouseIcon = "VB6DB.ctx":0703 MousePointer = 99 'Custom TabIndex = 10 TabStop = 0 'False Top = 300 Visible = 0 'False Width = 2715 End Begin VB.TextBox Text1 BackColor = &H00C0FFFF& ForeColor = &H00FF0000& Height = 315 Left = 3060 TabIndex = 7 TabStop = 0 'False Top = 540 Visible = 0 'False Width = 1635 End Begin VB6database.axButton sdButton3 Height = 195 Left = 7140 TabIndex = 32 ToolTipText = "Chiudi e accetta la selezione" Top = 60 Width = 195 _ExtentX = 344 _ExtentY = 344 BackColor = 12632256 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Picture = "VB6DB.ctx":0855 MaskColor = -2147483633 End Begin VB.Label Label7 AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "in senso...." Height = 195 Left = 3060 TabIndex = 14 Top = 240 Visible = 0 'False Width = 765 End Begin VB.Label Label6 AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "secondo la voce" Height = 195 Left = 1380 TabIndex = 11 Top = 240 Visible = 0 'False Width = 1185 End Begin VB.Label Label5 AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Risultati ricerca..." Height = 195 Left = 4860 TabIndex = 9 Top = 60 Visible = 0 'False Width = 1215 End Begin VB.Label Label4 AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "il testo...." Height = 195 Left = 3060 TabIndex = 8 Top = 240 Visible = 0 'False Width = 630 End Begin VB.Label Label3 AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "nella voce" Height = 195 Left = 1380 TabIndex = 6 Top = 240 Visible = 0 'False Width = 735 End Begin MSForms.ComboBox ComboBox2 Height = 315 Left = 1320 TabIndex = 5 TabStop = 0 'False Top = 540 Width = 1575 BackColor = 12640511 ForeColor = 0 BorderStyle = 1 DisplayStyle = 7 MousePointer = 99 Size = "2778;556" MatchEntry = 1 ShowDropButtonWhen= 2 SpecialEffect = 0 MouseIcon = "VB6DB.ctx":0981 FontHeight = 165 FontCharSet = 0 FontPitchAndFamily= 2 End Begin VB.Label Label2 AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Funzione" Height = 195 Left = 180 TabIndex = 4 Top = 240 Width = 645 End Begin MSForms.ComboBox ComboBox1 Height = 315 Left = 120 TabIndex = 3 TabStop = 0 'False Top = 540 Width = 1095 BackColor = 12640511 ForeColor = 0 BorderStyle = 1 DisplayStyle = 7 MousePointer = 99 Size = "1931;556" MatchEntry = 1 ShowDropButtonWhen= 2 SpecialEffect = 0 FontHeight = 165 FontCharSet = 0 FontPitchAndFamily= 2 End End Begin Threed.SSPanel SSPanel1 Align = 2 'Align Bottom Height = 495 Left = 0 TabIndex = 0 Top = 3885 Width = 7620 _Version = 65536 _ExtentX = 13441 _ExtentY = 873 _StockProps = 15 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty BorderWidth = 1 BevelInner = 1 Alignment = 6 Autosize = 3 Begin VB6database.axButton sdButton1 Height = 375 Index = 0 Left = 180 TabIndex = 19 ToolTipText = "Primo" Top = 60 Width = 375 _ExtentX = 661 _ExtentY = 661 BackColor = 12632256 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Picture = "VB6DB.ctx":0AE3 MaskColor = -2147483633 ShowFlatGrey = -1 'True End Begin VB.PictureBox Picture1 Height = 0 Left = 0 ScaleHeight = 0 ScaleWidth = 0 TabIndex = 20 Top = 0 Width = 0 End Begin VB6database.axButton sdButton1 Height = 375 Index = 1 Left = 660 TabIndex = 21 ToolTipText = "Indietro" Top = 60 Width = 375 _ExtentX = 661 _ExtentY = 661 BackColor = 12632256 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Picture = "VB6DB.ctx":0BF5 MaskColor = -2147483633 ShowFlatGrey = -1 'True End Begin VB6database.axButton sdButton1 Height = 375 Index = 2 Left = 1140 TabIndex = 22 ToolTipText = "Avanti" Top = 60 Width = 375 _ExtentX = 661 _ExtentY = 661 BackColor = 12632256 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Picture = "VB6DB.ctx":0D07 MaskColor = -2147483633 ShowFlatGrey = -1 'True End Begin VB6database.axButton sdButton1 Height = 375 Index = 3 Left = 1620 TabIndex = 23 ToolTipText = "Ultimo" Top = 60 Width = 375 _ExtentX = 661 _ExtentY = 661 BackColor = 12632256 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Picture = "VB6DB.ctx":0E19 MaskColor = -2147483633 ShowFlatGrey = -1 'True End Begin VB6database.axButton sdButton1 Height = 375 Index = 4 Left = 5160 TabIndex = 24 ToolTipText = "Cerca,ordina,stampa..." Top = 60 Width = 375 _ExtentX = 661 _ExtentY = 661 BackColor = 12632256 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Picture = "VB6DB.ctx":0F2B MaskColor = -2147483633 ShowFlatGrey = -1 'True End Begin VB6database.axButton sdButton1 Height = 375 Index = 5 Left = 5640 TabIndex = 25 Top = 60 Visible = 0 'False Width = 75 _ExtentX = 661 _ExtentY = 661 BackColor = 12632256 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Picture = "VB6DB.ctx":103D MaskColor = -2147483633 ShowFlatGrey = -1 'True End Begin VB6database.axButton sdButton1 Height = 375 Index = 6 Left = 2340 TabIndex = 26 ToolTipText = "Aggiungi" Top = 60 Width = 375 _ExtentX = 661 _ExtentY = 661 BackColor = 12632256 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Picture = "VB6DB.ctx":114F MaskColor = -2147483633 ShowFlatGrey = -1 'True End Begin VB6database.axButton sdButton1 Height = 375 Index = 7 Left = 2820 TabIndex = 27 ToolTipText = "Elimina" Top = 60 Width = 375 _ExtentX = 661 _ExtentY = 661 BackColor = 12632256 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Picture = "VB6DB.ctx":1261 MaskColor = -2147483633 ShowFlatGrey = -1 'True End Begin VB6database.axButton sdButton1 Height = 375 Index = 8 Left = 3480 TabIndex = 28 ToolTipText = "Modifica" Top = 60 Width = 375 _ExtentX = 661 _ExtentY = 661 BackColor = 12632256 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Picture = "VB6DB.ctx":1373 MaskColor = -2147483633 ShowFlatGrey = -1 'True End Begin VB6database.axButton sdButton1 Height = 375 Index = 9 Left = 3960 TabIndex = 29 ToolTipText = "Salva" Top = 60 Width = 375 _ExtentX = 661 _ExtentY = 661 BackColor = 12632256 Enabled = 0 'False BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Picture = "VB6DB.ctx":1485 MaskColor = -2147483633 ShowFlatGrey = -1 'True End Begin VB6database.axButton sdButton1 Height = 375 Index = 10 Left = 4440 TabIndex = 30 ToolTipText = "Annulla" Top = 60 Width = 375 _ExtentX = 661 _ExtentY = 661 BackColor = 12632256 Enabled = 0 'False BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Picture = "VB6DB.ctx":1597 MaskColor = -2147483633 ShowFlatGrey = -1 'True End Begin VB.Line Line2 BorderColor = &H00FFFFFF& Index = 2 X1 = 3360 X2 = 3360 Y1 = 60 Y2 = 420 End Begin VB.Line Line1 BorderColor = &H00808080& Index = 2 X1 = 3300 X2 = 3300 Y1 = 60 Y2 = 420 End Begin VB.Line Line1 BorderColor = &H00808080& Index = 1 X1 = 2160 X2 = 2160 Y1 = 60 Y2 = 420 End Begin VB.Line Line2 BorderColor = &H00FFFFFF& Index = 1 X1 = 2220 X2 = 2220 Y1 = 60 Y2 = 420 End Begin VB.Line Line2 BorderColor = &H00FFFFFF& Index = 0 X1 = 5040 X2 = 5040 Y1 = 60 Y2 = 420 End Begin VB.Line Line1 BorderColor = &H00808080& Index = 0 X1 = 4980 X2 = 4980 Y1 = 60 Y2 = 420 End Begin VB.Label Label1 Alignment = 2 'Center BackStyle = 0 'Transparent Height = 255 Left = 5820 TabIndex = 1 Top = 120 Width = 1635 End End Begin Threed.SSPanel SSPanel3 Align = 1 'Align Top Height = 1095 Left = 0 TabIndex = 15 Top = 1095 Visible = 0 'False Width = 7620 _Version = 65536 _ExtentX = 13441 _ExtentY = 1931 _StockProps = 15 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty BorderWidth = 1 BevelInner = 1 Begin OACTools.OACLabel OACLabel1 Height = 195 Left = 5880 TabIndex = 18 ToolTipText = "Anteprima di stampa" Top = 600 Width = 1530 _ExtentX = 2699 _ExtentY = 344 Caption = "Stampa voci" BackColor = 12632256 ForeColor = 16711680 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "Tahoma" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty End Begin VB.ListBox List2 Appearance = 0 'Flat BackColor = &H00C0FFFF& Columns = 3 ForeColor = &H00FF0000& Height = 615 Left = 120 MouseIcon = "VB6DB.ctx":16A9 MousePointer = 99 'Custom MultiSelect = 1 'Simple TabIndex = 16 TabStop = 0 'False ToolTipText = "Per tutte le voci non occorre selezionare..." Top = 360 Width = 5535 End Begin VB6database.axButton sdButton4 Height = 195 Left = 7380 TabIndex = 33 ToolTipText = "Chiudi sezione di stampa" Top = 60 Width = 195 _ExtentX = 344 _ExtentY = 344 BackColor = 12632256 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Picture = "VB6DB.ctx":17FB MaskColor = -2147483633 End Begin VB.Label Label8 AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Seleziona le voci da stampare..." Height = 195 Left = 180 TabIndex = 17 Top = 120 Width = 2250 End End Attribute VB_Name = "VB6DB" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = True Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes" Private NomeDBase Private DB As Data Public ControlliDisattivati As Boolean 'Eventi Event BeforeMoveNext() Event AfterMoveNext() Event BeforeMovePrevious() Event AfterMovePrevious() Event BeforeMoveLast() Event AfterMoveLast() Event BeforeMoveFirst() Event AfterMoveFirst() Event AfterDelete() Event BeforeDelete() Event AfterButton(Index As Integer) Event BeforeUpdate() Event AfterUpdate() Event BeforeAdd() Event AfterAdd() Event BeforeEdit() Event AfterEdit() Public Sub TrovaDBControlli(ByVal ListB As Object) Dim iCount As Integer For iCount = 0 To UserControl.ParentControls.Count - 1 If TypeOf UserControl.ParentControls(iCount) Is Data Then ListB.AddItem TrovaNomeDB(UserControl.ParentControls(iCount)) End If Next End Sub Private Function TrovaDB(ByVal Nome As String) As Control Dim C As Integer Dim DBTrovato As Object For C = 0 To UserControl.ParentControls.Count - 1 If UCase(TrovaNomeDB(UserControl.ParentControls(C))) = UCase(Nome) Then Set DBTrovato = UserControl.ParentControls(C) Exit For End If Next Set TrovaDB = DBTrovato End Function Private Function TrovaNomeDB(ByVal Controllo As Object) As String Dim sIndex As String Dim iIndex As Integer On Local Error Resume Next iIndex = Controllo.Index If Err = 0 Then If Controllo.Index > 0 Then sIndex = "(" & iIndex & ")" End If End If TrovaNomeDB = Controllo.Name & sIndex End Function Public Property Get NomeDB() As String Attribute NomeDB.VB_ProcData.VB_Invoke_Property = "ppVB6DB" NomeDB = NomeDBase End Property Public Property Let NomeDB(ByVal NuovoNomeDB As String) NomeDBase = NuovoNomeDB PropertyChanged "NomeDB" End Property Private Sub ComboBox1_Click() Select Case ComboBox1.Text Case "Cerca" Label5.Visible = True Label7.Visible = False Label4.Visible = True List1.Visible = True Option1.Visible = False Option2.Visible = False Label3.Visible = True Label6.Visible = False Text1.Visible = True ComboBox2.Clear For i = 0 To DB.Recordset.Fields.Count - 1 ComboBox2.AddItem DB.Recordset.Fields(i).Name Next i Case "Ordina" Label5.Visible = False Label7.Visible = True Label4.Visible = False List1.Visible = False Option1.Visible = True Option2.Visible = True Label3.Visible = False Label6.Visible = True Text1.Visible = False ComboBox2.Clear For i = 0 To DB.Recordset.Fields.Count - 1 ComboBox2.AddItem DB.Recordset.Fields(i).Name Next i Case "Stampa" SSPanel2.Visible = False SSPanel3.Visible = True List2.Clear For i = 0 To DB.Recordset.Fields.Count - 1 List2.AddItem DB.Recordset.Fields(i).Name Next i DBCR.RecordSource = DB.RecordSource DBCR.Refresh End Select End Sub Private Sub List1_Click() DB.Recordset.AbsolutePosition = List1.ListIndex End Sub Private Sub OACLabel1_Click() Dim Campi As String Dim DBRecordSource As String CR.WindowState = crptMaximized Select Case List2.SelCount Case Is >= 1 Campi = "" For i = 0 To List2.ListCount - 1 If List2.Selected(i) Then Campi = Campi + "[" & List2.List(i) & "]," End If Next i Campi = Mid(Campi, 1, Len(Campi) - 1) Case Is = 0 Campi = "*" End Select If UCase(Mid(DB.RecordSource, 1, 6)) = "SELECT" Then pos1 = InStr(1, UCase(DB.RecordSource), "FROM") pos2 = InStr(pos1, UCase(DB.RecordSource), "[") pos3 = InStr(pos2, UCase(DB.RecordSource), "]") DBRecordSource = Mid(DB.RecordSource, pos2 + 1, pos3 - pos2 - 1) DBRecordSource = DB.RecordSource End If DBCR.RecordSource = "select " & Campi & " from " & "[" & DBRecordSource & "]" DBCR.Refresh CR.Action = 1 End Sub Private Sub Option1_Click() If ComboBox2.Text <> "" Then DB.Recordset.Sort = "[" & ComboBox2.Text & "]" Set DB.Recordset = DB.Recordset.OpenRecordset End If End Sub Private Sub Option2_Click() If ComboBox2.Text <> "" Then DB.Recordset.Sort = "[" & ComboBox2.Text & "]" & " DESC" Set DB.Recordset = DB.Recordset.OpenRecordset End If End Sub Private Sub sdButton2_Click() For i = 0 To 8 sdButton1(i).Enabled = True Next i SSPanel2.Visible = False DB.Refresh List1.Clear ComboBox2.Clear Text1.Text = "" End Sub Private Sub sdButton3_Click() For i = 0 To 8 sdButton1(i).Enabled = True Next i SSPanel2.Visible = False End Sub Private Sub sdButton4_Click() ComboBox1.Text = "Cerca" SSPanel2.Visible = True SSPanel3.Visible = False DBCR.RecordSource = DB.RecordSource DBCR.Refresh End Sub Private Sub Text1_Change() On Error Resume Next If ComboBox2.Text <> "" Then DB.Refresh DB.Recordset.Filter = "[" & ComboBox2.Text & "]" + " like '*" + Text1.Text + "*'" Set DB.Recordset = DB.Recordset.OpenRecordset List1.Clear Do While Not DB.Recordset.EOF List1.AddItem "n " & Str(DB.Recordset.AbsolutePosition + 1) DB.Recordset.MoveNext Loop DB.Recordset.AbsolutePosition = 0 End If End Sub Private Sub UserControl_ReadProperties(PropBag As PropertyBag) NomeDBase = PropBag.ReadProperty("NomeDB", "") End Sub Private Sub UserControl_Resize() UserControl.Height = 1605 UserControl.Width = 7620 End Sub Private Sub sdButton1_Click(Index As Integer) On Error GoTo errore Label1.Caption = "" 'scorrimento / elimina / modifica If DB.Recordset.RecordCount <> 0 Then Select Case Index Case 0 'primo If DB.Recordset.EditMode <> dbEditNone Then DB.UpdateRecord End If RaiseEvent BeforeMoveFirst 'If Not ControlliDisattivati Then Call DisattivaDBControlli DB.Recordset.MoveFirst Label1.Caption = "Inizio archivio" Beep RaiseEvent AfterMoveFirst For i = 9 To 10 sdButton1(i).Enabled = False Next i Case 1 'precedente If DB.Recordset.EditMode <> dbEditNone Then DB.UpdateRecord End If RaiseEvent BeforeMovePrevious 'If Not ControlliDisattivati Then Call DisattivaDBControlli DB.Recordset.MovePrevious Label1.Caption = "Voce n " & Str(DB.Recordset.AbsolutePosition + 1) If DB.Recordset.BOF Then Label1.Caption = "Inizio archivio" DB.Recordset.MoveNext Beep End If RaiseEvent AfterMovePrevious For i = 9 To 10 sdButton1(i).Enabled = False Next i Case 2 'seguente If DB.Recordset.EditMode <> dbEditNone Then DB.UpdateRecord End If RaiseEvent BeforeMoveNext 'If Not ControlliDisattivati Then Call DisattivaDBControlli DB.Recordset.MoveNext Label1.Caption = "Voce n " & Str(DB.Recordset.AbsolutePosition + 1) If DB.Recordset.EOF Then Label1.Caption = "Fine archivio" DB.Recordset.MovePrevious Beep End If RaiseEvent AfterMoveNext For i = 9 To 10 sdButton1(i).Enabled = False Next i Case 3 'ultimo If DB.Recordset.EditMode <> dbEditNone Then DB.UpdateRecord End If RaiseEvent BeforeMoveLast 'If Not ControlliDisattivati Then Call DisattivaDBControlli DB.Recordset.MoveLast Label1.Caption = "Fine archivio" Beep RaiseEvent AfterMoveLast For i = 9 To 10 sdButton1(i).Enabled = False Next i Case 7 'elimina If DB.Recordset.EditMode <> dbEditNone Then DB.UpdateRecord End If RaiseEvent BeforeDelete 'If Not ControlliDisattivati Then Call DisattivaDBControlli Label1.Caption = "Eliminazione voce" risposta = MsgBox("Sei sicuro di eliminare la voce n " & Str(DB.Recordset.AbsolutePosition + 1), vbYesNo, "Attenzione...!!") If risposta = vbYes Then DB.Recordset.Delete DB.Refresh Label1.Caption = "Voce eliminata" RaiseEvent AfterDelete Else Label1.Caption = "" End If For i = 9 To 10 sdButton1(i).Enabled = False Next i Case 8 'modifica If DB.Recordset.EditMode <> dbEditNone Then DB.UpdateRecord End If RaiseEvent BeforeEdit 'If ControlliDisattivati Then Call AttivaDBControlli Label1.Caption = "Modifica voce" For i = 0 To 7 sdButton1(i).Enabled = False Next i For i = 9 To 10 sdButton1(i).Enabled = True Next i DB.Recordset.Edit RaiseEvent AfterEdit Case 9 'salva RaiseEvent BeforeUpdate 'If Not ControlliDisattivati Then Call DisattivaDBControlli Label1.Caption = "Modifica effettuata" For i = 0 To 7 sdButton1(i).Enabled = True Next i For i = 9 To 10 sdButton1(i).Enabled = False Next i DB.UpdateRecord RaiseEvent AfterUpdate Case 10 'annulla 'If Not ControlliDisattivati Then Call DisattivaDBControlli Label1.Caption = "Modifica annullata" For i = 0 To 7 sdButton1(i).Enabled = True Next i For i = 9 To 10 sdButton1(i).Enabled = False Next i DB.Recordset.CancelUpdate Case 4 'funzioni speciali If DB.Recordset.EditMode <> dbEditNone Then DB.UpdateRecord End If SSPanel2.Visible = True ComboBox1.Clear ComboBox1.AddItem "Cerca" ComboBox1.AddItem "Ordina" ComboBox1.AddItem "Stampa" For i = 0 To 10 sdButton1(i).Enabled = False Next i End Select 'nessun record Label1.Caption = "Nessuna voce" Beep End If 'aggiungi Select Case Index Case 6 'aggiungi DB.UpdateRecord 'If ControlliDisattivati Then Call AttivaDBControlli RaiseEvent BeforeAdd DB.Recordset.AddNew RaiseEvent BeforeUpdate DB.UpdateRecord DB.Recordset.Bookmark = DB.Recordset.LastModified Label1.Caption = "Nuova voce" 'RaiseEvent AfterUpdate RaiseEvent AfterAdd For i = 9 To 10 sdButton1(i).Enabled = True Next i End Select RaiseEvent AfterButton(Index) Exit Sub errore: Select Case Err Case 91 MsgBox "Fonte dati DB non connessa o con errori.... Assicurarsi di avere caricato un controllo DataBase , di avere impostato il percorso quindi la sorgente dati. Alla fine assegnare alla propriet NomeDB il controllo DataBase selezionandolo dalla lista generata in modo automatico!!", vbCritical, "Fonte DB non connessa..." Case Else MsgBox "Il database utilizzato presenta indici o voci che non possono essere nulli.... Analizzare il database e i campi correlati!!", vbCritical, "Errore indici correlati" End Select End Sub Private Sub UserControl_Show() On Error GoTo esci Set DB = TrovaDB(NomeDBase) 'Call DisattivaDBControlli If DB.Recordset.RecordCount <> 0 Then Label1.Caption = "Voce n Label1.Caption = "Archivio vuoto" End If 'Crystal Report DBCR.DatabaseName = DB.DatabaseName Exit Sub esci: End Sub Private Sub UserControl_WriteProperties(PropBag As PropertyBag) PropBag.WriteProperty "NomeDB", NomeDBase, "" End Sub Public Sub LeggiDB(ByVal Nome As String, ByVal Txt As Object, ByVal Txt1 As Object) Dim iC As Integer Dim iDBTrovato As Object For iC = 0 To UserControl.ParentControls.Count - 1 If UCase(TrovaNomeDB(UserControl.ParentControls(iC))) = UCase(Nome) Then Set iDBTrovato = UserControl.ParentControls(iC) Exit For End If Next Txt.Text = iDBTrovato.DatabaseName Txt1.Text = iDBTrovato.RecordSource End Sub Public Sub DisattivaDBControlli() On Error Resume Next ControlliDisattivati = True For i = 9 To 10 sdButton1(i).Enabled = False Next i Dim iCount As Integer For iCount = 0 To UserControl.ParentControls.Count - 1 If TypeOf UserControl.ParentControls(iCount) Is TextBox Then UserControl.ParentControls(iCount).Locked = True End If If TypeOf UserControl.ParentControls(iCount) Is ListBox Then UserControl.ParentControls(iCount).Enabled = False End If If TypeOf UserControl.ParentControls(iCount) Is OACLabel Then UserControl.ParentControls(iCount).Enabled = False End If If TypeOf UserControl.ParentControls(iCount) Is CheckBox Then UserControl.ParentControls(iCount).Enabled = False End If If TypeOf UserControl.ParentControls(iCount) Is SSCheck Then UserControl.ParentControls(iCount).Enabled = False End If If TypeOf UserControl.ParentControls(iCount) Is OptionButton Then UserControl.ParentControls(iCount).Enabled = False End If If TypeOf UserControl.ParentControls(iCount) Is SSOption Then UserControl.ParentControls(iCount).Enabled = False End If If TypeOf UserControl.ParentControls(iCount) Is ComboBox Then UserControl.ParentControls(iCount).Locked = True End If If TypeOf UserControl.ParentControls(iCount) Is DBCombo Then UserControl.ParentControls(iCount).Locked = True End If If TypeOf UserControl.ParentControls(iCount) Is DBGrid Then UserControl.ParentControls(iCount).Splits(0).Locked = True End If If TypeOf UserControl.ParentControls(iCount) Is DBList Then UserControl.ParentControls(iCount).Locked = True End If Next End Sub Public Sub AttivaDBControlli() On Error Resume Next ControlliDisattivati = False Dim iCount As Integer For iCount = 0 To UserControl.ParentControls.Count - 1 If TypeOf UserControl.ParentControls(iCount) Is TextBox Then UserControl.ParentControls(iCount).Locked = False End If If TypeOf UserControl.ParentControls(iCount) Is ListBox Then UserControl.ParentControls(iCount).Enabled = True End If If TypeOf UserControl.ParentControls(iCount) Is OACLabel Then UserControl.ParentControls(iCount).Enabled = True End If If TypeOf UserControl.ParentControls(iCount) Is CheckBox Then UserControl.ParentControls(iCount).Enabled = True End If If TypeOf UserControl.ParentControls(iCount) Is SSCheck Then UserControl.ParentControls(iCount).Enabled = True End If If TypeOf UserControl.ParentControls(iCount) Is OptionButton Then UserControl.ParentControls(iCount).Enabled = True End If If TypeOf UserControl.ParentControls(iCount) Is SSOption Then UserControl.ParentControls(iCount).Enabled = True End If If TypeOf UserControl.ParentControls(iCount) Is ComboBox Then UserControl.ParentControls(iCount).Locked = False End If If TypeOf UserControl.ParentControls(iCount) Is DBCombo Then UserControl.ParentControls(iCount).Locked = False End If If TypeOf UserControl.ParentControls(iCount) Is DBGrid Then UserControl.ParentControls(iCount).Splits(0).Locked = False End If If TypeOf UserControl.ParentControls(iCount) Is DBList Then UserControl.ParentControls(iCount).Locked = False End If Next End Sub