Курсовая работа: Создание базы данных

3092

3093 s$ = SelectForm. SelectDlg(QRDBIndex, "Выберите изменяемое поле", sCol)

3094 If (s = "-1") Then Exit Function

3095 Select Case what

3096 Case sType ' Изменение типа поля

3097 Generate_Change = sChange + sType + "(" + s + ")"

3098 Case sName ' Изменение названия столбца

3099 Name$ = InputForm. InputVal("Введите новое название поля")

3100 If (Name = "") Then Exit Function

3101 Generate_Change = sChange + sName + "(" + s + ", " + Name + ")"

3102 End Select

3103End Function

3104

3105Sub ErrorInQuery()

3106 Call MsgForm. ErrorMsg("Ошибка в запросе! ")

3107End Sub

3108

3109Function TestZero(i%)

3110 If (i = 0) Then

3111 Call ErrorInQuery

3112 TestZero = True

3113 Else

3114 TestZero = False

3115 End If

3116End Function

3117

3118Sub AddRun(what$, str$)

3119 Select Case what

3120 Case sCol

3121 ' заголовок

3122 p% = InStr(1, str, ",")

3123 If TestZero(p) Then Exit Sub

3124 title$ = Trim(Left(str, p - 1))

3125 str = Mid(str, p + 1)

3126 ' тип

3127 p = InStr(1, str, ",")

3128 If TestZero(p) Then Exit Sub

3129 ColType$ = Trim(Left(str, p - 1))

3130 str = Mid(str, p + 1)

3131

3132 ' начальное значение

3133 p = InStr(1, str, ",")

3134 If TestZero(p) Then Exit Sub

3135 StValStr$ = Trim(Left(str, p - 1))

3136 str = Mid(str, p + 1)

3137

3138 ' позиция

3139 ColPosStr$ = str

3140 If (Not IsNumeric(ColPosStr)) Then

3141 Call ErrorInQuery

3142 Exit Sub

3143 End If

3144 ColPos% = CInt(ColPosStr)

3145

3146 If ItColAlreadyCreate(QRDBIndex, title) Then

3147 Call MsgForm. ErrorMsg("Добавляемое поле уже существует! ")

3148 Exit Sub

3149 End If

3150

3151 ' в зависимости от типа определяю значение

3152 Select Case ColType

3153 Case sI

3154 If (Not IsInteger(StValStr)) Then

3155 Call ErrorInQuery

3156 Exit Sub

3157 End If

3158 stval = CInt(StValStr)

3159 Call AddCol(QRDBIndex, ccInteger, title, stval, ColPos)

3160 Case sS

3161 stval = CStr(StValStr)

3162 Call AddCol(QRDBIndex, ccString, title, stval, ColPos)

3163 Case Default

3164 Call ErrorInQuery

3165 Exit Sub

3166 End Select

3167

3168 Case sRow

3169 If (DB(QRDBIndex). Header. ColCount > 0) Then

3170 Dim row() As Variant

3171 ReDim row(DB(QRDBIndex). Header. ColCount - 1)

3172 For i = 0 To DB(QRDBIndex). Header. ColCount - 1

3173 row(i) = DB(QRDBIndex). Cols(i). DefValue

3174 Next i

3175 If (Not FindRow(QRDBIndex, row)) Then

3176 Call AddField(QRDBIndex, row)

3177 Else

3178 Call MsgForm. ErrorMsg("Добавляемый столбец дублируется! ")

3179 End If

3180 Else

3181 Call MsgForm. ErrorMsg("Нельзя добавлять записи в БД без полей! ")

3182 End If

3183 End Select

3184

3185End Sub

3186

3187Sub DelRun(what$, str$)

3188 p% = InStr(1, str, ",")

3189 If TestZero(p) Then Exit Sub

3190 IndexStr$ = Trim(Left(str, p - 1))

3191 If (Not IsInteger(IndexStr)) Then

3192 Call ErrorInQuery

3193 Exit Sub

3194 End If

3195 Index% = CInt(IndexStr)

3196 str = Mid(str, p + 1)

3197 ConfirmStr$ = Trim(str)

3198 Dim Confirm As Boolean

3199 Select Case ConfirmStr

3200 Case sYes

3201 Confirm = True

3202 Case sNo

3203 Confirm = False

3204 Case Default

3205 Call ErrorInQuery

3206 Exit Sub

3207 End Select

3208

3209 Select Case what

3210 Case sCol

3211 If (DB(QRDBIndex). Header. ColCount > 0) Then

3212 Call DelCol_(QRDBIndex, Index, Confirm)

3213 Else

3214 Call MsgForm. ErrorMsg("В БД нет полей! ")

3215 Exit Sub

3216 End If

3217 Case sRow

3218 If (DB(QRDBIndex). Header. RowCount > 0) Then

3219 Call DelRow_(QRDBIndex, Index, Confirm)

3220 Else

3221 Call MsgForm. ErrorMsg("В БД нет записей! ")

3222 Exit Sub

3223 End If

3224 End Select

3225End Sub

3226

3227Sub SortRun(str$)

3228 If (DB(QRDBIndex). Header. ColCount = 0) Or (DB(QRDBIndex). Header. RowCount = 0) Then

3229 Call MsgForm. ErrorMsg("Нечего сортировать! ")

3230 Exit Sub

3231 End If

3232

3233 p% = InStr(1, str, ",")

3234 If TestZero(p) Then Exit Sub

