Windows编程

开发平台：
Visual C++

IMAGE.FRM：源码内容
							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
End
Sub About_Menu_Click ()
    About_Form.Show 1
End Sub
Function CheckForImageTable () As Integer
Rem
Rem Check to see if sample table exits
Rem If it's not there, then see if they want to create it
Rem
    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
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.
Rem
    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
Rem Change the primary window title to show the database name
Rem Clear the image control
Rem
    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
Rem This routine will insert the image from the file into the database
Rem
    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
Rem This routine inserts an image into the SQL Server
Rem Insert new row with title and image token data
Rem
    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
Rem This routine reads an image from the SQL Server
Rem Get length of bitmap image in image column
Rem
    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
Rem Clear the picture
Rem
    Image_Control.Picture = LoadPicture()
End Sub
Sub Titles_List_DblClick ()
Rem
Rem Get the image image selected from the server
Rem Display the image
Rem
    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

						