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

2851

2852' перетаскивание

2853Dim ClickBool As Boolean

2854Dim Xs%, Ys%

2855

2856Sub MInit()

2857 ClickBool = False

2858 Xs = 0

2859 Ys = 0

2860End Sub

2861

2862Sub MMove(ByVal Handle As Long, ByVal x%, ByVal y%)

2863 Dim R As RECT

2864 If ClickBool Then

2865 Call GetWindowRect(Handle, R)

2866 W% = R. Right - R. Left

2867 H% = R. Bottom - R. Top

2868 x = R. Left + (x - Xs) / Screen. TwipsPerPixelX

2869 y = R. Top + (y - Ys) / Screen. TwipsPerPixelY

2870 Call MoveWindow(Handle, x, y, W, H, True)

2871 End If

2872End Sub

2873

2874Sub MDown(ByVal x%, ByVal y%)

2875 ClickBool = True

2876 Xs = x

2877 Ys = y

2878End Sub

2879

2880Sub MUp()

2881 ClickBool = False

2882End Sub

Модуль: DBConst. bas

2883' результаты работы диалогов из MsgBox

2884Public Const resBad = 0 ' выход, закрытием окна

2885Public Const resOk = 1 ' Да

2886Public Const resNo = 2 ' Нет

2887Public Const resCancel = 3 ' Отмена

2888

2889' константы типов данных

2890Public Const ccInteger As Byte = 0

2891Public Const ccString As Byte = 1

2892

2893' флаги доступа доступа к БД

2894 ' требовать пароль для входа

2895Public Const flPasswordNeed As Byte = 1

2896 ' запрещать доступ на чтение без пароля

2897Public Const flReadOnlyEnable As Byte = 2

2898 ' зашифрованность данных

2899Public Const flCoded As Byte = 4

2900

2901' для диаграмм

2902Type TDiagElem

2903 Text As String

2904 Val As Integer

2905 Color As Long

2906End Type

2907

2908' права Только чтение

2909Public Sub ProtectedMsg()

2910 Call MsgForm. ErrorMsg("Недостаточно прав для выполнения действия! ")

2911End 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

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