на тему рефераты Информационно-образоательный портал
Рефераты, курсовые, дипломы, научные работы,
на тему рефераты
на тему рефераты
МЕНЮ|
на тему рефераты
поиск
Создание базы данных
911End Sub

2912

2913' звук нажатия кнопки

2914Public Sub SoundClick()

2915 Call sndPlaySound("Data\Click. wav", SND_ASYNC + SND_FILENAME + SND_LOOP + SND_APPLICATION)

2916End Sub

2917

2918Public Function IsInteger(ByVal str$) As Boolean

2919 Dim Arr(1 To 4) As String * 1

2920 Arr(1) = "e": Arr(2) = "E": Arr(3) = ",": Arr(4) = ". "

2921 IsInteger = True

2922 If IsNumeric(str) Then

2923 For i% = LBound(Arr) To UBound(Arr)

2924 If (InStr(1, str, Arr(i)) > 0) Then

2925 IsInteger = False

2926 Exit For

2927 End If

2928 Next i

2929 Else

2930 IsInteger = False

2931 End If

2932End Function

2933

2934Public Sub ButEnabled(Pict As Image, Lbl As Label, enbl As Boolean)

2935 If enbl Then

2936 Pict. Picture = MainForm. ButtonImageList. ListImages(1). Picture

2937 Lbl. MousePointer = 1

2938 Else

2939 Pict. Picture = MainForm. ButtonImageList. ListImages(2). Picture

2940 Lbl. MousePointer = 12

2941 End If

2942 Lbl. Tag = CInt(enbl)

2943End Sub

Модуль: QueryRunner. bas

2944Public QRDBIndex%

2945

2946'***********************************

2947' Запросы чувствительны к регистру!

2948'***********************************

2949

2950' константы видов запросов

2951 ' ОБЯЗАТЕЛЬНО 3 ЗНАКА

2952Public Const sAdd$ = "Add"

2953Public Const sDel$ = "Del"

2954Public Const sSort$ = "Srt"

2955Public Const sOut$ = "Out"

2956Public Const sSwap$ = "Swp"

2957Public Const sChange$ = "Chg"

2958

2959' константы подтипов запросов

2960Public Const sCol$ = "Col"

2961Public Const sRow$ = "Row"

2962Public Const sTable$ = "Tbl" ' только для использования в запросе Вывод

2963Public Const sAZ$ = "AZ"

2964Public Const sZA$ = "ZA"

2965Public Const sEqual$ = "? ="

2966Public Const sAbove$ = "? >"

2967Public Const sBelow$ = "? <"

2968Public Const sCountEqual$ = "+="

2969Public Const sCountAbove$ = "+>"

2970Public Const sCountBelow$ = "+<"

2971Public Const sI$ = "i"

2972Public Const sS$ = "s"

2973Public Const sYes$ = "yes"

2974Public Const sNo$ = "no"

2975Public Const sType$ = "Type"

2976Public Const sName$ = "Name"

2977

2978' остальные константы

2979Public Const sSep$ = "; "

2980

2981'************************ Формирует строку добавления 'What' ************************

2982Public Function Generate_Add(ByVal what$) As String

2983 If (what = sCol) Then

2984 s$ = AddColForm. AddColDlg(QRDBIndex)

2985 If (s <> "") Then

2986 Generate_Add = sAdd + sCol + "(" + s + ")"

2987 Else

2988 Generate_Add = ""

2989 End If

2990 Else

2991 Generate_Add = sAdd + sRow + "()"

2992 End If

2993End Function

2994

2995'************************ Формирует строку удаления 'What' ************************

2996Public Function Generate_Del(ByVal what$) As String

2997 With SelectForm. CheckConfirm

2998. value = 1

2999. Visible = True

3000 End With

3001 Dim conf$

3002

3003 If (what = sCol) Then

3004 s$ = SelectForm. SelectDlg(QRDBIndex, "Выберите удаляемое поле", sCol)

3005 If (s <> - 1) Then

