Tricks of the Windows Gam…ming Gurus (2nd Edition)/Disc2.iso/msdn_vcb/samples/vc98/sdk/dbmsg/sql/vbsql/image.frm

Visual Basic Form | 1996-04-03 | 15.5 KB | 480 lines

VERSION 2.00
Begin Form PrimaryWindow
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Image"
   ControlBox      =   0   'False
   ForeColor       =   &H00000000&
   Height          =   7035
   Icon            =   IMAGE.FRX:0000
   Left            =   615
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   6345
   ScaleWidth      =   6990
   Top             =   75
   Width           =   7110
   Begin PictureBox Image_Control
      Height          =   3495
      Left            =   120
      ScaleHeight     =   3465
      ScaleWidth      =   6705
      TabIndex        =   12
      Top             =   2760
      Width           =   6735
   End
   Begin VBSQL VBSQL1
      Caption         =   "SQL Err/Msg"
      Height          =   272
      Left            =   4800
      Top             =   2505
      Visible         =   0   'False
      Width           =   2055
   End
   Begin ListBox Titles_List
      Height          =   810
      Left            =   135
      TabIndex        =   8
      Top             =   1440
      Width           =   2055
   End
   Begin DirListBox Dir_Tree_Combo
      Height          =   1275
      Left            =   2520
      TabIndex        =   4
      Top             =   1170
      Width           =   2055
   End
   Begin FileListBox Image_File_List
      Height          =   1590
      Left            =   4800
      Pattern         =   "*.bmp"
      TabIndex        =   5
      Top             =   855
      Width           =   2055
   End
   Begin DriveListBox Drive_Combo
      Height          =   357
      Left            =   2528
      TabIndex        =   3
      Top             =   833
      Width           =   2048
   End
   Begin ListBox Database_List
      Height          =   420
      Left            =   135
      TabIndex        =   10
      Top             =   360
      Width           =   2055
   End
   Begin TextBox Title_Edit
      Height          =   323
      Left            =   3855
      TabIndex        =   1
      Top             =   75
      Width           =   3000
   End
   Begin Label Label5
      BackColor       =   &H00C0C0C0&
      Caption         =   "Image in database:"
      Height          =   225
      Left            =   120
      TabIndex        =   11
      Top             =   2520
      Width           =   2055
   End
   Begin Label Label4
      BackColor       =   &H00C0C0C0&
      Caption         =   "Titles in database:"
      Height          =   225
      Left            =   120
      TabIndex        =   9
      Top             =   1200
      Width           =   2055
   End
   Begin Label Image_File_Label
      BackColor       =   &H00C0C0C0&
      Caption         =   "(none)"
      Height          =   255
      Left            =   3000
      TabIndex        =   7
      Top             =   500
      Width           =   3840
   End
   Begin Label Label3
      BackColor       =   &H00C0C0C0&
      Caption         =   "File:"
      Height          =   255
      Left            =   2520
      TabIndex        =   6
      Top             =   500
      Width           =   375
   End
   Begin Label Label2
      BackColor       =   &H00C0C0C0&
      Caption         =   "Image file title:"
      ForeColor       =   &H00000000&
      Height          =   225
      Left            =   2520
      TabIndex        =   2
      Top             =   120
      Width           =   1335
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Databases:"
      Height          =   210
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   2085
   End
   Begin Menu Menu_File
      Caption         =   "&File"
      Begin Menu Logon_Selection
         Caption         =   "&Logon"
      End
      Begin Menu Log_Off_Selection
         Caption         =   "Log &Off"
      End
      Begin Menu Exit_Selection
         Caption         =   "&Exit"
      End
   End
   Begin Menu Options_Menu
      Caption         =   "&Options"
      Begin Menu View_Selection
         Caption         =   "&View Image"
      End
      Begin Menu Insert_Selection
         Caption         =   "&Insert Image"
      End
      Begin Menu Delete_Selection
         Caption         =   "&Delete Image"
      End
   End
   Begin Menu About_Menu
      Caption         =   "&About"
   End
Sub About_Menu_Click ()
    About_Form.Show 1
