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

2039 Min% = Height - dH2 + Screen. TwipsPerPixelY

2040 If (Min < 0) Then Min = 0

2041 VScroll. Height = Min

2042

2043 Call DrawDiagram

2044End Sub

2045

2046Private Sub Image1_Click()

2047 CD. FileName = ""

2048 CD. ShowSave

2049 If (CD. FileName <> "") Then

2050 Call SavePicture(Chart. Image, CD. FileName)

2051 End If

2052End Sub

2053

2054Private Sub Image2_Click()

2055 With DiagOptForm

2056 ' цвета

2057. Frame2(0). BackColor = StartFillColor

2058. Frame2(1). BackColor = EndFillColor

2059. Frame2(2). BackColor = Chart. ForeColor

2060. Frame2(3). BackColor = LineColor

2061 ' размеры

2062. UpDown1. value = LineWidth

2063. UpDown2. value = d3D

2064. UpDown3. value = PointRadius

2065. UpDown4. value = LineCount

2066. UpDown5. value = Round(Ellipce * 100)

2067

2068. UpDown6. Max = Chart. Width

2069 If (Chart. Height < Chart. Width) Then. UpDown6. Max = Chart. Width

2070. UpDown6. Max = Round(. UpDown6. Max / Screen. TwipsPerPixelX)

2071. UpDown6. value = Round(Radius / Screen. TwipsPerPixelX)

2072

2073. UpDown7. Max =. UpDown6. Max * 0.9

2074. UpDown7. value = Round(InRad / Screen. TwipsPerPixelX)

2075

2076 ' цвета и надписи

2077. List1. Clear

2078 For i% = 1 To ItemCount

2079. List1. AddItem (DiagData(i - 1). Text)

2080. List1. ItemData(i - 1) = DiagData(i - 1). Color

2081 Next i

2082 If (. List1. ListCount > 0) Then. List1. ListIndex = 0

2083

2084 ' флаги

2085. Check1. value = - CInt(UseColorFill)

2086. Check3. value = - CInt(UseCircleLegend)

2087. Check2. value = - CInt(UseLineLeftValues)

2088

2089. Show vbModal

2090 If (. res = 1) Then

2091 ' цвета

2092 StartFillColor =. Frame2(0). BackColor

2093 EndFillColor =. Frame2(1). BackColor

2094 Chart. ForeColor =. Frame2(2). BackColor

2095 LineColor =. Frame2(3). BackColor

2096 ' размеры

2097 LineWidth =. UpDown1. value

2098 d3D =. UpDown2. value

2099 PointRadius =. UpDown3. value

2100 LineCount =. UpDown4. value

2101 Ellipce =. UpDown5. value / 100

2102 Radius =. UpDown6. value * Screen. TwipsPerPixelX

2103 InRad =. UpDown7. value * Screen. TwipsPerPixelX

2104 ' цвета и надписи

2105 For i% = 1 To ItemCount

2106 DiagData(i - 1). Text =. List1. List(i - 1)

2107 DiagData(i - 1). Color =. List1. ItemData(i - 1)

2108 Next i

2109 ' флаги

2110 UseColorFill = (. Check1. value = 1)

2111 UseCircleLegend = (. Check3. value = 1)

2112 UseLineLeftValues = (. Check2. value = 1)

2113 Call DrawDiagram

2114 End If

2115 End With

2116End Sub

2117

2118Private Sub Image3_Click()

2119 Hide

2120End Sub

2121

2122Private Sub VScroll_Change()

2123 Ellipce = VScroll. value / 100

2124 Call DrawDiagram

2125End Sub

Форма: InputForm. frm

2126Dim res%

2127

2128Private Sub CancelBut_Click()

2129 Call SoundClick

2130 Hide

2131End Sub

2132

2133Private Sub Form_Activate()

2134 Text1. SetFocus

2135End Sub

2136

2137Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

2138 Select Case KeyCode

2139 Case 13: Call YesBut_Click

2140 Case 27: Call CancelBut_Click

2141 End Select

2142End Sub