3235 what$ = Trim(Left(str, p - 1))

3236

3237 If (Not IsInteger(what)) Then

3238 Call ErrorInQuery

3239 Exit Sub

3240 End If

3241

3242 whatint% = CInt(what)

3243

3244 If (whatint < 0) Or (whatint > DB(QRDBIndex). Header. ColCount - 1) Then

3245 Call ErrorInQuery

3246 Exit Sub

3247 End If

3248

3249 Mode$ = Trim(Mid(str, p + 1))

3250

3251 Select Case Mode

3252 Case sAZ

3253 s$ = "А->Я"

3254 Case sZA

3255 s$ = "Я->А"

3256 Case Default

3257 Call ErrorInQuery

3258 Exit Sub

3259 End Select

3260

3261 Count% = MainForm. TabStrip. Tabs. Count

3262 ReDim Preserve DB(Count)

3263

3264 DB(Count) = DB(QRDBIndex)

3265

3266 MainForm. TabStrip. Tabs. Add pvCaption: =s, pvImage: =1

3267

3268 Dim find As Boolean, needswap As Boolean

3269 Dim tmp As TDBElem

3270 With DB(Count)

3271 Do

3272 find = False

3273 For R% = 1 To. Header. RowCount - 1

3274 If (Mode = sZA) Then

3275 needswap = (. Rows(R). Fields(whatint) >. Rows(R - 1). Fields(whatint))

3276 Else

3277 needswap = (. Rows(R). Fields(whatint) <. Rows(R - 1). Fields(whatint))

3278 End If

3279 If (needswap) Then

3280 tmp =. Rows(R)

3281. Rows(R) =. Rows(R - 1)

3282. Rows(R - 1) = tmp

3283 find = True

3284 End If

3285 Next R

3286 Loop While (find)

3287 End With

3288End Sub

3289

3290Function Equal(ByVal col%, ByVal row%, ByVal cmpstr$) As Long

3291 If (DB(QRDBIndex). Cols(col). Class = ccInteger) Then

3292 Rval = CLng(DB(QRDBIndex). Rows(row). Fields(col))

3293 Equal = (Rval - CLng(cmpstr))

3294 Else

3295 Rval = CStr(DB(QRDBIndex). Rows(row). Fields(col))

3296 If (Rval = cmpstr) Then

3297 Equal = 0

3298 Else

3299 If (Rval > cmpstr) Then

3300 Equal = 1

3301 Else

3302 Equal = - 1

3303 End If

3304 End If

3305 End If

3306End Function

3307

3308Function CalcCount(Index%, c%, value$) As Integer

3309 Count% = 0

3310 For i% = 0 To (DB(Index). Header. RowCount - 1)

3311 If (CStr(DB(Index). Rows(i). Fields(c)) = value) Then Count = Count + 1

3312 Next i

3313 CalcCount = Count

3314End Function

3315

3316Function EarlierDontFind(Index%, c%, R%, value$) As Boolean

3317 For i% = 0 To (R - 1)

3318 If (CStr(DB(Index). Rows(i). Fields(c)) = value) Then

3319 EarlierDontFind = False

3320 Exit Function

3321 End If

3322 Next i

3323 EarlierDontFind = True

3324End Function

3325

3326Public Function FindRow(Index%, row())

3327 For R% = 0 To DB(Index). Header. RowCount - 1

3328 Sum% = 0

3329 For c% = 0 To DB(Index). Header. ColCount - 1

3330 If (CStr(DB(Index). Rows(R). Fields(c)) = row(c)) Then Sum = Sum + 1

3331 Next c

3332 If (Sum = DB(Index). Header. ColCount) Then

3333 FindRow = True

3334 Exit Function

3335 End If

3336 Next R

3337 FindRow = False

3338End Function

3339

3340Sub OutRun(str$)

3341 If (DB(QRDBIndex). Header. ColCount = 0) Or (DB(QRDBIndex). Header. RowCount = 0) Then

3342 Call MsgForm. ErrorMsg("Не с чем сравнивать! ")

3343 Exit Sub

3344 End If

3345

3346 p% = InStr(1, str, ",")

3347 what$ = Trim(Left(str, p - 1))

3348

3349 If (Not IsInteger(what)) Then

3350 Call ErrorInQuery

3351 Exit Sub

3352 End If

3353

3354 whatint% = CInt(what)

3355

3356 If (whatint < 0) Or (whatint > DB(QRDBIndex). Header. ColCount - 1) Then

3357 Call ErrorInQuery

3358 Exit Sub

3359 End If

3360

3361 pi% = p + 1

3362 Do

3363 Mode$ = Trim(Mid(str, pi, 1))

3364 pi = pi + 1

3365 Loop While (Mode = "")

3366 Mode = Mode + Mid(str, pi, 1)

3367

3368 If (Mode <> sEqual) And (Mode <> sAbove) And (Mode <> sBelow) And (Mode <> sCountEqual) And (Mode <> sCountAbove) And (Mode <> sCountBelow) Then

3369 Call ErrorInQuery

3370 Exit Sub

3371 End If

3372

3373 Dim CalcMode As Boolean

3374 CalcMode = (Mode = sCountEqual) Or (Mode = sCountAbove) Or (Mode = sCountBelow)

3375

3376 str = Trim(Mid(str, pi + 1))

3377

3378 If (str = "") Then

3379 Call ErrorInQuery

3380 Exit Sub

3381 End If

3382

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20