End Sub
Function CheckForImageTable () As Integer
Rem Check to see if sample table exits
Rem If it's not there, then see if they want to create it
    Results% = ExecuteSQLCommand("Select count(*) from sysobjects where name = 'image_table'")
    Do While (SqlResults%(SqlConn%) <> NOMORERESULTS)
    Do While (SqlNextRow(SqlConn%) <> NOMOREROWS)
        Table_Found$ = Sqldata(SqlConn%, 1)
    Loop
    Loop
    If Val(Table_Found$) = 0 Then
    Results% = MsgBox("Text table not found in " + Database$ + " database." + Chr$(13) + Chr$(10) + "Do you wish to create the table?", 52)
    If Results% = 7 Then
        CheckForImageTable = FAIL
        Exit Function
    Else
        Cmd$ = "create table image_table (title varchar(30) not null, image_col image null)"
        Results% = SqlCmd(SqlConn%, Cmd$)
        Results% = SqlExec(SqlConn%)
        Do While (SqlResults%(SqlConn%) <> NOMORERESULTS)
        Do While (SqlNextRow(SqlConn%) <> NOMOREROWS)
        Loop
        Loop
        CheckForImageTable = SUCCEED
    End If
    Else
    CheckForImageTable = SUCCEED
    End If
End Function
Sub ClearImageTitles ()
    Rem Clear all text titles out of list box
    Do While Titles_List.ListCount
    Titles_List.RemoveItem 0
    Loop
End Sub
Sub Database_List_Click ()
Rem This procedure gets the chosen database.
Rem Checks to see if the image table is there
Rem If it's not, then clear the images field, and disable other fields
Rem If it is, then get the list of images, display the list and enable other fields.
    DatabaseSelection$ = Database_List.Text
    Results% = SqlUse(SqlConn%, DatabaseSelection$)
    Results% = CheckForImageTable()
    If Results% = SUCCEED Then
    PrimaryWindow.MousePointer = 11
    RetrieveImageTitles
    View_Selection.Enabled = True
    Insert_Selection.Enabled = True
    Delete_Selection.Enabled = True
    PrimaryWindow.MousePointer = 0
    Else
    ClearImageTitles
    View_Selection.Enabled = False
    Insert_Selection.Enabled = False
    Delete_Selection.Enabled = False
    End If
Rem Change the primary window title to show the database name
Rem Clear the image control
    DatabaseName$ = SQLName(SqlConn%)
    ChangePrimaryWindowCaption
    Image_Control.Picture = LoadPicture()
End Sub
Sub Delete_Selection_Click ()
    Image_Title$ = Titles_List.Text
    If Image_Title$ = "" Then
    Beep
    MsgBox "You must first select a title."
    Else
    Response% = MsgBox("Delete " + Image_Title$ + "?", 49)
    If Response% = 1 Then
        PrimaryWindow.MousePointer = 11
        Results% = ExecuteSQLCommand("Delete from image_table where title = '" + Image_Title$ + "'")
        Results% = SqlResults%(SqlConn%)
        Do While (SqlNextRow(SqlConn%) <> NOMOREROWS)
        Loop
        Image_Control.Picture = LoadPicture()
        RetrieveImageTitles
        PrimaryWindow.MousePointer = 0
    Else
        MsgBox "Delete aborted."
    End If
    End If
End Sub
Sub Dir_Tree_Combo_Change ()
    Image_File_Label.Caption = "(none)"
    Image_File_List.Path = Dir_Tree_Combo.Path
End Sub
Sub Drive_Combo_Change ()
    Image_File_Label.Caption = "(none)"
    Dir_Tree_Combo.Path = Drive_Combo.Drive
End Sub
Sub Exit_Selection_Click ()
    ExitApplication
    End
End Sub
Sub Form_Load ()
   Temp_Image_File = "c:\image.tmp"
    PrimaryWindowTitle = "Image Example"
    ChangePrimaryWindowCaption
    InitializeApplication
    MsgBox DBLIB_VERSION$
    Logon_Selection.Enabled = True
    Log_Off_Selection.Enabled = False
    Exit_Selection.Enabled = True
    View_Selection.Enabled = False
    Insert_Selection.Enabled = False
    Delete_Selection.Enabled = False
End Sub
Sub Image_File_List_Click ()
    If Right$(Dir_Tree_Combo.Path, 1) = "\" Then
    Image_File_Label.Caption = Dir_Tree_Combo.Path + Image_File_List.FileName
    Else
    Image_File_Label.Caption = Dir_Tree_Combo.Path + "\" + Image_File_List.FileName
    End If
