| 0,0 → 1,1043 |
|---|
| VERSION 5.00 |
| Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" |
| Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" |
| Begin VB.Form Form1 |
| BorderStyle = 4 'Fixed ToolWindow |
| Caption = "LOG.AN." |
| ClientHeight = 8700 |
| ClientLeft = 45 |
| ClientTop = 285 |
| ClientWidth = 10005 |
| BeginProperty Font |
| Name = "Tahoma" |
| Size = 8.25 |
| Charset = 238 |
| Weight = 400 |
| Underline = 0 'False |
| Italic = 0 'False |
| Strikethrough = 0 'False |
| EndProperty |
| Icon = "Form1.frx":0000 |
| LinkTopic = "Form1" |
| MaxButton = 0 'False |
| MinButton = 0 'False |
| ScaleHeight = 8700 |
| ScaleWidth = 10005 |
| ShowInTaskbar = 0 'False |
| StartUpPosition = 2 'CenterScreen |
| Begin VB.Frame Frame2 |
| Caption = "GRAFICKE VYJADRENI" |
| Height = 5175 |
| Left = 5640 |
| TabIndex = 15 |
| Top = 120 |
| Width = 4335 |
| Begin VB.CommandButton CTEXT |
| Caption = "Vymazat vypoctenou drahu" |
| Height = 255 |
| Left = 120 |
| TabIndex = 21 |
| Top = 4800 |
| Width = 4095 |
| End |
| Begin VB.CommandButton CLOG |
| Caption = "Vymazat log" |
| Height = 255 |
| Left = 120 |
| TabIndex = 20 |
| Top = 4560 |
| Width = 4095 |
| End |
| Begin VB.CommandButton Command1 |
| Caption = "* vymazat *" |
| Height = 255 |
| Left = 2400 |
| TabIndex = 19 |
| Top = 1800 |
| Width = 1695 |
| End |
| Begin VB.CommandButton Command2 |
| Caption = "Vykreslit" |
| BeginProperty Font |
| Name = "Tahoma" |
| Size = 9 |
| Charset = 238 |
| Weight = 700 |
| Underline = 0 'False |
| Italic = 0 'False |
| Strikethrough = 0 'False |
| EndProperty |
| Height = 495 |
| Left = 2400 |
| TabIndex = 18 |
| Top = 1320 |
| Width = 1695 |
| End |
| Begin MSComctlLib.Slider Slider1 |
| Height = 375 |
| Left = 120 |
| TabIndex = 16 |
| Top = 720 |
| Width = 4095 |
| _ExtentX = 7223 |
| _ExtentY = 661 |
| _Version = 393216 |
| Max = 31 |
| End |
| Begin VB.CommandButton Command3 |
| Caption = "Ulozit graf" |
| BeginProperty Font |
| Name = "Tahoma" |
| Size = 8.25 |
| Charset = 238 |
| Weight = 700 |
| Underline = 0 'False |
| Italic = 0 'False |
| Strikethrough = 0 'False |
| EndProperty |
| Height = 615 |
| Left = 2400 |
| TabIndex = 22 |
| Top = 2160 |
| Width = 1695 |
| End |
| Begin VB.Label Label3 |
| Caption = "Cast (0 az 32 po 32 bodech z vypoctene 128 vlevo):" |
| Height = 255 |
| Left = 240 |
| TabIndex = 17 |
| Top = 360 |
| Width = 3855 |
| End |
| End |
| Begin VB.PictureBox pY |
| Appearance = 0 'Flat |
| BackColor = &H80000005& |
| ForeColor = &H80000008& |
| Height = 4575 |
| Left = 0 |
| ScaleHeight = 4545 |
| ScaleWidth = 0 |
| TabIndex = 13 |
| Top = 0 |
| Width = 15 |
| End |
| Begin VB.PictureBox pX |
| Appearance = 0 'Flat |
| BackColor = &H80000005& |
| ForeColor = &H80000008& |
| Height = 15 |
| Left = 0 |
| ScaleHeight = 0 |
| ScaleWidth = 6705 |
| TabIndex = 12 |
| Top = 0 |
| Width = 6735 |
| End |
| Begin VB.TextBox LOGBOX |
| Height = 1335 |
| Left = 120 |
| Locked = -1 'True |
| MultiLine = -1 'True |
| ScrollBars = 2 'Vertical |
| TabIndex = 7 |
| Top = 3960 |
| Width = 5415 |
| End |
| Begin VB.TextBox TestText |
| BeginProperty Font |
| Name = "Fixedsys" |
| Size = 9 |
| Charset = 238 |
| Weight = 400 |
| Underline = 0 'False |
| Italic = 0 'False |
| Strikethrough = 0 'False |
| EndProperty |
| Height = 1935 |
| Left = 120 |
| Locked = -1 'True |
| MultiLine = -1 'True |
| ScrollBars = 3 'Both |
| TabIndex = 6 |
| Top = 1920 |
| Width = 5415 |
| End |
| Begin VB.Frame Frame1 |
| Caption = "VYPOCET" |
| Height = 1695 |
| Left = 120 |
| TabIndex = 0 |
| Top = 120 |
| Width = 5415 |
| Begin VB.ComboBox Combo128 |
| Height = 315 |
| ItemData = "Form1.frx":0442 |
| Left = 1080 |
| List = "Form1.frx":045E |
| TabIndex = 11 |
| Text = "1" |
| Top = 1200 |
| Width = 735 |
| End |
| Begin VB.ComboBox Combo1024 |
| Height = 315 |
| ItemData = "Form1.frx":047A |
| Left = 1080 |
| List = "Form1.frx":0487 |
| TabIndex = 10 |
| Text = "1" |
| Top = 840 |
| Width = 735 |
| End |
| Begin VB.CommandButton exStart |
| Caption = "Spustit" |
| BeginProperty Font |
| Name = "Tahoma" |
| Size = 9 |
| Charset = 238 |
| Weight = 700 |
| Underline = 0 'False |
| Italic = 0 'False |
| Strikethrough = 0 'False |
| EndProperty |
| Height = 375 |
| Left = 3120 |
| TabIndex = 4 |
| Top = 1200 |
| Width = 2175 |
| End |
| Begin VB.CommandButton exBwseTgt |
| Caption = "..." |
| Height = 285 |
| Left = 4920 |
| TabIndex = 3 |
| Top = 350 |
| Width = 375 |
| End |
| Begin VB.TextBox exTgtGETFROM |
| Appearance = 0 'Flat |
| Height = 285 |
| Left = 1080 |
| TabIndex = 2 |
| Top = 350 |
| Width = 3855 |
| End |
| Begin VB.Label Label2 |
| Caption = "128 :" |
| Height = 255 |
| Left = 120 |
| TabIndex = 9 |
| Top = 1240 |
| Width = 975 |
| End |
| Begin VB.Label Label1 |
| Caption = "1024 :" |
| Height = 255 |
| Left = 120 |
| TabIndex = 8 |
| Top = 880 |
| Width = 975 |
| End |
| Begin VB.Label STATUS |
| Alignment = 2 'Center |
| Caption = "READY" |
| BeginProperty Font |
| Name = "Tahoma" |
| Size = 9.75 |
| Charset = 238 |
| Weight = 700 |
| Underline = 0 'False |
| Italic = 0 'False |
| Strikethrough = 0 'False |
| EndProperty |
| ForeColor = &H00FF0000& |
| Height = 375 |
| Left = 3120 |
| TabIndex = 5 |
| Top = 800 |
| Width = 2175 |
| End |
| Begin VB.Label exLblImage |
| Caption = "Soubor:" |
| Height = 255 |
| Left = 120 |
| TabIndex = 1 |
| Top = 360 |
| Width = 975 |
| End |
| End |
| Begin MSComDlg.CommonDialog CD1 |
| Left = 0 |
| Top = 0 |
| _ExtentX = 847 |
| _ExtentY = 847 |
| _Version = 393216 |
| End |
| Begin VB.PictureBox Picture1 |
| Appearance = 0 'Flat |
| BackColor = &H00C0C0C0& |
| ForeColor = &H80000008& |
| Height = 3255 |
| Left = 120 |
| ScaleHeight = 3225 |
| ScaleWidth = 9825 |
| TabIndex = 14 |
| Top = 5400 |
| Width = 9855 |
| End |
| Begin MSComDlg.CommonDialog CD2 |
| Left = 480 |
| Top = 0 |
| _ExtentX = 847 |
| _ExtentY = 847 |
| _Version = 393216 |
| End |
| End |
| Attribute VB_Name = "Form1" |
| Attribute VB_GlobalNameSpace = False |
| Attribute VB_Creatable = False |
| Attribute VB_PredeclaredId = True |
| Attribute VB_Exposed = False |
| '############################################################ |
| '# # |
| '# PROJEKT LOG.AN. by Michal Frdlík 2005/2006 # |
| '# (MSD) 2005/2006 # |
| '# # |
| '# kod v tomto programu neni snadny na pochopeni a uz # |
| '# vubec neni pro zacatecniky ve VB !! Popisky jsou # |
| '# urceny pro pokrocile. # |
| '# # |
| '############################################################ |
| |
| Dim nulaX As Single |
| Dim nulaY As Single |
| Dim a ' cast GearBoxu, "a" je jedna ze tri 1024 v souboru |
| Dim b ' cast GearBoxu, "b" je jedna z 8mi casti jednoho ze tri "a" |
| Dim GCH ' Tohle je charakter, kterej se pouzije pro linii |
| |
| |
| '''''''''''''''''''''''''''''' |
| Const RC_PALETTE As Long = &H100 |
| Const SIZEPALETTE As Long = 104 |
| Const RASTERCAPS As Long = 38 |
| Private Type PALETTEENTRY |
| peRed As Byte |
| peGreen As Byte |
| peBlue As Byte |
| peFlags As Byte |
| End Type |
| Private Type LOGPALETTE |
| palVersion As Integer |
| palNumEntries As Integer |
| palPalEntry(255) As PALETTEENTRY ' Enough for 256 colors |
| End Type |
| Private Type GUID |
| Data1 As Long |
| Data2 As Integer |
| Data3 As Integer |
| Data4(7) As Byte |
| End Type |
| Private Type PicBmp |
| Size As Long |
| Type As Long |
| hBmp As Long |
| hPal As Long |
| Reserved As Long |
| End Type |
| Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long |
| Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long |
| Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long |
| Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long |
| Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal iCapabilitiy As Long) As Long |
| Private Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long |
| Private Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long |
| Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long |
| Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long |
| Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long |
| Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long |
| Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long |
| Public Function hDCToPicture(ByVal hDCSrc As Long, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture |
| Dim hDCMemory As Long, hBmp As Long, hBmpPrev As Long, R As Long |
| Dim hPal As Long, hPalPrev As Long, RasterCapsScrn As Long, HasPaletteScrn As Long |
| Dim PaletteSizeScrn As Long, LogPal As LOGPALETTE |
| |
| 'Create a compatible device context |
| hDCMemory = CreateCompatibleDC(hDCSrc) |
| 'Create a compatible bitmap |
| hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc) |
| 'Select the compatible bitmap into our compatible device context |
| hBmpPrev = SelectObject(hDCMemory, hBmp) |
| |
| 'Raster capabilities? |
| RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster |
| 'Does our picture use a palette? |
| HasPaletteScrn = RasterCapsScrn And RC_PALETTE ' Palette |
| 'What's the size of that palette? |
| PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of |
| |
| If HasPaletteScrn And (PaletteSizeScrn = 256) Then |
| 'Set the palette version |
| LogPal.palVersion = &H300 |
| 'Number of palette entries |
| LogPal.palNumEntries = 256 |
| 'Retrieve the system palette entries |
| R = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0)) |
| 'Create the palette |
| hPal = CreatePalette(LogPal) |
| 'Select the palette |
| hPalPrev = SelectPalette(hDCMemory, hPal, 0) |
| 'Realize the palette |
| R = RealizePalette(hDCMemory) |
| End If |
| |
| 'Copy the source image to our compatible device context |
| R = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy) |
| |
| 'Restore the old bitmap |
| hBmp = SelectObject(hDCMemory, hBmpPrev) |
| |
| If HasPaletteScrn And (PaletteSizeScrn = 256) Then |
| 'Select the palette |
| hPal = SelectPalette(hDCMemory, hPalPrev, 0) |
| End If |
| |
| 'Delete our memory DC |
| R = DeleteDC(hDCMemory) |
| |
| Set hDCToPicture = CreateBitmapPicture(hBmp, hPal) |
| End Function |
| Public Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture |
| Dim R As Long, Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID |
| |
| 'Fill GUID info |
| With IID_IDispatch |
| .Data1 = &H20400 |
| .Data4(0) = &HC0 |
| .Data4(7) = &H46 |
| End With |
| |
| 'Fill picture info |
| With Pic |
| .Size = Len(Pic) ' Length of structure |
| .Type = vbPicTypeBitmap ' Type of Picture (bitmap) |
| .hBmp = hBmp ' Handle to bitmap |
| .hPal = hPal ' Handle to palette (may be null) |
| End With |
| |
| 'Create the picture |
| R = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic) |
| |
| 'Return the new picture |
| Set CreateBitmapPicture = IPic |
| End Function |
| '''''''''''''''''''''''''''''' |
| |
| Private Sub CLOG_Click() 'vymzat log |
| LOGBOX.Text = "" |
| End Sub |
| |
| Private Sub Command1_Click() |
| Picture1.Cls |
| Call init |
| End Sub |
| |
| Private Sub Command2_Click() |
| On Error GoTo ErrHand |
| Picture1.Cls |
| Call init |
| |
| Dim All |
| All = TestText.Text |
| Dim X0 |
| Dim X1 |
| All = Strings.Left(All, 2050) |
| |
| X0 = Strings.Left(All, 1024) |
| X1 = Strings.Right(All, 1024) |
| |
| For i = 1 To 32 |
| Select Case (Mid(X0, (32 * Slider1.Value) + i, 1)) |
| Case GCH |
| XY XJplus(i), YJplus(6), XJplus(i + 1), YJplus(6), 2, vbBlue |
| If (Mid(X0, (32 * Slider1.Value) + i + 1, 1)) = " " Then |
| XY XJplus(i + 1), YJplus(6), XJplus(i + 1), YJplus(1), 2, vbBlue |
| End If |
| Case " " |
| |
| End Select |
| Select Case (Mid(X1, (32 * Slider1.Value) + i, 1)) |
| Case GCH |
| XY XJplus(i), YJplus(1), XJplus(i + 1), YJplus(1), 2, vbBlue |
| If (Mid(X1, (32 * Slider1.Value) + i + 1, 1)) = " " Then |
| XY XJplus(i + 1), YJplus(1), XJplus(i + 1), YJplus(6), 2, vbBlue |
| End If |
| Case " " |
| |
| End Select |
| Next i |
| |
| Exit Sub |
| ErrHand: |
| MsgBox Err.Description, vbCritical, "ERROR!" |
| End Sub |
| |
| Private Sub Command3_Click() |
| On Error GoTo ErrHand |
| CD2.Filter = "*.bmp - bitmapa | *.bmp" |
| CD2.ShowSave |
| If CD2.FileName = "" Then |
| Exit Sub |
| End If |
| |
| Dim pointX As Long |
| Dim pointY As Long |
| pointX = ((Form1.Left + Form1.Picture1.Left) + (Form1.Picture1.Width - Form1.Picture1.ScaleWidth)) / Screen.TwipsPerPixelX |
| pointY = ((Form1.Top + Form1.Picture1.Top) + (Form1.Height - Form1.ScaleHeight)) / Screen.TwipsPerPixelY |
| Set Form1.Picture = hDCToPicture(GetDC(0), pointX, pointY, Form1.Picture1.ScaleWidth / Screen.TwipsPerPixelX, Form1.Picture1.ScaleHeight / Screen.TwipsPerPixelY) |
| SavePicture Form1.Picture, CD2.FileName |
| Form1.Picture = LoadPicture |
| |
| Exit Sub |
| ErrHand: |
| MsgBox Err.Description, vbCritical, "ERROR!" |
| End Sub |
| |
| Private Sub CTEXT_Click() 'vymazat graf |
| TestText.Text = "" |
| End Sub |
| |
| Private Sub exBwseTgt_Click() 'dialog Browse |
| CD1.FileName = "" |
| CD1.CancelError = False |
| CD1.DialogTitle = "Browse for File" |
| CD1.Filter = "*.* == All files | *.*" |
| CD1.ShowOpen |
| exTgtGETFROM.Text = CD1.FileName |
| End Sub |
| |
| Public Function DecToBin(lgNbDec As Long, lgBase As Long) As String |
| On Error GoTo ErrHand |
| 'prevod Decimalni->Binarni |
| Dim stResultat As String |
| Dim lgDec As Long, lgK As Long |
| If lgNbDec < 0 Then lgK = 1 |
| lgDec = Abs(lgNbDec) |
| Do While lgDec <> 0 |
| stResultat = (lgDec + lgK) Mod 2 & stResultat |
| lgDec = lgDec \ 2 |
| Loop |
| DecToBin = Right$(String$(lgBase, CStr(lgK)) & stResultat, lgBase) |
| |
| Exit Function |
| ErrHand: |
| MsgBox Err.Description, vbCritical, "ERROR!" |
| End Function |
| |
| Private Sub exStart_Click() |
| On Error GoTo ErrHand |
| |
| '######################################################## |
| '# # |
| '# VYKONNE JADRO LOG.AN. (MSD)2005 # |
| '# # |
| '######################################################## |
| |
| On Error GoTo FuckOff 'kdyz chyba, pak FuckOff |
| |
| 'GEARBOX: |
| a = CInt(Combo1024.Text) ' Tak co tam mame |
| b = CInt(Combo128.Text) ' nestaveny v tech comboboxech ... |
| '####### |
| |
| STATUS.Caption = "BUSY OR ERR" ' Pomalejsi pocitac tohle sotva zaregsitruje, |
| ' ale aby si nemyslel, ze se mu to seklo |
| |
| Log ("ANALYZUJI SOUBOR...") ' Zapiseme do logu informaci |
| Dim nFileNum As Integer ' Neco jako volny handle |
| nFileNum = FreeFile ' k souboru |
| |
| Dim PocetSekvenci ' tady bude pocet 1024 sekvenci v souboru |
| PocetSekvenci = 0 ' pokud budu pracovat pouze s tvojema souborama, mohl |
| ' bych tam dat konstantne 3 a upravit kod, ale to |
| ' se nedela ... |
| Dim VysledneSekvence(1 To 10, 1 To 1024) ' tady budou 3 sekvence 1024 |
| ' dal jsem tam, ale radsi 10 misto 3 ... |
| ' kdyby neco nehralo |
| Dim Temp As Byte ' to co zrovna prectu |
| Dim Large() As Byte ' tady bude celej soubor |
| Dim Zapocata1024 As Boolean ' tohle je tu prakticky i teoreticky k nicemu... |
| Dim CurrentSekvence1024 ' inkrementator pohybu v sekvenci |
| Dim Sekvence1024() As Byte ' docasne misto pro jednu sekvenci |
| |
| ReDim Large(FileLen(exTgtGETFROM.Text)) ' predimenzujeme si pole tak, aby melo |
| ' velikost celeho souboru |
| |
| '### NAHRAJI DO PAMETI BAJTY V SOUBORU V DECIMALNIM FORMATU |
| |
| Log ("Pokusim se o pristup do souboru " & exTgtGETFROM.Text & "...") |
| Open exTgtGETFROM.Text For Binary Access Read Lock Read Write As #nFileNum ' otevrit |
| Log ("Pristup povolen") |
| Log ("Nactu do pameti bajty...") |
| For i = 0 To FileLen(exTgtGETFROM.Text) |
| Get #nFileNum, i + 1, Temp ' nacist vsechny bajty |
| ' to "+1" je tam proto, protoze funkce |
| ' Get poctita 1 misto 0 jako zacatek souboru |
| Large(i) = Temp |
| Next i |
| Log ("Bajty nacteny") |
| Close #nFileNum |
| Log ("Zaviram soubor") |
| |
| ' tak uz mam nactenej soubor, ted se v nem budu prehrabovat ... |
| |
| '### VYHLEDAM SEKVENCE O 1024 BAJTECH A ULOZIM JE DO POLE |
| |
| Log ("Budu hledat sekvence o 1024 bajtech...") |
| For n = 0 To FileLen(exTgtGETFROM.Text) |
| If Large(n) = 0 Then ' jestlize nejsem v sekvenci |
| If CurrentSekvence1024 = 1024 Then 'jestli je sekvence kompletni |
| Log ("Sekvence o 1024 bajtech nalezena!") |
| PocetSekvenci = PocetSekvenci + 1 |
| For xx = 1 To 1024 'Zapis sekvenci jako jeden z vysledku |
| VysledneSekvence(PocetSekvenci, xx) = Sekvence1024(xx - 1) |
| Next xx |
| End If |
| Zapocata1024 = False |
| CurrentSekvence1024 = 0 'vynulovat pocitadlo |
| GoTo SKIP__ONE ' tohle tu nemusi bejt, protoze to tak jak tak jde hned na konec |
| Else ' jinak |
| Zapocata1024 = True |
| ReDim Preserve Sekvence1024(CurrentSekvence1024) ' predimenzuj pole s funkci |
| ' zachrany soucasnych dat |
| ' (preserve) na aktualni |
| ' velikost sekvence a |
| |
| Sekvence1024(CurrentSekvence1024) = Large(n) ' zapis vysledek |
| CurrentSekvence1024 = CurrentSekvence1024 + 1 ' inc. |
| End If |
| |
| SKIP__ONE: |
| Next n |
| |
| Log ("Celkem sekvenci o 1024 bajtech: " & PocetSekvenci) |
| |
| ' tak a mame pole v trema 1024 sekvencema, ted uz zbyva je rozdelit do |
| ' 24 128 sekvenci a tak dale a tak dale .... |
| |
| '### ROZDELIM TYTO 1024 BITOVE SEKVENCE DO 24 128 BITOVYCH |
| '### A VSE SETRIDIM DO PREHLEDNEHO POLE |
| |
| Log ("Budu tridit 1024sekvence do pole...") |
| Dim Temp128(1 To 128) ' nevyuzita promenna=) |
| Dim Multiple128() |
| ReDim Multiple128(1 To PocetSekvenci, 1 To 8, 1 To 128) 'nase prehledny pole |
| |
| For qq = 1 To PocetSekvenci |
| For ww = 1 To 8 |
| For ee = 1 To 128 |
| Multiple128(qq, ww, ee) = VysledneSekvence(qq, ((128 * ww) - 128) + ee) |
| ' tenhle zakrok uklada do pole 3,8,128 a pocita s posunem pocatku... |
| ' doufam, ze je to jasny |
| Next ee |
| Next ww |
| Next qq |
| Log ("Roztrizeno") |
| |
| ' a ted prevod do bin,8 |
| |
| '### PREVEDU DO BINARNIHO FORMATU |
| |
| Log ("Budu prevadet do binarniho formatu o zakladu 8...") |
| Dim Bin128() As String |
| ReDim Bin128(1 To PocetSekvenci, 1 To 8, 1 To 128) As String |
| |
| For qqq = 1 To PocetSekvenci |
| For www = 1 To 8 |
| For eee = 1 To 128 |
| Bin128(qqq, www, eee) = DecToBin(CLng(Multiple128(qqq, www, eee)), 8) |
| Next eee |
| Next www |
| Next qqq |
| Log ("Prevedeno") |
| Log ("ANALYZA DOKONCENA BEZ CHYB") |
| |
| '################################################### |
| '### SIMULACE GRAFICKEHO SUBSYSTEMU ################ |
| '################################################### |
| |
| ' Toto je znamy "derny stitek" |
| |
| Log ("SPOUSTIM SIMULACI GRAFICKEHO SUBSYSTEMU...") |
| |
| Dim BIGG ' tohle je 1024 charakteru dlouha pomlcak |
| For biggc = 1 To 1024 |
| BIGG = BIGG & "-" |
| Next biggc |
| |
| Dim Glyph ' tady bude vysledek |
| Dim GlyphX0 ' osa X, status Y=0 |
| Dim GlyphX1 ' osa X, status Y=1 |
| Dim DownGlyph ' popisky na ose X |
| Dim TempChar ' docasne misto pro prave nactenej neco... |
| |
| Log ("Zpracovavam linii grafu...") |
| |
| Log ("Manualne nastaveno a=" & CStr(a) & " b=" & CStr(b)) |
| Log ("sekv. " & CStr(a) & "/" & PocetSekvenci & "; sekv." & CStr(b) & "/8") |
| |
| For gl1a = 1 To 128 |
| For gl1b = 1 To 8 |
| TempChar = Mid(CStr(Bin128(a, b, gl1a)), (gl1b), 1) |
| ' Tohle je moc Basicovsky a je to takova lepsi prace se stringy, |
| ' muze se stat ze ti to nebude moc jasny. Funkce Mid, vraci znaky, |
| ' ktere jsou dany parametrem, odkud a kolik =). |
| Select Case TempChar ' mame nula nebo jedna? jestli nula tak, v jedna |
| ' bude mezera a v nula znak, vice versa. |
| Case "0" |
| GlyphX0 = GlyphX0 & GCH |
| GlyphX1 = GlyphX1 & " " |
| Case "1" |
| GlyphX0 = GlyphX0 & " " |
| GlyphX1 = GlyphX1 & GCH |
| End Select |
| DownGlyph = DownGlyph & TempChar |
| Next gl1b |
| Next gl1a |
| |
| Log ("Zpracovano") |
| |
| Log ("Vykresluji...") |
| |
| Glyph = "" & GlyphX1 & vbCrLf & _ |
| "" & GlyphX0 & vbCrLf & _ |
| BIGG & vbCrLf & _ |
| DownGlyph & vbCrLf 'vysledek |
| |
| TestText.Text = Glyph 'vykreslim |
| |
| Log ("Vykresleno") |
| |
| |
| Log ("UKONCUJI SIMULACI GRAFICKEHO SUBSYSTEMU") |
| Log ("ALGORITMUS UKONCEN") |
| STATUS.Caption = "READY" |
| |
| Exit Sub |
| |
| FuckOff: |
| Log ("#CHYBA: Potrebujes soubor obsahujici 3 sekvence 1024 bajtu oddelene minimalne jednou nulou !!!") |
| |
| Exit Sub |
| ErrHand: |
| MsgBox Err.Description, vbCritical, "ERROR!" |
| End Sub |
| |
| Public Function Log(Str) |
| LOGBOX.Text = LOGBOX.Text & Time & ": " & Str & vbCrLf |
| End Function |
| |
| Private Sub Form_Load() |
| On Error GoTo ErrHand |
| GCH = "¤" |
| |
| pX.Top = (Picture1.Top + (Picture1.Height / 2)) |
| pX.Left = Picture1.Left |
| pY.Left = (Picture1.Left + (Picture1.Width / 20)) |
| pY.Top = Picture1.Top |
| pX.Width = Picture1.Width |
| |
| nulaY = Picture1.Height / 2 |
| nulaX = Picture1.Width / 20 |
| |
| Call init |
| |
| Exit Sub |
| ErrHand: |
| MsgBox Err.Description, vbCritical, "ERROR!" |
| End Sub |
| |
| |
| |
| |
| |
| |
| '################################################ |
| '################################################ |
| Public Function Spoj(AnoNe As Boolean) |
| |
| Select Case AnoNe |
| Case True |
| dravv = True |
| Case False |
| dravv = False |
| End Select |
| |
| End Function |
| |
| Public Function PxPy(zeroX As Single, zeroY As Single, destX As Single, destY As Single, Wdt As Long, Sclr As ColorConstants) |
| |
| Pencil Picture1, zeroX, zeroY, Wdt, 1, Sclr |
| Pencil Picture1, XJplus(destX), YJplus(destY), Wdt, 1, Sclr |
| dravv = False |
| |
| End Function |
| Public Function PxMy(zeroX As Single, zeroY As Single, destX As Single, destY As Single, Wdt As Long, Sclr As ColorConstants) |
| |
| Pencil Picture1, zeroX, zeroY, Wdt, 1, Sclr |
| Pencil Picture1, XJplus(destX), YJminus(destY), Wdt, 1, Sclr |
| dravv = False |
| |
| End Function |
| |
| Public Function MxPy(zeroX As Single, zeroY As Single, destX As Single, destY As Single, Wdt As Long, Sclr As ColorConstants) |
| |
| Pencil Picture1, zeroX, zeroY, Wdt, 1, Sclr |
| Pencil Picture1, XJminus(destX), YJplus(destY), Wdt, 1, Sclr |
| dravv = False |
| |
| End Function |
| |
| Public Function MxMy(zeroX As Single, zeroY As Single, destX As Single, destY As Single, Wdt As Long, Sclr As ColorConstants) |
| |
| Pencil Picture1, zeroX, zeroY, Wdt, 1, Sclr |
| Pencil Picture1, XJminus(destX), YJminus(destY), Wdt, 1, Sclr |
| dravv = False |
| |
| End Function |
| |
| Public Function XY(zeroX As Single, zeroY As Single, destX As Single, destY As Single, Wdt As Long, Sclr As ColorConstants) |
| |
| Pencil Picture1, zeroX, zeroY, Wdt, 1, Sclr |
| Pencil Picture1, destX, destY, Wdt, 1, Sclr |
| dravv = False |
| |
| End Function |
| |
| |
| |
| Private Sub init() |
| |
| 'POZOR!!!!! |
| 'toto je neoptimalizovany kod, pouzil jsem Ctrl+C Ctrl+V z jednoho |
| 'ze svych straych projektu, kdy jsem jeste nepouzival cykly |
| 'for...next ; POUZE TATO CAST JE NEOPTIMALIZOVANA !!!!!!! |
| |
| |
| Pencil Picture1, Xminus(0), Yplus(25), 1, 1, vbBlack |
| Pencil Picture1, Xminus(10), Yplus(25), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xminus(0), Yplus(150), 1, 1, vbBlack |
| Pencil Picture1, Xminus(10), Yplus(150), 1, 1, vbBlack |
| dravv = False |
| |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' |
| |
| Pencil Picture1, Xplus(25), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xplus(25), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xplus(50), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xplus(50), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xplus(75), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xplus(75), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xplus(100), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xplus(100), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xplus(125), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xplus(125), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xplus(150), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xplus(150), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xplus(175), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xplus(175), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xplus(200), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xplus(200), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xplus(225), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xplus(225), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xplus(250), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xplus(250), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xplus(275), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xplus(275), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xplus(300), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xplus(300), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xplus(325), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xplus(325), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' |
| |
| Pencil Picture1, Xminus(25), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xminus(25), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xminus(50), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xminus(50), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xminus(75), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xminus(75), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xminus(100), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xminus(100), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xminus(125), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xminus(125), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xminus(150), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xminus(150), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xminus(175), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xminus(175), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xminus(200), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xminus(200), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xminus(225), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xminus(225), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xminus(250), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xminus(250), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xminus(275), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xminus(275), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xminus(300), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xminus(300), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xminus(325), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xminus(325), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Dim i As Single |
| i = 350 |
| For i = 350 To 1000 Step 25 |
| |
| Pencil Picture1, Xplus(i), Yplus(0), 1, 1, vbBlack |
| Pencil Picture1, Xplus(i), Yplus(10), 1, 1, vbBlack |
| dravv = False |
| |
| Next i |
| |
| ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' |
| |
| Pencil Picture1, Xminus(0), Yminus(25), 1, 1, vbBlack |
| Pencil Picture1, Xminus(10), Yminus(25), 1, 1, vbBlack |
| dravv = False |
| |
| Pencil Picture1, Xminus(0), Yminus(150), 1, 1, vbBlack |
| Pencil Picture1, Xminus(10), Yminus(150), 1, 1, vbBlack |
| dravv = False |
| End Sub |
| |
| |
| Private Sub Command6_Click() |
| On Error GoTo ErrHand |
| 'XY XJplus(0), YJplus(6), XJplus(1), YJplus(6), 1, vbBlack |
| 'XY XJplus(1), YJplus(6), XJplus(2), YJplus(6), 1, vbBlack |
| 'XY XJplus(2), YJplus(6), XJplus(2), YJplus(1), 1, vbBlack |
| CD1.Filter = "*.txt - predloha pro graf z LOG.AN. | *.txt" |
| CD1.ShowOpen |
| Dim SMODL1 As New Opt |
| SMODL1.BasicInputFromFileToMultiLine Soubor, CD1.FileName |
| |
| Soubor = Replace(Soubor, vbCrLf, "") |
| Soubor = Replace(Soubor, "-", "") |
| MsgBox Len(Soubor) |
| |
| S1 = Mid(Soubor, 1, 1024) |
| S0 = Mid(Soubor, 1025, 2049) |
| CA = Mid(Soubor, 2049, 3072) |
| SP = Mid(Soubor, 3073, 4097) |
| |
| Text1.Text = S1 |
| MsgBox Len(Text1.Text) |
| Text2.Text = S0 |
| MsgBox Len(Text2.Text) |
| Text3.Text = SP |
| MsgBox Len(Text3.Text) |
| |
| Exit Sub |
| ErrHand: |
| MsgBox Err.Description, vbCritical, "ERROR!" |
| End Sub |
| |
| Private Sub DX_Change() |
| If DX.Text = "+" Or DX.Text = "-" Then |
| DX.Text = " " & DX.Text & " " |
| End If |
| End Sub |
| |
| Private Sub DY_Change() |
| If DY.Text = "+" Or DY.Text = "-" Then |
| DY.Text = " " & DY.Text & " " |
| End If |
| End Sub |
| |
| Public Function Xplus(n As Single) |
| Xplus = nulaX + (n * 10) |
| End Function |
| |
| Public Function Yplus(n As Single) |
| Yplus = nulaY - (n * 10) |
| End Function |
| |
| Public Function Xminus(n As Single) |
| Xminus = nulaX - (n * 10) |
| End Function |
| |
| Public Function Yminus(n As Single) |
| Yminus = nulaY + (n * 10) |
| End Function |
| |
| Public Function XJplus(n) ' As Single) |
| XJplus = nulaX + (n * 250) |
| End Function |
| |
| Public Function YJplus(n) ' As Single) |
| YJplus = nulaY - (n * 250) |
| End Function |
| |
| Public Function XJminus(n) ' As Single) |
| XJminus = nulaX - (n * 250) |
| End Function |
| |
| Public Function YJminus(n) ' As Single) |
| YJminus = nulaY + (n * 250) |
| End Function |
| |
| |
| |
| '################################################### |
| '################################################### |