烟草核酸管理系统源程序

《烟草核酸管理系统源程序》由会员分享，可在线阅读，更多相关《烟草核酸管理系统源程序（119页珍藏版）》请在装配图网上搜索。

1、烟草核酸数据库管理系统源程序云南省烟草科学研究所2006-12-18源程序旳前10页Imports SystemImports System.ioImports System.TextPublic Class Abitracer 解析一种abi文献 /the next three lines are the important persistent data Private sequence As String Private A(), G(), C(), T(), Basecalls() As Integer Private TraceLength, SeqLength As Integer

2、 /This is the actual file data. Private TraceData() As Byte Private maximum As Integer = 0 /the next four declaration lines comprise the file index information Private MacJunk As Integer = 0 /sometimes when macintosh files are /FTPed in binary form, they have 128 bytes /of crap pre-pended to them. T

3、his constant /allows ABITrace to handle that in a way that /is invisible to the user. Private Shared AbsIndexBase As Integer = 26 /The file location of the Index pointer Private IndexBase, PLOC As Integer Private ATraceStart, CTraceStart, GTraceStart, TTraceStart As Integer /the next declaration is

4、for the actual file pointers Private DATA9, DATA10, DATA11, DATA12, PBAS2, FWO As Integer Private stremtempfile As String = stream Dim Basecalls() As Integer Dim acolor As Color = Color.DarkGreen Dim ccolor As Color = Color.Blue Dim gcolor As Color = Color.Black Dim tcolor As Color = Color.Red Dim n

5、color As Color = Color.Pink Dim abrush As Brush = Brushes.Blue Dim cbrush As Brush = Brushes.Red Dim gbrush As Brush = Brushes.DarkGreen Dim tbrush As Brush = Brushes.Black Dim nbrush As Brush = Brushes.Pink Dim backcolor As Color = Color.White Dim dffont As Font = New Font(Times New Roman, 10) Priv

6、ate myRund, mydate, myDYEP, myMACH, myMODL, myBCAL As String Public lable As String Private errstring Public Function ABITrace(ByVal ABIFile() As Byte) As Boolean initData(ABIFile) If errstring Then Return False Else Return True End If End Function Public Function ABITrace(ByVal ABIFile As String) A

7、s Boolean If ABIFile = Then errstring = 请输入文献！ Return False Exit Function End If Dim bytes() As Byte Dim fs As FileStream Dim reader As BinaryReader Try fs = New FileStream(ABIFile, FileMode.Open) reader = New BinaryReader(fs) bytes = reader.ReadBytes(fs.Length) reader.Close() fs.Close() fs = Nothin

8、g Catch ex As Exception errstring = ex.ToString Return False Exit Function End Try If IsNothing(bytes) Then errstring = 无效文献！ Return False Exit Function End If errstring = initData(bytes) If errstring Then Return False Else Return True End If End Function Private Sub initData(ByVal fileData() As Byt

9、e) TraceData = fileData If isABI() Then setIndex() setBasecalls() setSeq() setTraces() End If End Sub Public Sub getImage(ByRef out As PictureBox, ByVal widthScale As Integer) out.Image = CType(getImage(out.Height, widthScale), Image) End Sub Public Function getImage(ByVal height As Integer, ByVal w

10、idthScale As Double) As Bitmap Dim out As Bitmap out = New Bitmap(CInt(TraceLength * 2 * widthScale), height) out.Width out.Width = TraceLength * widthScale Dim imageHeight As Integer = out.Height out.Height = imageHeight Dim gd As System.Drawing.Graphics Dim mypen As Pen Dim scale As Double scale =

11、 calculateScale(out.Height) Dim bc() As Integer = Basecalls bc可能是定义nt所在旳坐标位置 Dim seq() As Char Dim dfcolor As Color = Color.Black Dim dfbrush = Brushes.Black Dim aa As Brush seq = sequence.ToCharArray gd = Graphics.FromImage(out) gd.Clear(backcolor) Dim here, basenum As Integer here = 0 basenum = 0