End Sub
Sub Insert_Selection_Click ()
Rem This routine will insert the image from the file into the database
    Image_File$ = Image_File_Label.Caption
    Title$ = Title_Edit.Text
    Title$ = PrepareString(Title$)
    If Image_File$ = "(none)" Then
    Beep
    MsgBox "Please select a bitmap to insert."
    ElseIf Title$ = "" Then
    Beep
    MsgBox "Please enter a title for the bitmap you wish to insert."
    Else
    PrimaryWindow.MousePointer = 11
    InsertImage Title$, Image_File$
    Title_Edit.Text = ""
    Image_File_List.ListIndex = -1
    Image_File_Label.Caption = ""
    RetrieveImageTitles
    PrimaryWindow.MousePointer = 0
    End If
End Sub
Sub InsertImage (Title As String, Bitmap_File As String)
Rem This routine inserts an image into the SQL Server
Rem Insert new row with title and image token data
    Results% = ExecuteSQLCommand("Insert into image_table values ('" + Title + "',0x80)")
    Do While SqlResults(SqlConn%) <> NOMORERESULTS%
    Do While SqlNextRow(SqlConn%) <> NOMOREROWS%
    Loop
    Loop
Rem Get identifier for image column in current row
    Results% = ExecuteSQLCommand("select image_col from image_table where title = '" + Title + "'")
    Do While SqlResults(SqlConn%) <> NOMORERESULTS%
    Do While SqlNextRow(SqlConn%) <> NOMOREROWS%
        SqlPointer$ = SqlTxPtr(SqlConn%, 1)
        SqlTimestamp$ = SqlTxTimeStamp(SqlConn%, 1)
    Loop
    Loop
Rem Open bitmap file to load into SQL Server table
    Open Bitmap_File For Binary As #1
    FileLength& = LOF(1)
Rem Begin inserting bitmap into image column in DatePartLimit& size chunks
    Table$ = "image_table.image_col"
    DataPartLimit& = 4096
    DataPartSize& = 0
    If SqlWriteText(SqlConn%, Table$, SqlPointer$, SQLTXPLEN%, SqlTimestamp$, 1, FileLength&, "") <> FAIL% Then
    If SqlOk(SqlConn%) <> FAIL% Then
        Results% = SqlResults(SqlConn%)
        Done% = False
        Do While Not Done%
        DataPart$ = Input$(DataPartLimit&, 1)
        DataPartSize& = DataPartSize& + Len(DataPart$)
        Results% = SqlMoreText%(SqlConn%, Len(DataPart$), DataPart$)
        If DataPartSize& = FileLength& Then
            Done% = True
        End If
        Loop
        If SqlOk(SqlConn%) <> FAIL% Then
        If SqlResults(SqlConn%) <> FAIL% Then
            MsgBox "Image inserted."
        End If
        End If
    End If
    End If
Close 1
End Sub
Sub LoadImage (Title As String)
Rem This routine reads an image from the SQL Server
Rem Get length of bitmap image in image column
    Results% = ExecuteSQLCommand("select datalength(image_col) from image_table where title = '" + Title + "'")
    Do While SqlResults(SqlConn%) <> NOMORERESULTS
    Do While SqlNextRow(SqlConn%) <> NOMOREROWS
        ImageLen& = Val(Sqldata(SqlConn%, 1))
    Loop
    Loop
    Offset& = 0
Rem Set LoadSizeLimit to 8K
    LoadSizeLimit& = 4096
    If LoadSizeLimit& > ImageLen& Then
    LoadSizeLimit& = ImageLen&
    End If
    LoadSize& = LoadSizeLimit&
Rem Set size of image returned to LoadSizeLimit&
    Results% = ExecuteSQLCommand("set textsize " + Str$(LoadSizeLimit&))
    Do While SqlResults(SqlConn%) <> NOMORERESULTS
    Do While SqlNextRow(SqlConn%) <> NOMOREROWS
    Loop
    Loop
Rem Begin reading image column in LoadSizeLimit& size chunks
    Cmd$ = "Declare @val varbinary(30)"
    Results% = SqlCmd(SqlConn%, Cmd$)
    Cmd$ = "Select @val = textptr(image_col) from image_table where title = '" + Title + "'"
    Results% = SqlCmd(SqlConn%, Cmd$)
    Table$ = "image_table.image_col"
    Done% = False
    Do While Not Done%
    Cmd$ = "READTEXT " + Table$ + " @val " + Str$(Offset&) + " " + Str$(LoadSize&)
    Results% = SqlCmd(SqlConn%, Cmd$)
    If Offset& + LoadSize& = ImageLen& Then
        Done% = True
    Else
        Offset& = Offset& + LoadSizeLimit&
        If Offset& + LoadSizeLimit& > ImageLen& Then
        LoadSize& = ImageLen& - Offset&
        End If
    End If
    Loop