3006 If (SelectForm. CheckConfirm. value = 1) Then

3007 conf = sYes

3008 Else

3009 conf = sNo

3010 End If

3011 Generate_Del = sDel + sCol + "(" + s + ", " + conf + ")"

3012 Else

3013 Generate_Del = ""

3014 End If

3015 Else

3016 s$ = SelectForm. SelectDlg(QRDBIndex, "Выберите удаляемую запись", sRow)

3017 If (s <> - 1) Then

3018 If (SelectForm. CheckConfirm. value = 1) Then

3019 conf = sYes

3020 Else

3021 conf = sNo

3022 End If

3023 Generate_Del = sDel + sRow + "(" + s + ", " + conf + ")"

3024 Else

3025 Generate_Del = ""

3026 End If

3027 End If

3028End Function

3029

3030'************************ Формирует строку сортировки по 'What' ************************

3031Public Function Generate_Sort(ByVal what$) As String

3032 SelectForm. CheckConfirm. Visible = False

3033

3034 s$ = SelectForm. SelectDlg(QRDBIndex, "Выберите поле сортировки", sCol)

3035 If (s <> - 1) Then

3036 Generate_Sort = sSort + "(" + s + ", " + what + ")"

3037 Else

3038 Generate_Sort = ""

3039 End If

3040End Function

3041

3042'************************ Формирует строку вывода по 'What' ************************

3043Public Function Generate_Out(ByVal what$) As String

3044 Generate_Out = ""

3045 SelectForm. CheckConfirm. Visible = False

3046 Dim str$

3047

3048 s$ = SelectForm. SelectDlg(QRDBIndex, "Выберите поле", sCol)

3049 If (s <> "-1") Then

3050 str = Trim(InputForm. InputVal("Введите относительное значение"))

3051 If (str <> "") Then

3052 Dim CreateNewTab As Boolean

3053 CreateNewTab = (MsgForm. QuestMsg("Выводить в новую таблицу? Нет для вывода в уже существующую. ") = resOk)

3054 If (Not CreateNewTab) Then

3055 Table$ = SelectForm. SelectDlg(QRDBIndex, "Выберите таблицу", sTable)

3056 If (Table = "-1") Then Exit Function

3057 Generate_Out = sOut + "(" + s + ", " + what + str + ", " + Table + ")"

3058 Else

3059 Generate_Out = sOut + "(" + s + ", " + what + str + ")"

3060 End If

3061 Else

3062 Call MsgForm. ErrorMsg("Не задано относительное значение! ")

3063 End If

3064 End If

3065End Function

3066

3067'************************ Формирует строку обмена по 'What' ************************

3068Public Function Generate_Swap(ByVal what$) As String

3069 If (what = sCol) Then

3070 s$ = SelectForm. MultiSelectDlg(QRDBIndex, "Выберите 2 обмениваемых поля", sCol)

3071 If (s <> "") Then

3072 p% = InStr(1, s, ",")

3073 Generate_Swap = sSwap + sCol + "(" + Left(s, p - 1) + ", " + Mid(s, p + 1) + ")"

3074 Else

3075 Generate_Swap = ""

3076 End If

3077 Else

3078 s$ = SelectForm. MultiSelectDlg(QRDBIndex, "Выберите 2 обмениваемые записи", sRow)

3079 If (s <> "") Then

3080 p% = InStr(1, s, ",")

3081 Generate_Swap = sSwap + sRow + "(" + Left(s, p - 1) + ", " + Mid(s, p + 1) + ")"

3082 Else

3083 Generate_Swap = ""

3084 End If

3085 End If

3086End Function

3087

3088'************************ Формирует строку изменения 'What' ************************

3089Public Function Generate_Change(ByVal what$) As String

3090 Generate_Change = ""

3091 SelectForm. CheckConfirm. Visible = False

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

3383 ' проверка на наличие индекса таблицы

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

3385 tableindex% = - 1

3386 If (p <> 0) Then

3387 tableindexstr$ = Trim(Mid(str, p + 1))