12、For q As Integer = 1 To 5 For x As Integer = 0 To 2 * TraceLength - 2 If q = 1 Then 画A旳轨迹 g.setColor(acolor) gd.DrawLine(New Pen(acolor), 2 * x, transmute(A(x), imageHeight, scale), _ 2 * (x + 1), transmute(A(x + 1), imageHeight, scale) End If If q = 2 Then gd.DrawLine(New Pen(ccolor), 2 * x, transm

13、ute(C(x), imageHeight, scale), _ 2 * (x + 1), transmute(C(x + 1), imageHeight, scale) End If If q = 3 Then gd.DrawLine(New Pen(tcolor), 2 * x, transmute(T(x), imageHeight, scale), _ 2 * (x + 1), transmute(T(x + 1), imageHeight, scale) End If If q = 4 Then gd.DrawLine(New Pen(gcolor), 2 * x, transmut

14、e(G(x), imageHeight, scale), _ 2 * (x + 1), transmute(G(x + 1), imageHeight, scale) End If If q = 5 Then 画其他内容旳 If (here bc.Length - 1) Or (basenum seq.Length - 1) Then Exit For If x Mod 30 = 0 Then gd.DrawString(2 * x, dffont, Brushes.Black, _ (2 * x - 3), transmute(-27, imageHeight, 1.0) End If If

15、 (bc(here) = x) Then gd.DrawLine(New Pen(dfcolor), 2 * x, transmute(-2, imageHeight, 1.0), _ 2 * x, transmute(-7, imageHeight, 1.0) If (basenum + 1) Mod 10 = 0) Then /if the basecount is divisible by ten /add a number gd.DrawLine(New Pen(dfcolor), 2 * x, transmute(-20, imageHeight, 1.0), _ 2 * x, tr

16、ansmute(-25, imageHeight, 1.0) gd.DrawString(basenum + 1, dffont, Brushes.Black, _ (2 * x - 3), transmute(-36, imageHeight, 1.0) End If Select Case seq(basenum) Case A, a dfbrush = abrush Case C, c dfbrush = cbrush Case G, g dfbrush = gbrush Case T, t dfbrush = tbrush Case Else dfbrush = nbrush End

17、Select gd.DrawString(seq(basenum), dffont, dfbrush, (2 * x - 3), transmute(-18, imageHeight, 1.0) dfbrush = Brushes.Black here += 1 basenum += 1 End If End If Next Next Return out End Function Public Function getabasebyid(ByVal x As Integer) As Char 输入一种位图坐标，得到相应旳一种base If x sequence.Length - 1 Then

18、 Return R End If Return CType(sequence.Chars(x), Char) End Function Public Function getsiglebase(ByVal x As Integer) As Char 输入一种位图坐标，得到相应旳一种base Dim basenum As Integer = getbaseX(x) MsgBox(basenum) If basenum sequence.Length - 1 Then Return R End If Return CType(sequence.Chars(basenum), Char) End F

19、unction Public Function getbaseX(ByVal x As Integer) As Integer 根据输入旳坐标得到近来base旳索引（x方向） Dim xidx, xs, xsmin As Integer If x 2 * TraceLength Then errstring = 坐标越界！ Return -1 Exit Function End If Dim bc() As Integer = Basecalls xsmin = 2 * TraceLength - 2 For i As Integer = 0 To bc.Length - 1 xs = (x

20、- bc(i) * 2) 2 If xs xsmin Then xsmin = xs xidx = i End If Next MsgBox(xsmin) MsgBox(bc(xidx) bc = Nothing Return xidx End Function Public Function getbaseLX(ByVal seq As String, ByVal count As Integer, ByVal islast As Boolean) As Integer 得到要查找询列旳 Dim idx As Integer idx = getbaseX(seq, count, islast

21、) If idx = -1 Then Return -1 Return Basecalls(idx) * 2 End Function Public Function getbaseLX(ByVal idx As Integer) As Integer 得到要查找询列旳坐标 If idx = Basecalls.Length Then Return -1 Return Basecalls(idx) * 2 End Function Public Function getbaseY_cf(ByVal idx As Integer) As Integer 得到该序列旳置信度 transmute(A

22、(x + 1), imageHeight, scale) If idx sequence.Length - 1 Then Return R End If Dim base As Char = sequence.Chars(idx) Dim YY As Integer() Select Case base Case A, a YY = A lable = A Case T, t YY = T lable = T Case C, c YY = C lable = C Case G, g YY = G lable = G Case Else MsgBox(r) End Select If IsNot

23、hing(YY) Then Return -1 Dim Yidx, xidx As Integer xidx = getbaseLX(idx) If xidx = -1 Then Return -1 Yidx = YY(Basecalls(idx) YY = Nothing Return Yidx End Function Public Function getbaseX(ByVal seq As String, ByVal count As Integer, ByVal islast As Boolean) As Integer 根据序列查找索引 If sequence = Then Ret

24、urn -1 End If seq = seq.ToLower Dim seq1 As String = sequence.ToLower Dim idx, i, x, ass As Integer x = 1 idx = seq1.IndexOf() ass = 0 While i -1 i = seq1.IndexOf(seq) If i -1 Then ass += i + seq.Length seq1 = seq1.Substring(i + seq.Length) End If If x = count Then If i = -1 Then idx = -1 Else idx =

25、 ass End If Exit While End If x += 1 End While If idx = -1 Then Return -1 End If MsgBox(islast) If Not islast Then idx -= seq.Length End If MsgBox(idx) Return idx Return Basecalls(idx) * 2 注意这里要不要*2 End Function Private Sub setIndex() Dim DataCounter, PBASCounter, PLOCCounter, NumRecords As Integer

26、Dim RecNameArray(3) As Byte Dim RecName As String Dim record = 0 Dim myRund1, mydate1, myDYEP1, myMACH1, myMODL1, myBCAL1 As Integer DataCounter = 0 PBASCounter = 0 PLOCCounter = 0 IndexBase = getIntAt(AbsIndexBase + MacJunk) NumRecords = getIntAt(AbsIndexBase - 8 + MacJunk) For record = 0 To NumRec

27、ords - 1 getSubArray(RecNameArray, (IndexBase + (record * 28) RecName = ToString_ASC(RecNameArray) If RecName = FWO_ Then FWO = IndexBase + (record * 28) + 20 If RecName = DATA Then DataCounter += 1 If (DataCounter = 9) Then DATA9 = IndexBase + (record * 28) + 20 If (DataCounter = 10) Then DATA10 =

28、IndexBase + (record * 28) + 20 If (DataCounter = 11) Then DATA11 = IndexBase + (record * 28) + 20 If (DataCounter = 12) Then DATA12 = IndexBase + (record * 28) + 20 End If If RecName = PBAS Then PBASCounter += 1 If (PBASCounter = 2) Then PBAS2 = IndexBase + (record * 28) + 20 End If If RecName = PLO

29、C Then PLOCCounter += 1 If (PLOCCounter = 2) Then PLOC = IndexBase + (record * 28) + 20 End If Private myRund, mydate, myDYEP, myMACH, myMODL, myBCAL As String If RecName.ToUpper = RUND Then myRund1 = IndexBase + (record * 28) + 20 End If If RecName.ToUpper = DATE Then myRund1 = IndexBase + (record

30、* 28) + 20 End If If RecName.ToUpper = DYEP Then myRund1 = IndexBase + (record * 28) + 20 End If If RecName.ToUpper = MACH Then myRund1 = IndexBase + (record * 28) + 20 End If If RecName.ToUpper = BCAL Then myRund1 = IndexBase + (record * 28) + 20 End If If RecName.ToUpper = MODL Then myRund1 = Inde

31、xBase + (record * 28) + 20 End If Next TraceLength = getIntAt(DATA12 - 8) SeqLength = getIntAt(PBAS2 - 4) PLOC = getIntAt(PLOC) + MacJunk DATA9 = getIntAt(DATA9) + MacJunk DATA10 = getIntAt(DATA10) + MacJunk DATA11 = getIntAt(DATA11) + MacJunk DATA12 = getIntAt(DATA12) + MacJunk PBAS2 = getIntAt(PBA

32、S2) + MacJunk myRund = getIntAt(PBAS2) + MacJunk mydate = getIntAt(PBAS2) + MacJunk myDYEP = getIntAt(PBAS2) + MacJunk myMACH = getIntAt(PBAS2) + MacJunk myMODL = getIntAt(PBAS2) + MacJunk myBCAL = getIntAt(PBAS2) + MacJunk End Sub Private Sub setBasecalls() Dim baselenth As Integer = SeqLength - 1

33、ReDim Basecalls(baselenth) Dim qq(baselenth * 2) As Byte Dim i As Integer getSubArray(qq, PLOC) Dim readint As New Abitracer.mystream For i = 0 To SeqLength - 1 Try Basecalls(i) = readint.read_int16_next(qq) Catch ex As Exception errstring = ex.ToString End Try Next readint = Nothing End Sub Private

34、 Sub setSeq() Dim x As Integer Dim tempseq(SeqLength - 1) As Char For x = 0 To SeqLength - 1 tempseq(x) = ChrW(TraceData(PBAS2 + x) Next sequence = ToString_char(tempseq) End Sub Private Sub setTraces() Dim pointers(3) As Integer alphabetical, 0=A, 1=C, 2=G, 3=T Dim datas(3) As Integer Dim order(3)

35、As Char Dim i As Integer datas(0) = DATA9 datas(1) = DATA10 datas(2) = DATA11 datas(3) = DATA12 For i = 0 To 3 order(i) = ChrW(TraceData(FWO + i) Next For i = 0 To 3 Select Case order(i) Case a, A pointers(0) = datas(0) Case c, C pointers(1) = datas(1) Case g, G pointers(2) = datas(2) Case t, T poin

36、ters(3) = datas(3) Case Else errstring = Trace contains illegal values! MsgBox() Exit Sub End Select Next ReDim A(2 * TraceLength - 1) ReDim C(2 * TraceLength - 1) ReDim G(2 * TraceLength - 1) ReDim T(2 * TraceLength - 1) For i = 0 To 3 Dim qq(TraceLength * 2 - 1) As Byte getSubArray(qq, pointers(i)

37、 Dim x As Integer Dim rd As New mystream For x = 0 To 2 * TraceLength - 1 Try If (i = 0) Then A(x) = rd.read_int16_next(qq) If (i = 1) Then C(x) = rd.read_int16_next(qq) If (i = 2) Then G(x) = rd.read_int16_next(qq) If (i = 3) Then T(x) = rd.read_int16_next(qq) Catch ex As Exception errstring = ex.T

38、oString End Try Next rd = Nothing Next End Sub Private Function isABI() As Boolean Dim ABI(3) As Char Dim i, n As Integer For i = 0 To 2 ABI(i) = ChrW(TraceData(i) Next If ABI(0) = A And ABI(1) = B And ABI(2) = I Then Return True Else For i = 128 To 130 ABI(i) = ChrW(TraceData(i) Next If ABI(0) = A

39、And ABI(1) = B And ABI(2) = I Then Return True Else Return False End If End If End Function Private Function getIntAt(ByVal pointer As Integer) As Integer Dim out As Integer = 0 Dim temp() As Byte = New Byte(3) getSubArray(temp, pointer) Dim mystm As New mystream out = mystm.read_int32(temp) mystm =

40、 Nothing aa = Me.ToString_Uni(temp) Return out End Function Private Sub getSubArray(ByRef b As Byte(), ByVal traceDataOffset As Integer) Dim x As Integer Dim aa As Byte For x = 0 To b.Length - 1 aa = TraceData(traceDataOffset + x) b(x) = aa Next End Sub Private Function calculateScale(ByVal height A

41、s Integer) As Double Dim newScale As Double = 0.0 Dim max As Double = getMaximum() Dim ht As Double = height newScale = (ht - 50.0) / max Return newScale End Function Private Function transmute(ByVal ya As Integer, ByVal height As Integer, ByVal scale As Double) As Integer Return (height - 45 - CInt

42、(ya * scale) End Function Private Function getMaximum() As Integer If (maximum 0) Then Return maximum Dim max As Integer = 0 For x As Integer = 0 To T.Length - 1 If (T(x) max) Then max = T(x) If (A(x) max) Then max = A(x) If (C(x) max) Then max = C(x) If (G(x) max) Then max = G(x) Next Return max En

43、d Function =如下是必要旳字符串#Region 字符解决函数 Private Function ToString_ASC(ByVal bytes() As Byte) As String Dim encoding As New ASCIIEncoding Dim constructedString As String = encoding.GetString(bytes) Return constructedString End Function Private Function ToString_Uni(ByVal bytes() As Byte) As String Dim en

44、coding As New UnicodeEncoding Dim constructedString As String = encoding.GetString(bytes) Return constructedString End Function Private Function ToString_char(ByVal chars() As Char) As String Dim aa, bb As String bb = For Each aa In chars bb &= aa Next Return bb End Function Public Function read_int32(ByVal bt() As Byte) As Int32 Dim aa As By