Rem Retrieve image data in result rows and write to temporary bitmap file
    If SqlExec(SqlConn%) <> FAIL% Then
    Open Temp_Image_File For Binary As #1
    filepos& = 1
    Do While SqlResults(SqlConn%) <> NOMORERESULTS
        Do While SqlNextRow(SqlConn%) <> NOMOREROWS
        in$ = Sqldata(SqlConn%, 1)
        Put 1, filepos&, in$
        filepos& = filepos& + Len(in$)
        Loop
    Loop
    Close 1
    End If
End Sub
Sub Log_Off_Selection_Click ()
    Logoff
    Logon_Selection.Enabled = True
    Log_Off_Selection.Enabled = False
    Exit_Selection.Enabled = True
    View_Selection.Enabled = False
    Insert_Selection.Enabled = False
    Delete_Selection.Enabled = False
End Sub
Sub Logon_Selection_Click ()
    Login.Show 1
    PrimaryWindow.MousePointer = 11
    If CheckServerConnection() = 1 Then
    Results% = GetDatabases(Database_List)
    ChangePrimaryWindowCaption
    Logon_Selection.Enabled = False
    Log_Off_Selection.Enabled = True
    End If
    PrimaryWindow.MousePointer = 0
End Sub
Function PrepareString (String_In As String) As String
    String_Out$ = ""
    For I% = 1 To Len(String_In)
    If Mid$(String_In, I%, 1) = Chr$(39) Then
        String_Out$ = String_Out$ + Chr$(39) + Chr$(39)
    Else
        String_Out$ = String_Out$ + Mid$(String_In, I%, 1)
    End If
    Next
    PrepareString = String_Out$
End Function
Sub RetrieveImageTitles ()
    ClearImageTitles
    Rem Retrieve text titles from SQL Server into list box
    Results% = ExecuteSQLCommand("Select title from image_table")
    Do While (SqlResults%(SqlConn%) <> NOMORERESULTS)
    Do While (SqlNextRow(SqlConn%) <> NOMOREROWS)
        Titles_List.AddItem Sqldata(SqlConn%, 1)
    Loop
    Loop
End Sub
Sub Title_Edit_KeyPress (KeyAscii As Integer)
    If Len(Title_Edit.Text) = 30 Then
    If KeyAscii <> 8 Then
        KeyAscii = 0
    End If
    End If
End Sub
Sub Titles_List_Click ()
Rem Clear the picture
    Image_Control.Picture = LoadPicture()
End Sub
Sub Titles_List_DblClick ()
Rem Get the image image selected from the server
Rem Display the image
    Image_Title$ = Titles_List.Text
    PrimaryWindow.MousePointer = 11
    LoadImage Image_Title$
    Image_Control.Picture = LoadPicture(Temp_Image_File)
    PrimaryWindow.MousePointer = 0
End Sub
Sub VBSQL1_Error (SqlConn As Integer, Severity As Integer, ErrorNum As Integer, ErrorStr As String, RetCode As Integer)
' Call the required VBSQL error-handling function
' OSErr and OSErrStr not used in VBSQL for Windows, but DOS interprets
' anything other than -1 as an OS error
    OsErr% = -1
    RetCode% = UserSqlErrorHandler%(SqlConn, Severity%, ErrorNum%, OsErr%, ErrorStr$, OsErrStr$)
End Sub
Sub VBSQL1_Message (SqlConn As Integer, Message As Long, State As Integer, Severity As Integer, MsgStr As String)
    UserSqlMsgHandler SqlConn, Message&, State%, Severity%, MsgStr$
End Sub
Sub View_Selection_Click ()
    Image_Title$ = Titles_List.Text
    If Image_Title$ = "" Then
    Beep
    MsgBox "You must first select a title."
    Else
    PrimaryWindow.MousePointer = 11
    LoadImage Image_Title$
    Image_Control.Picture = LoadPicture(Temp_Image_File)
    PrimaryWindow.MousePointer = 0
    End If
End Sub