2143

2144Private Sub Form_Load()

2145 Call ButEnabled(YesImg, YesBut, True)

2146 Call ButEnabled(CancelImg, CancelBut, True)

2147End Sub

2148

2149Public Function InputVal(str$) As String

2150 Label1. Caption = str

2151 Text1. Text = ""

2152 res = 0

2153 Me. Show vbModal

2154 If (res = 1) Then InputVal = Text1. Text

2155 Unload Me

2156End Function

2157

2158Private Sub YesBut_Click()

2159 Call SoundClick

2160 res = 1

2161 Hide

2162End Sub

Форма: DiagOpt. frm

2163Public res%

2164

2165Private Sub Form_Load()

2166 res = 0

2167 Call ButEnabled(SelectImg, SelectBut, True)

2168 Call ButEnabled(CancelImg, CancelBut, True)

2169End Sub

2170

2171Private Sub Form_Paint()

2172 Call DiagResForm. ColorFill(Picture1, Frame2(0). BackColor, Frame2(1). BackColor)

2173End Sub

2174

2175Private Sub Frame2_Click(Index As Integer)

2176 ColorDlg. Color = Frame2(Index). BackColor

2177 ColorDlg. ShowColor

2178 Frame2(Index). BackColor = ColorDlg. Color

2179 If (Index < 2) Then Call DiagResForm. ColorFill(Picture1, Frame2(0). BackColor, Frame2(1). BackColor)

2180 If (Index = 4) Then List1. ItemData(List1. ListIndex) = Frame2(4). BackColor

2181End Sub

2182

2183Private Sub Label10_Click()

2184 res = 1

2185 Hide

2186End Sub

2187

2188Private Sub Label15_Click()

2189 Hide

2190End Sub

2191

2192Private Sub List1_Click()

2193 If (List1. ListIndex > - 1) Then

2194 Text1. Text = List1. List(List1. ListIndex)

2195 Frame2(4). BackColor = List1. ItemData(List1. ListIndex)

2196 End If

2197End Sub

2198

2199Private Sub List1_KeyPress(KeyAscii As Integer)

2200 Call List1_Click

2201End Sub

2202

2203Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)

2204 If (KeyCode = 13) Then

2205 List1. List(List1. ListIndex) = Text1. Text

2206 List1. ItemData(List1. ListIndex) = Frame2(4). BackColor

2207 End If

2208End Sub

Форма: SplashScreenForm. frm

2209Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

2210 If (KeyCode = 27) Or (KeyCode = 13) Then

2211 MainForm. Show

2212 Unload Me

2213 End If

2214End Sub

2215

2216Private Sub Form_Load()

2217 Label2. Caption = "v. " + CStr(App. Major) + ". " + CStr(App. Minor)

2218End Sub

2219

2220Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

2221 Call MDown(x, y)

2222End Sub

2223

2224Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

2225 Call MMove(hwnd, x, y)

2226End Sub

2227

2228Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

2229 Call MUp

2230End Sub

Форма: MonthForm. frm

2231Public res%

2232

2233Private Sub CancelBut_Click()

2234 Hide

2235End Sub

2236

2237Private Sub EditBut_Click()

2238 res = - 1

2239 Hide

2240End Sub

2241

2242Private Sub Form_Load()

2243 Call ButEnabled(YesImg, YesBut, True)

2244 Call ButEnabled(EditImg, EditBut, True)

2245 Call ButEnabled(CancelImg, CancelBut, True)

2246 res = 0

2247End Sub

2248

2249Private Sub YesBut_Click()

2250 res = 1

2251 Hide

2252End Sub

Модуль: DBTypes. bas

2253'************************************

2254' модуль DBTypes. bas

2255' вся работа с файлом БД

2256'************************************

2257

2258'************************************** Описание типов **************************************

2259

2260' заголовок файла

2261Type TDBHeader

2262 ' "DBX" - проверка файла

2263 Header As String * 3

2264 ' флаги

2265 Flags As Byte

2266 ' количество полей

2267 ColCount As Long

2268 ' количество записей