3388 If Not IsInteger(tableindexstr) Then

3389 Call ErrorInQuery

3390 Exit Sub

3391 End If

3392 tableindex% = CLng(tableindexstr)

3393 If (tableindex < 0) Or (tableindex > MainForm. TabStrip. Tabs. Count - 1) Then

3394 Call ErrorInQuery

3395 Exit Sub

3396 End If

3397 str = Trim(Left(str, p - 1))

3398 End If

3399

3400 Dim GlobEqual As Boolean

3401 If (Not IsInteger(str)) And (DB(QRDBIndex). Cols(whatint). Class = ccInteger) Then

3402 Call MsgForm. ErrorMsg("Эквивалентом вывода целочисленного столбца не является целое число! " + vbCrLf + _

3403 "Условие всегда истинно! ")

3404 GlobEqual = True

3405 Else

3406 GlobEqual = False

3407 End If

3408

3409 Count% = MainForm. TabStrip. Tabs. Count

3410 If (tableindex = - 1) Then

3411 ReDim Preserve DB(Count)

3412

3413 DB(Count). Header = DB(QRDBIndex). Header

3414 DB(Count). Header. RowCount = 0

3415 DB(Count). Cols = DB(QRDBIndex). Cols

3416

3417 MainForm. TabStrip. Tabs. Add pvCaption: ="Вывод " + Mode + str, pvImage: =1

3418 Else

3419 Count = tableindex

3420 End If

3421

3422 Dim NeedAdd As Boolean

3423 With DB(Count)

3424 Dim Rval

3425 For R% = 0 To DB(QRDBIndex). Header. RowCount - 1

3426 If (Not GlobEqual) Then

3427 Select Case Mode

3428 Case sEqual

3429 NeedAdd = (Equal(whatint, R, str) = 0)

3430 Case sAbove

3431 NeedAdd = (Equal(whatint, R, str) > 0)

3432 Case sBelow

3433 NeedAdd = (Equal(whatint, R, str) < 0)

3434 Case sCountEqual

3435 value$ = CStr(DB(QRDBIndex). Rows(R). Fields(whatint))

3436 NeedAdd = ((CStr(CalcCount(QRDBIndex, whatint, value)) = str) And (EarlierDontFind(QRDBIndex, whatint, R, value)))

3437 Case sCountAbove

3438 value$ = CStr(DB(QRDBIndex). Rows(R). Fields(whatint))

3439 NeedAdd = ((CStr(CalcCount(QRDBIndex, whatint, value)) > str) And (EarlierDontFind(QRDBIndex, whatint, R, value)))

3440 Case sCountBelow

3441 value$ = CStr(DB(QRDBIndex). Rows(R). Fields(whatint))

3442 NeedAdd = ((CStr(CalcCount(QRDBIndex, whatint, value)) < str) And (EarlierDontFind(QRDBIndex, whatint, R, value)))

3443 End Select

3444 Else

3445 NeedAdd = True

3446 End If

3447 If (NeedAdd) Then

3448 ReDim tmparr(DB(QRDBIndex). Header. ColCount)

3449 tmparr = DB(QRDBIndex). Rows(R). Fields

3450 If (Not FindRow(Count, tmparr)) Then

3451 addindex% = DB(Count). Header. RowCount

3452 ReDim Preserve DB(Count). Rows(addindex)

3453 ReDim DB(Count). Rows(addindex). Fields(DB(Count). Header. ColCount - 1)

3454 DB(Count). Rows(addindex). Fields = DB(QRDBIndex). Rows(R). Fields

3455 DB(Count). Header. RowCount = DB(Count). Header. RowCount + 1

3456 Else

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

3458 End If

3459 End If

3460 Next R

3461 End With

3462End Sub

3463

3464Sub SwapRun(what$, str$)

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

3466 If TestZero(p) Then Exit Sub

3467 index1str$ = Trim(Left(str, p - 1))

3468 index2str$ = Trim(Mid(str, p + 1))

