Subversion Repositories svnkaklik

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



'###################################################
'###################################################