2269 RowCount As Long

2270End Type

2271

2272' имеет ли пользователь права на редактирование

2273Public UserIsAdmin As Boolean

2274

2275' данные о столбце

2276Type TDBElemData

2277 ' тип данных

2278 Class As Byte

2279 ' длина заголовка

2280 TitleLen As Byte

2281 ' заголовок, длины TitleLen

2282 title As String

2283 ' значение по-умолчанию

2284 DefValue As Variant

2285End Type

2286

2287' запись

2288Type TDBElem

2289 ' поля записи

2290 Fields() As Variant

2291End Type

2292

2293' элемент в массиве DB

2294Type TDBCell

2295 Header As TDBHeader

2296 Cols() As TDBElemData

2297 Rows() As TDBElem

2298 Password As String

2299End Type

2300

2301'************************************** Описание констант **************************************

2302

2303' контрольный байт

2304Public Const ValidateByte As Byte = &H7F

2305

2306'************************************** Описание переменных **************************************

2307

2308' путь к БД

2309Public DBPath$

2310' флаг изменения БД

2311Public DBChanged As Boolean

2312' данные таблиц: каждый элемент - это копия некоторой таблицы

2313Public DB() As TDBCell

2314

2315'************************************** Процедуры и функции **************************************

2316

2317' удаление поля

2318Public Sub DelCol_(DBIndex%, Optional ByVal Index% = - 1, Optional ByVal conf As Boolean = True)

2319 With DB(DBIndex). Header

2320 If (. ColCount = 0) Then Exit Sub

2321 If (Index = - 1) Then Index =. ColCount - 1

2322 If (Index >. ColCount - 1) Or (Index < - 1) Then

2323 Call MsgForm. ErrorMsg("Ошибка удаления столбца! ")

2324 Exit Sub

2325 End If

2326

2327 If conf Then

2328 If (MsgForm. QuestMsg("Удалить столбец? ") <> resOk) Then Exit Sub

2329 End If

2330 ' вырезаю из полей

2331 For i% = Index To (. ColCount - 2)

2332 DB(DBIndex). Cols(i) = DB(DBIndex). Cols(i + 1)

2333 Next i

2334 ' вырезаю из записей

2335 For R% = 0 To (. RowCount - 1)

2336 For c% = Index To (. ColCount - 2)

2337 DB(DBIndex). Rows(R). Fields(c) = DB(DBIndex). Rows(R). Fields(c + 1)

2338 Next c

2339 Next R

2340

2341. ColCount =. ColCount - 1

2342 ReDim Preserve DB(DBIndex). Cols(. ColCount)

2343 DBChanged = True

2344End With

2345End Sub

2346

2347' удаление записи

2348Public Sub DelRow_(DBIndex%, Optional ByVal Index% = - 1, Optional ByVal conf As Boolean = True)

2349 With DB(DBIndex). Header

2350 If (. RowCount = 0) Then Exit Sub

2351 If (Index = - 1) Then Index =. RowCount - 1

2352 If (Index >. RowCount - 1) Then

2353 Call MsgForm. ErrorMsg("Ошибка удаления записи! ")

2354 Exit Sub

2355 End If

2356

2357 If conf Then

2358 If (MsgForm. QuestMsg("Удалить запись? ") = resNo) Then Exit Sub

2359 End If

2360 For i% = Index To (. RowCount - 2)

2361 DB(DBIndex). Rows(i) = DB(DBIndex). Rows(i + 1)

2362 Next i

2363. RowCount =. RowCount - 1

2364 ReDim Preserve DB(DBIndex). Rows(. RowCount)

2365 DBChanged = True

2366End With

2367End Sub

2368

2369Public Sub TestDBChanged()

2370 If DBChanged Then

2371 MainForm. SB. Panels(1). Picture = MainForm. ImageList1. ListImages(2). Picture

2372 Else

2373 Set MainForm. SB. Panels(1). Picture = Nothing

2374 End If

2375End Sub

2376

2377' отображение таблицы