3469

3470 If (Not IsInteger(index1str)) Then

3471 Call ErrorInQuery

3472 Exit Sub

3473 End If

3474

3475 index1% = CInt(index1str)

3476 index2% = CInt(index2str)

3477

3478 If (index1 < 0) Or (index2 < 0) Or (index1 = index2) Then

3479 Call ErrorInQuery

3480 Exit Sub

3481 End If

3482

3483 Select Case what

3484 Case sCol

3485 With DB(QRDBIndex)

3486 If (index1 >. Header. ColCount - 1) Or (index2 >. Header. ColCount - 1) Then

3487 Call ErrorInQuery

3488 Exit Sub

3489 End If

3490 ' обмен полей

3491 Dim tmpcol As TDBElemData

3492 tmpcol =. Cols(index1)

3493. Cols(index1) =. Cols(index2)

3494. Cols(index2) = tmpcol

3495 ' обмен полей записей

3496 Dim tmpcell As Variant

3497 For R% = 0 To. Header. RowCount - 1

3498 tmpcell =. Rows(R). Fields(index1)

3499. Rows(R). Fields(index1) =. Rows(R). Fields(index2)

3500. Rows(R). Fields(index2) = tmpcell

3501 Next R

3502

3503 End With

3504 Case sRow

3505 With DB(QRDBIndex)

3506 If (index1 >. Header. RowCount - 1) Or (index2 >. Header. RowCount - 1) Then

3507 Call ErrorInQuery

3508 Exit Sub

3509 End If

3510 Dim tmprow As TDBElem

3511 tmprow =. Rows(index1)

3512. Rows(index1) =. Rows(index2)

3513. Rows(index2) = tmprow

3514 End With

3515 End Select

3516End Sub

3517

3518Sub ChangeRun(what$, param$)

3519 Select Case what

3520 Case sType ' **************...::: Type:::... ***************

3521 If Not IsInteger(param) Then

3522 Call ErrorInQuery

3523 Exit Sub

3524 End If

3525 colindex% = CLng(param)

3526 If (colindex < 0) Or (colindex > DB(QRDBIndex). Header. ColCount - 1) Then

3527 Call ErrorInQuery

3528 Exit Sub

3529 End If

3530 If (DB(QRDBIndex). Cols(colindex). Class = ccString) Then

3531 If (MsgForm. QuestMsg("Поле строкового типа преобразуется в числовой тип. " + _

3532 "Все нечисловые значения будут преобразованы в 0. " + _

3533 "Продолжить? ") <> resOk) Then Exit Sub

3534

3535 End If

3536 For i% = 0 To (DB(QRDBIndex). Header. RowCount - 1)

3537 Select Case DB(QRDBIndex). Cols(colindex). Class

3538 Case ccInteger

3539 DB(QRDBIndex). Rows(i). Fields(colindex) = CStr(DB(QRDBIndex). Rows(i). Fields(colindex))

3540 Case ccString

3541 If Not IsInteger(DB(QRDBIndex). Rows(i). Fields(colindex)) Then

3542 DB(QRDBIndex). Rows(i). Fields(colindex) = 0

3543 Else

3544 DB(QRDBIndex). Rows(i). Fields(colindex) = CLng(DB(QRDBIndex). Rows(i). Fields(colindex))

3545 End If

3546 End Select

3547 Next i

3548 Select Case DB(QRDBIndex). Cols(colindex). Class

3549 Case ccInteger

3550 DB(QRDBIndex). Cols(colindex). Class = ccString

3551 Case ccString

3552 DB(QRDBIndex). Cols(colindex). Class = ccInteger

3553 End Select

3554

3555 Case sName ' **************...::: Name:::... ***************

3556 p% = InStr(1, param, ",")

3557 If TestZero(p) Then Exit Sub

3558 colindexstr$ = Trim(Left(param, p - 1))

3559 If Not IsInteger(colindexstr) Then

3560 Call ErrorInQuery

3561 Exit Sub

3562 End If

