home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Hot Shareware 35
/
hot35.iso
/
ficheros
/
LVB
/
T2W32543.ZIP
/
_DALONG.FRM
< prev
next >
Wrap
Text File
|
1998-05-21
|
9KB
|
292 lines
VERSION 5.00
Begin VB.Form frmDALong
BorderStyle = 4 'Fixed ToolWindow
Caption = "Disk array : long"
ClientHeight = 4065
ClientLeft = 1890
ClientTop = 3255
ClientWidth = 8130
MaxButton = 0 'False
MDIChild = -1 'True
PaletteMode = 1 'UseZOrder
ScaleHeight = 4065
ScaleWidth = 8130
ShowInTaskbar = 0 'False
Begin VB.Frame Frame1
Height = 570
Left = 0
TabIndex = 2
Top = -90
Width = 8115
Begin VB.CommandButton cmdNP
Caption = ">"
Height = 285
Index = 1
Left = 7740
TabIndex = 7
Top = 195
Width = 285
End
Begin VB.CommandButton cmdNP
Caption = "<"
Height = 285
Index = 0
Left = 6840
TabIndex = 6
Top = 195
Width = 285
End
Begin VB.CommandButton Command1
Caption = "&Go"
Default = -1 'True
Height = 285
Left = 7200
TabIndex = 5
Top = 195
Width = 465
End
Begin VB.ComboBox cmb_Function
Height = 315
Left = 1365
TabIndex = 3
Top = 180
Width = 5385
End
Begin VB.Label Label2
Caption = "&Select a function"
Height = 255
Left = 90
TabIndex = 4
Top = 210
Width = 1275
End
End
Begin VB.Label lbl_Result
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H80000008&
Height = 3345
Left = 2970
TabIndex = 1
Top = 630
Width = 5055
End
Begin VB.Label lbl_Open
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
BeginProperty Font
Name = "Courier New"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 3345
Left = 90
TabIndex = 0
Top = 630
Width = 2715
End
End
Attribute VB_Name = "frmDALong"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 1
Private Const Iteration = 50
Dim IsLoaded As Integer
Dim TimerStartOk As Integer
Dim TimerCloseOk As Integer
Dim TimerHandle As Integer
Dim TimerValue As Long
Private Sub cmdNP_Click(Index As Integer)
Call sub_NextPrev(cmb_Function, Index)
End Sub
Private Sub cmb_Function_Click()
If (IsLoaded = False) Then Exit Sub
Call cDisableFI(mdiT2W.Picture1)
lbl_Result = ""
DoEvents
Call TestDALong(cmb_Function.ListIndex - 1)
DoEvents
Call cEnableFI(mdiT2W.Picture1)
End Sub
Private Sub Form_Activate()
mdiT2W.Label2.Caption = cInsertBlocks(mdiT2W.Label2.Tag, "" & Iteration)
End Sub
Private Sub Form_Load()
IsLoaded = False
Show
Call sub_Load_Combo(cmb_Function, T2WDirInst + "_dalong.t2w")
IsLoaded = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim intResult As Integer
intResult = cKillFileAll("c:\t2w_tmp\dalong.tmp")
End Sub
Private Sub Command1_Click()
Call cmb_Function_Click
End Sub
Private Sub TestDALong(intManagement As Integer)
Dim intResult As Integer
Dim strResult As String
Dim strOpen As String
Dim strDisplay As String
Dim i As Integer
Dim DA As tagDISKARRAY
intResult = 0
strResult = ""
strOpen = ""
strDisplay = ""
DA.nFileName = T2WDirTest + "\dalong.tmp"
DA.nType = DA_LONG
DA.nIsTyped = False
DA.nRows = 100
DA.nCols = 100
DA.nSheets = 2
Select Case intManagement
Case True 'create
intResult = cDACreate(DA, True)
Case False 'use
intResult = cDACreate(DA, False)
Case 1 'clear all
intResult = cDACreate(DA, False)
If (intResult = -1) Then intResult = cDAClear(DA)
Case 2 'clear sheet 2
intResult = cDACreate(DA, False)
If (intResult = -1) Then intResult = cDAClearSheet(DA, 2)
Case 3 'clear last row
intResult = cDACreate(DA, False)
If (intResult = -1) Then intResult = cDAClearRow(DA, DA.nRows, 1)
Case 4 'clear last col
intResult = cDACreate(DA, False)
If (intResult = -1) Then intResult = cDAClearCol(DA, DA.nCols, 1)
Case 5 'clear last row in all sheets
intResult = cDACreate(DA, False)
If (intResult = -1) Then intResult = cDAClearRow(DA, DA.nRows, -1)
Case 6 'clear last col in all sheets
intResult = cDACreate(DA, False)
If (intResult = -1) Then intResult = cDAClearCol(DA, DA.nCols, -1)
End Select
strDisplay = strDisplay & "Last intResult = " & intResult & vbCrLf & vbCrLf
If (intResult = True) Then
strOpen = strOpen & "daSize = " & DA.daSize & vbCrLf
strOpen = strOpen & "Signature = " & DA.signature & vbCrLf
strOpen = strOpen & "nFilename = " & Trim$(cGetInPartR(DA.nFileName, "\", True)) & vbCrLf
strOpen = strOpen & "nType = " & DA.nType & vbCrLf
strOpen = strOpen & "nIsTyped = " & DA.nIsTyped & vbCrLf
strOpen = strOpen & "nRows = " & DA.nRows & vbCrLf
strOpen = strOpen & "nCols = " & DA.nCols & vbCrLf
strOpen = strOpen & "nSheets = " & DA.nSheets & vbCrLf
strOpen = strOpen & "rHandle = " & DA.rHandle & vbCrLf
strOpen = strOpen & "rElementSize = " & DA.rElementSize & vbCrLf
strOpen = strOpen & "rFileSize = " & DA.rFileSize & vbCrLf
strOpen = strOpen & "rParts = " & DA.rParts & vbCrLf
strOpen = strOpen & "rRemain = " & DA.rRemain & vbCrLf
strOpen = strOpen & "rSheetSize = " & DA.rSheetSize & vbCrLf
strOpen = strOpen & "rTime = " & DA.rTime & vbCrLf & vbCrLf
If (intManagement = True) Then
Call cDAPut(DA, 1, 1, 1, 12345)
Call cDAPut(DA, 1, DA.nCols, 1, 56789)
Call cDAPut(DA, DA.nRows, 1, 1, 54321)
Call cDAPut(DA, DA.nRows, DA.nCols, 1, 98765)
Call cDAPut(DA, 1, 1, 2, 12345678)
Call cDAPut(DA, 1, DA.nCols, 2, 34567890)
Call cDAPut(DA, DA.nRows, 1, 2, 123456789)
Call cDAPut(DA, DA.nRows, DA.nCols, 2, 987654321)
End If
strDisplay = strDisplay & "R:1 , C:1 , D:1, Value : " & Trim$(cDAGet(DA, 1, 1, 1)) & " , time : " & DA.rTime & vbCrLf
strDisplay = strDisplay & "R:1 , C:" & DA.nCols & ", D:1, Value : " & Trim$(cDAGet(DA, 1, DA.nCols, 1)) & " , time : " & DA.rTime & vbCrLf
strDisplay = strDisplay & "R:" & DA.nRows & ", C:1 , D:1, Value : " & Trim$(cDAGet(DA, DA.nRows, 1, 1)) & " , time : " & DA.rTime & vbCrLf
strDisplay = strDisplay & "R:" & DA.nRows & ", C:" & DA.nCols & ", D:1, Value : " & Trim$(cDAGet(DA, DA.nRows, DA.nCols, 1)) & " , time : " & DA.rTime & vbCrLf
strDisplay = strDisplay & "R:1 , C:1 , D:2, Value : " & Trim$(cDAGet(DA, 1, 1, 2)) & " , time : " & DA.rTime & vbCrLf
strDisplay = strDisplay & "R:1 , C:" & DA.nCols & ", D:2, Value : " & Trim$(cDAGet(DA, 1, DA.nCols, 2)) & " , time : " & DA.rTime & vbCrLf
strDisplay = strDisplay & "R:" & DA.nRows & ", C:1 , D:2, Value : " & Trim$(cDAGet(DA, DA.nRows, 1, 2)) & " , time : " & DA.rTime & vbCrLf
strDisplay = strDisplay & "R:" & DA.nRows & ", C:" & DA.nCols & ", D:2, Value : " & Trim$(cDAGet(DA, DA.nRows, DA.nCols, 2)) & " , time : " & DA.rTime & vbCrLf
End If
Call cDAClose(DA, False)
lbl_Open = strOpen
lbl_Result = strDisplay
'time the function
TimerHandle = cTimerOpen()
TimerStartOk = cTimerStart(TimerHandle)
For i = 1 To Iteration
strResult = cDACreate(DA, False)
Call cDAClose(DA, False)
Next i
mdiT2W.pnl_Timer = cTimerRead(TimerHandle)
TimerCloseOk = cTimerClose(TimerHandle)
End Sub