2378Public Sub ShowTable(DBIndex%)

2379 MainForm. ListView. ListItems. Clear

2380 MainForm. ListView. ColumnHeaders. Clear

2381 If (DBIndex = - 1) Then

2382 DBPath = ""

2383 MainForm. SB. Panels(3). Text = ""

2384 GoTo exit_

2385 End If

2386 If (DB(DBIndex). Header. ColCount = 0) Then GoTo exit_

2387 For c% = 0 To DB(DBIndex). Header. ColCount - 1

2388 Call MainForm. ListView. ColumnHeaders. Add(_

2389 MainForm. ListView. ColumnHeaders. Count + 1, _

2390 "col_key_" + CStr(c), _

2391 DB(DBIndex). Cols(c). title, _

2392 1440, _

2393 lvwColumnLeft, _

2394 0 _

2395)

2396

2397 Next c

2398 For R% = 0 To DB(DBIndex). Header. RowCount - 1

2399 With MainForm. ListView. ListItems. Add

2400. Key = "row_key_" + CStr(R)

2401. Text = DB(DBIndex). Rows(R). Fields(0)

2402 For i% = 1 To DB(DBIndex). Header. ColCount - 1

2403. SubItems(i) = DB(DBIndex). Rows(R). Fields(i)

2404 Next i

2405 End With

2406 Next R

2407exit_:

2408 MainForm. TabStrip. Visible = (DBPath <> "")

2409 MainForm. ListView. Visible = MainForm. TabStrip. Visible

2410 If (DBIndex <> - 1) Then

2411 MainForm. SB. Panels(2). Text = CStr(DB(DBIndex). Header. RowCount)

2412 Else

2413 MainForm. SB. Panels(2). Text = ""

2414 End If

2415 Call TestDBChanged

2416End Sub

2417

2418' поиск поля *************************************************

2419Public Function ItColAlreadyCreate(QRDBIndex%, title$) As Boolean

2420 With DB(QRDBIndex)

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

2422 If (. Cols(i). title = title) Then

2423 ItColAlreadyCreate = True

2424 Exit Function

2425 End If

2426 Next i

2427 End With

2428 ItColAlreadyCreate = False

2429End Function

2430

2431' добавление поля *************************************************

2432Public Sub AddCol(DBIndex%, ByVal Class%, ByVal title$, ByVal defval, Optional ByVal pos% = - 1)

2433 With DB(DBIndex). Header

2434 ReDim Preserve DB(DBIndex). Cols(. ColCount)

2435 If (pos = - 1) Then

2436 pos =. ColCount

2437 Else

2438 For i% = 1 To (. ColCount - pos)

2439 DB(DBIndex). Cols(. ColCount - i + 1) = DB(DBIndex). Cols(. ColCount - i)

2440 Next i

2441 End If

2442 With DB(DBIndex). Cols(pos)

2443. Class = Class

2444. title = title

2445. TitleLen = Len(title)

2446. DefValue = defval

2447 End With

2448

2449 ' увеличиваю размерность записей

2450 For R% = 0 To DB(DBIndex). Header. RowCount - 1

2451 ReDim Preserve DB(DBIndex). Rows(R). Fields(. ColCount)

2452 For i% = 1 To (. ColCount - pos)

2453 DB(DBIndex). Rows(R). Fields(. ColCount - i + 1) = DB(DBIndex). Rows(R). Fields(. ColCount - i)

2454 Next i

2455 DB(DBIndex). Rows(R). Fields(pos) = DB(DBIndex). Cols(pos). DefValue

2456 Next R

2457

2458. ColCount =. ColCount + 1

2459

2460 DBChanged = True

2461 End With

2462End Sub

2463

2464' добавление записи *************************************************

2465Public Sub AddField(DBIndex%, row)

2466 With DB(DBIndex). Header

2467 ReDim Preserve DB(DBIndex). Rows(. RowCount)

2468 DB(DBIndex). Rows(. RowCount). Fields = row

2469. RowCount =. RowCount + 1

2470 DBChanged = True

2471 End With

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


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