3563 colindex% = CLng(colindexstr)

3564 param = Trim(Mid(param, p + 1))

3565 If (param = "") Then

3566 Call ErrorInQuery

3567 Exit Sub

3568 End If

3569 ' поиск на дубликат

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

3571 If (DB(QRDBIndex). Cols(i). title = param) And (i <> colindex) Then

3572 Call MsgForm. ErrorMsg("Поле с названием " + param + " уже существует! ")

3573 Exit Sub

3574 End If

3575 Next i

3576 DB(QRDBIndex). Cols(colindex). title = param

3577 DB(QRDBIndex). Cols(colindex). TitleLen = Len(param)

3578 Case Default ' **************!! ***************

3579 Call ErrorInQuery

3580 End Select

3581End Sub

3582

3583Public Sub RunQuery(DBIndex_%, query$)

3584 Dim s1$, p%

3585

3586 s1 = Mid(query, 4)

3587 query = Left(query, 3)

3588

3589 QRDBIndex = DBIndex_

3590

3591 Select Case query

3592 Case sAdd

3593 query = Left(s1, 3)

3594 s1 = Mid(s1, InStr(1, s1, "("))

3595 If (Left(s1, 1) <> "(") Or (Right(s1, 1) <> ")") Or ((Len(s1) < 8) And (query = sCol)) Then

3596 Call ErrorInQuery

3597 Else

3598 Call AddRun(query, Trim(Mid(s1, 2, Len(s1) - 2)))

3599 End If

3600 Case sDel

3601 query = Left(s1, 3)

3602 s1 = Mid(s1, InStr(1, s1, "("))

3603 If (Left(s1, 1) <> "(") Or (Right(s1, 1) <> ")") Or (Len(s1) < 5) Then

3604 Call ErrorInQuery

3605 Else

3606 Call DelRun(query, Trim(Mid(s1, 2, Len(s1) - 2)))

3607 End If

3608 Case sSort

3609 If (Left(s1, 1) <> "(") Or (Right(s1, 1) <> ")") Or (Len(s1) < 5) Then

3610 Call ErrorInQuery

3611 Else

3612 Call SortRun(Trim(Mid(s1, 2, Len(s1) - 2)))

3613 End If

3614 Case sOut

3615 If (Left(s1, 1) <> "(") Or (Right(s1, 1) <> ")") Or (Len(s1) < 5) Then

3616 Call ErrorInQuery

3617 Else

3618 Call OutRun(Trim(Mid(s1, 2, Len(s1) - 2)))

3619 End If

3620 Case sSwap

3621 query = Left(s1, 3)

3622 s1 = Mid(s1, InStr(1, s1, "("))

3623 If (Left(s1, 1) <> "(") Or (Right(s1, 1) <> ")") Or ((Len(s1) < 5) And (query = sCol)) Then

3624 Call ErrorInQuery

3625 Else

3626 Call SwapRun(query, Trim(Mid(s1, 2, Len(s1) - 2)))

3627 End If

3628 Case sChange

3629 query = Left(s1, 4)

3630 s1 = Mid(s1, InStr(1, s1, "("))

3631 If (Left(s1, 1) <> "(") Or (Right(s1, 1) <> ")") Or (Len(s1) < 3) Then

3632 Call ErrorInQuery

3633 Else

3634 Call ChangeRun(query, Trim(Mid(s1, 2, Len(s1) - 2)))

3635 End If

3636 End Select

3637

3638End Sub

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11


© 2003-2013
Рефераты бесплатно, курсовые, рефераты биология, большая бибилиотека рефератов, дипломы, научные работы, рефераты право, рефераты, рефераты скачать, рефераты литература, курсовые работы, реферат, доклады, рефераты медицина, рефераты на тему, сочинения, реферат бесплатно, рефераты авиация, рефераты психология, рефераты математика, рефераты кулинария, рефераты логистика, рефераты анатомия, рефераты маркетинг, рефераты релиния, рефераты социология, рефераты менеджемент.