Subversion Repositories svnkaklik

Rev

Go to most recent revision | Details | Last modification | View Log

Rev Author Line No. Line
6 kaklik 1
VERSION 5.00
2
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
3
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
4
Begin VB.Form Form1 
5
   BorderStyle     =   4  'Fixed ToolWindow
6
   Caption         =   "LOG.AN."
7
   ClientHeight    =   8700
8
   ClientLeft      =   45
9
   ClientTop       =   285
10
   ClientWidth     =   10005
11
   BeginProperty Font 
12
      Name            =   "Tahoma"
13
      Size            =   8.25
14
      Charset         =   238
15
      Weight          =   400
16
      Underline       =   0   'False
17
      Italic          =   0   'False
18
      Strikethrough   =   0   'False
19
   EndProperty
20
   Icon            =   "Form1.frx":0000
21
   LinkTopic       =   "Form1"
22
   MaxButton       =   0   'False
23
   MinButton       =   0   'False
24
   ScaleHeight     =   8700
25
   ScaleWidth      =   10005
26
   ShowInTaskbar   =   0   'False
27
   StartUpPosition =   2  'CenterScreen
28
   Begin VB.Frame Frame2 
29
      Caption         =   "GRAFICKE VYJADRENI"
30
      Height          =   5175
31
      Left            =   5640
32
      TabIndex        =   15
33
      Top             =   120
34
      Width           =   4335
35
      Begin VB.CommandButton CTEXT 
36
         Caption         =   "Vymazat vypoctenou drahu"
37
         Height          =   255
38
         Left            =   120
39
         TabIndex        =   21
40
         Top             =   4800
41
         Width           =   4095
42
      End
43
      Begin VB.CommandButton CLOG 
44
         Caption         =   "Vymazat log"
45
         Height          =   255
46
         Left            =   120
47
         TabIndex        =   20
48
         Top             =   4560
49
         Width           =   4095
50
      End
51
      Begin VB.CommandButton Command1 
52
         Caption         =   "* vymazat *"
53
         Height          =   255
54
         Left            =   2400
55
         TabIndex        =   19
56
         Top             =   1800
57
         Width           =   1695
58
      End
59
      Begin VB.CommandButton Command2 
60
         Caption         =   "Vykreslit"
61
         BeginProperty Font 
62
            Name            =   "Tahoma"
63
            Size            =   9
64
            Charset         =   238
65
            Weight          =   700
66
            Underline       =   0   'False
67
            Italic          =   0   'False
68
            Strikethrough   =   0   'False
69
         EndProperty
70
         Height          =   495
71
         Left            =   2400
72
         TabIndex        =   18
73
         Top             =   1320
74
         Width           =   1695
75
      End
76
      Begin MSComctlLib.Slider Slider1 
77
         Height          =   375
78
         Left            =   120
79
         TabIndex        =   16
80
         Top             =   720
81
         Width           =   4095
82
         _ExtentX        =   7223
83
         _ExtentY        =   661
84
         _Version        =   393216
85
         Max             =   31
86
      End
87
      Begin VB.CommandButton Command3 
88
         Caption         =   "Ulozit graf"
89
         BeginProperty Font 
90
            Name            =   "Tahoma"
91
            Size            =   8.25
92
            Charset         =   238
93
            Weight          =   700
94
            Underline       =   0   'False
95
            Italic          =   0   'False
96
            Strikethrough   =   0   'False
97
         EndProperty
98
         Height          =   615
99
         Left            =   2400
100
         TabIndex        =   22
101
         Top             =   2160
102
         Width           =   1695
103
      End
104
      Begin VB.Label Label3 
105
         Caption         =   "Cast (0 az 32 po 32 bodech z vypoctene 128 vlevo):"
106
         Height          =   255
107
         Left            =   240
108
         TabIndex        =   17
109
         Top             =   360
110
         Width           =   3855
111
      End
112
   End
113
   Begin VB.PictureBox pY 
114
      Appearance      =   0  'Flat
115
      BackColor       =   &H80000005&
116
      ForeColor       =   &H80000008&
117
      Height          =   4575
118
      Left            =   0
119
      ScaleHeight     =   4545
120
      ScaleWidth      =   0
121
      TabIndex        =   13
122
      Top             =   0
123
      Width           =   15
124
   End
125
   Begin VB.PictureBox pX 
126
      Appearance      =   0  'Flat
127
      BackColor       =   &H80000005&
128
      ForeColor       =   &H80000008&
129
      Height          =   15
130
      Left            =   0
131
      ScaleHeight     =   0
132
      ScaleWidth      =   6705
133
      TabIndex        =   12
134
      Top             =   0
135
      Width           =   6735
136
   End
137
   Begin VB.TextBox LOGBOX 
138
      Height          =   1335
139
      Left            =   120
140
      Locked          =   -1  'True
141
      MultiLine       =   -1  'True
142
      ScrollBars      =   2  'Vertical
143
      TabIndex        =   7
144
      Top             =   3960
145
      Width           =   5415
146
   End
147
   Begin VB.TextBox TestText 
148
      BeginProperty Font 
149
         Name            =   "Fixedsys"
150
         Size            =   9
151
         Charset         =   238
152
         Weight          =   400
153
         Underline       =   0   'False
154
         Italic          =   0   'False
155
         Strikethrough   =   0   'False
156
      EndProperty
157
      Height          =   1935
158
      Left            =   120
159
      Locked          =   -1  'True
160
      MultiLine       =   -1  'True
161
      ScrollBars      =   3  'Both
162
      TabIndex        =   6
163
      Top             =   1920
164
      Width           =   5415
165
   End
166
   Begin VB.Frame Frame1 
167
      Caption         =   "VYPOCET"
168
      Height          =   1695
169
      Left            =   120
170
      TabIndex        =   0
171
      Top             =   120
172
      Width           =   5415
173
      Begin VB.ComboBox Combo128 
174
         Height          =   315
175
         ItemData        =   "Form1.frx":0442
176
         Left            =   1080
177
         List            =   "Form1.frx":045E
178
         TabIndex        =   11
179
         Text            =   "1"
180
         Top             =   1200
181
         Width           =   735
182
      End
183
      Begin VB.ComboBox Combo1024 
184
         Height          =   315
185
         ItemData        =   "Form1.frx":047A
186
         Left            =   1080
187
         List            =   "Form1.frx":0487
188
         TabIndex        =   10
189
         Text            =   "1"
190
         Top             =   840
191
         Width           =   735
192
      End
193
      Begin VB.CommandButton exStart 
194
         Caption         =   "Spustit"
195
         BeginProperty Font 
196
            Name            =   "Tahoma"
197
            Size            =   9
198
            Charset         =   238
199
            Weight          =   700
200
            Underline       =   0   'False
201
            Italic          =   0   'False
202
            Strikethrough   =   0   'False
203
         EndProperty
204
         Height          =   375
205
         Left            =   3120
206
         TabIndex        =   4
207
         Top             =   1200
208
         Width           =   2175
209
      End
210
      Begin VB.CommandButton exBwseTgt 
211
         Caption         =   "..."
212
         Height          =   285
213
         Left            =   4920
214
         TabIndex        =   3
215
         Top             =   350
216
         Width           =   375
217
      End
218
      Begin VB.TextBox exTgtGETFROM 
219
         Appearance      =   0  'Flat
220
         Height          =   285
221
         Left            =   1080
222
         TabIndex        =   2
223
         Top             =   350
224
         Width           =   3855
225
      End
226
      Begin VB.Label Label2 
227
         Caption         =   "128 :"
228
         Height          =   255
229
         Left            =   120
230
         TabIndex        =   9
231
         Top             =   1240
232
         Width           =   975
233
      End
234
      Begin VB.Label Label1 
235
         Caption         =   "1024 :"
236
         Height          =   255
237
         Left            =   120
238
         TabIndex        =   8
239
         Top             =   880
240
         Width           =   975
241
      End
242
      Begin VB.Label STATUS 
243
         Alignment       =   2  'Center
244
         Caption         =   "READY"
245
         BeginProperty Font 
246
            Name            =   "Tahoma"
247
            Size            =   9.75
248
            Charset         =   238
249
            Weight          =   700
250
            Underline       =   0   'False
251
            Italic          =   0   'False
252
            Strikethrough   =   0   'False
253
         EndProperty
254
         ForeColor       =   &H00FF0000&
255
         Height          =   375
256
         Left            =   3120
257
         TabIndex        =   5
258
         Top             =   800
259
         Width           =   2175
260
      End
261
      Begin VB.Label exLblImage 
262
         Caption         =   "Soubor:"
263
         Height          =   255
264
         Left            =   120
265
         TabIndex        =   1
266
         Top             =   360
267
         Width           =   975
268
      End
269
   End
270
   Begin MSComDlg.CommonDialog CD1 
271
      Left            =   0
272
      Top             =   0
273
      _ExtentX        =   847
274
      _ExtentY        =   847
275
      _Version        =   393216
276
   End
277
   Begin VB.PictureBox Picture1 
278
      Appearance      =   0  'Flat
279
      BackColor       =   &H00C0C0C0&
280
      ForeColor       =   &H80000008&
281
      Height          =   3255
282
      Left            =   120
283
      ScaleHeight     =   3225
284
      ScaleWidth      =   9825
285
      TabIndex        =   14
286
      Top             =   5400
287
      Width           =   9855
288
   End
289
   Begin MSComDlg.CommonDialog CD2 
290
      Left            =   480
291
      Top             =   0
292
      _ExtentX        =   847
293
      _ExtentY        =   847
294
      _Version        =   393216
295
   End
296
End
297
Attribute VB_Name = "Form1"
298
Attribute VB_GlobalNameSpace = False
299
Attribute VB_Creatable = False
300
Attribute VB_PredeclaredId = True
301
Attribute VB_Exposed = False
302
'############################################################
303
'#                                                          #
304
'#  PROJEKT LOG.AN. by Michal Frdlík 2005/2006              #
305
'#  (MSD) 2005/2006                                         #
306
'#                                                          #
307
'#  kod v tomto programu neni snadny na pochopeni a uz      #
308
'#  vubec neni pro zacatecniky ve VB !! Popisky jsou        #
309
'#  urceny pro pokrocile.                                   #
310
'#                                                          #
311
'############################################################
312
 
313
Dim nulaX As Single
314
Dim nulaY As Single
315
Dim a   ' cast GearBoxu, "a" je jedna ze tri 1024 v souboru
316
Dim b   ' cast GearBoxu, "b" je jedna z 8mi casti jednoho ze tri "a"
317
Dim GCH ' Tohle je charakter, kterej se pouzije pro linii
318
 
319
 
320
''''''''''''''''''''''''''''''
321
Const RC_PALETTE As Long = &H100
322
Const SIZEPALETTE As Long = 104
323
Const RASTERCAPS As Long = 38
324
Private Type PALETTEENTRY
325
    peRed As Byte
326
    peGreen As Byte
327
    peBlue As Byte
328
    peFlags As Byte
329
End Type
330
Private Type LOGPALETTE
331
    palVersion As Integer
332
    palNumEntries As Integer
333
    palPalEntry(255) As PALETTEENTRY ' Enough for 256 colors
334
End Type
335
Private Type GUID
336
    Data1 As Long
337
    Data2 As Integer
338
    Data3 As Integer
339
    Data4(7) As Byte
340
End Type
341
Private Type PicBmp
342
    Size As Long
343
    Type As Long
344
    hBmp As Long
345
    hPal As Long
346
    Reserved As Long
347
End Type
348
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
349
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
350
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
351
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
352
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal iCapabilitiy As Long) As Long
353
Private Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
354
Private Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long
355
Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
356
Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long
357
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
358
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
359
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
360
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
361
    Dim hDCMemory As Long, hBmp As Long, hBmpPrev As Long, R As Long
362
    Dim hPal As Long, hPalPrev As Long, RasterCapsScrn As Long, HasPaletteScrn As Long
363
    Dim PaletteSizeScrn As Long, LogPal As LOGPALETTE
364
 
365
    'Create a compatible device context
366
    hDCMemory = CreateCompatibleDC(hDCSrc)
367
    'Create a compatible bitmap
368
    hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
369
    'Select the compatible bitmap into our compatible device context
370
    hBmpPrev = SelectObject(hDCMemory, hBmp)
371
 
372
    'Raster capabilities?
373
    RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster
374
    'Does our picture use a palette?
375
    HasPaletteScrn = RasterCapsScrn And RC_PALETTE ' Palette
376
    'What's the size of that palette?
377
    PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of
378
 
379
    If HasPaletteScrn And (PaletteSizeScrn = 256) Then
380
        'Set the palette version
381
        LogPal.palVersion = &H300
382
        'Number of palette entries
383
        LogPal.palNumEntries = 256
384
        'Retrieve the system palette entries
385
        R = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))
386
        'Create the palette
387
        hPal = CreatePalette(LogPal)
388
        'Select the palette
389
        hPalPrev = SelectPalette(hDCMemory, hPal, 0)
390
        'Realize the palette
391
        R = RealizePalette(hDCMemory)
392
    End If
393
 
394
    'Copy the source image to our compatible device context
395
    R = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy)
396
 
397
    'Restore the old bitmap
398
    hBmp = SelectObject(hDCMemory, hBmpPrev)
399
 
400
    If HasPaletteScrn And (PaletteSizeScrn = 256) Then
401
        'Select the palette
402
        hPal = SelectPalette(hDCMemory, hPalPrev, 0)
403
    End If
404
 
405
    'Delete our memory DC
406
    R = DeleteDC(hDCMemory)
407
 
408
    Set hDCToPicture = CreateBitmapPicture(hBmp, hPal)
409
End Function
410
Public Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
411
    Dim R As Long, Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID
412
 
413
    'Fill GUID info
414
    With IID_IDispatch
415
        .Data1 = &H20400
416
        .Data4(0) = &HC0
417
        .Data4(7) = &H46
418
    End With
419
 
420
    'Fill picture info
421
    With Pic
422
        .Size = Len(Pic) ' Length of structure
423
        .Type = vbPicTypeBitmap ' Type of Picture (bitmap)
424
        .hBmp = hBmp ' Handle to bitmap
425
        .hPal = hPal ' Handle to palette (may be null)
426
    End With
427
 
428
    'Create the picture
429
    R = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
430
 
431
    'Return the new picture
432
    Set CreateBitmapPicture = IPic
433
End Function
434
''''''''''''''''''''''''''''''
435
 
436
Private Sub CLOG_Click() 'vymzat log
437
LOGBOX.Text = ""
438
End Sub
439
 
440
Private Sub Command1_Click()
441
Picture1.Cls
442
Call init
443
End Sub
444
 
445
Private Sub Command2_Click()
446
On Error GoTo ErrHand
447
Picture1.Cls
448
Call init
449
 
450
Dim All
451
All = TestText.Text
452
Dim X0
453
Dim X1
454
All = Strings.Left(All, 2050)
455
 
456
X0 = Strings.Left(All, 1024)
457
X1 = Strings.Right(All, 1024)
458
 
459
For i = 1 To 32
460
    Select Case (Mid(X0, (32 * Slider1.Value) + i, 1))
461
        Case GCH
462
            XY XJplus(i), YJplus(6), XJplus(i + 1), YJplus(6), 2, vbBlue
463
            If (Mid(X0, (32 * Slider1.Value) + i + 1, 1)) = " " Then
464
                XY XJplus(i + 1), YJplus(6), XJplus(i + 1), YJplus(1), 2, vbBlue
465
            End If
466
        Case " "
467
 
468
    End Select
469
    Select Case (Mid(X1, (32 * Slider1.Value) + i, 1))
470
        Case GCH
471
            XY XJplus(i), YJplus(1), XJplus(i + 1), YJplus(1), 2, vbBlue
472
            If (Mid(X1, (32 * Slider1.Value) + i + 1, 1)) = " " Then
473
                XY XJplus(i + 1), YJplus(1), XJplus(i + 1), YJplus(6), 2, vbBlue
474
            End If
475
        Case " "
476
 
477
    End Select
478
Next i
479
 
480
Exit Sub
481
ErrHand:
482
MsgBox Err.Description, vbCritical, "ERROR!"
483
End Sub
484
 
485
Private Sub Command3_Click()
486
On Error GoTo ErrHand
487
CD2.Filter = "*.bmp - bitmapa | *.bmp"
488
CD2.ShowSave
489
If CD2.FileName = "" Then
490
Exit Sub
491
End If
492
 
493
Dim pointX As Long
494
Dim pointY As Long
495
pointX = ((Form1.Left + Form1.Picture1.Left) + (Form1.Picture1.Width - Form1.Picture1.ScaleWidth)) / Screen.TwipsPerPixelX
496
pointY = ((Form1.Top + Form1.Picture1.Top) + (Form1.Height - Form1.ScaleHeight)) / Screen.TwipsPerPixelY
497
Set Form1.Picture = hDCToPicture(GetDC(0), pointX, pointY, Form1.Picture1.ScaleWidth / Screen.TwipsPerPixelX, Form1.Picture1.ScaleHeight / Screen.TwipsPerPixelY)
498
SavePicture Form1.Picture, CD2.FileName
499
Form1.Picture = LoadPicture
500
 
501
Exit Sub
502
ErrHand:
503
MsgBox Err.Description, vbCritical, "ERROR!"
504
End Sub
505
 
506
Private Sub CTEXT_Click() 'vymazat graf
507
TestText.Text = ""
508
End Sub
509
 
510
Private Sub exBwseTgt_Click() 'dialog Browse
511
CD1.FileName = ""
512
CD1.CancelError = False
513
CD1.DialogTitle = "Browse for File"
514
CD1.Filter = "*.* == All files | *.*"
515
CD1.ShowOpen
516
exTgtGETFROM.Text = CD1.FileName
517
End Sub
518
 
519
Public Function DecToBin(lgNbDec As Long, lgBase As Long) As String
520
On Error GoTo ErrHand
521
'prevod Decimalni->Binarni
522
Dim stResultat As String
523
Dim lgDec As Long, lgK As Long
524
If lgNbDec < 0 Then lgK = 1
525
lgDec = Abs(lgNbDec)
526
Do While lgDec <> 0
527
    stResultat = (lgDec + lgK) Mod 2 & stResultat
528
    lgDec = lgDec \ 2
529
Loop
530
DecToBin = Right$(String$(lgBase, CStr(lgK)) & stResultat, lgBase)
531
 
532
Exit Function
533
ErrHand:
534
MsgBox Err.Description, vbCritical, "ERROR!"
535
End Function
536
 
537
Private Sub exStart_Click()
538
On Error GoTo ErrHand
539
 
540
'########################################################
541
'#                                                      #
542
'#  VYKONNE JADRO LOG.AN. (MSD)2005                     #
543
'#                                                      #
544
'########################################################
545
 
546
On Error GoTo FuckOff 'kdyz chyba, pak FuckOff
547
 
548
'GEARBOX:
549
a = CInt(Combo1024.Text) ' Tak co tam mame
550
b = CInt(Combo128.Text)  ' nestaveny v tech comboboxech ...
551
'#######
552
 
553
STATUS.Caption = "BUSY OR ERR" ' Pomalejsi pocitac tohle sotva zaregsitruje,
554
                        ' ale aby si nemyslel, ze se mu to seklo
555
 
556
Log ("ANALYZUJI SOUBOR...") ' Zapiseme do logu informaci
557
Dim nFileNum As Integer ' Neco jako volny handle
558
nFileNum = FreeFile     ' k souboru
559
 
560
Dim PocetSekvenci ' tady bude pocet 1024 sekvenci v souboru
561
PocetSekvenci = 0 ' pokud budu pracovat pouze s tvojema souborama, mohl
562
                  ' bych tam dat konstantne 3 a upravit kod, ale to
563
                  ' se nedela ...
564
Dim VysledneSekvence(1 To 10, 1 To 1024) ' tady budou 3 sekvence 1024
565
                                         ' dal jsem tam, ale radsi 10 misto 3 ...
566
                                         ' kdyby neco nehralo
567
Dim Temp As Byte ' to co zrovna prectu
568
Dim Large() As Byte ' tady bude celej soubor
569
Dim Zapocata1024 As Boolean ' tohle je tu prakticky i teoreticky k nicemu...
570
Dim CurrentSekvence1024 ' inkrementator pohybu v sekvenci
571
Dim Sekvence1024() As Byte ' docasne misto pro jednu sekvenci
572
 
573
ReDim Large(FileLen(exTgtGETFROM.Text)) ' predimenzujeme si pole tak, aby melo
574
                                        ' velikost celeho souboru
575
 
576
'### NAHRAJI DO PAMETI BAJTY V SOUBORU V DECIMALNIM FORMATU
577
 
578
Log ("Pokusim se o pristup do souboru " & exTgtGETFROM.Text & "...")
579
Open exTgtGETFROM.Text For Binary Access Read Lock Read Write As #nFileNum ' otevrit
580
Log ("Pristup povolen")
581
Log ("Nactu do pameti bajty...")
582
    For i = 0 To FileLen(exTgtGETFROM.Text)
583
        Get #nFileNum, i + 1, Temp ' nacist vsechny bajty
584
                                   ' to "+1" je tam proto, protoze funkce
585
                                   ' Get poctita 1 misto 0 jako zacatek souboru
586
        Large(i) = Temp
587
    Next i
588
Log ("Bajty nacteny")
589
Close #nFileNum
590
Log ("Zaviram soubor")
591
 
592
' tak uz mam nactenej soubor, ted se v nem budu prehrabovat ...
593
 
594
'### VYHLEDAM SEKVENCE O 1024 BAJTECH A ULOZIM JE DO POLE
595
 
596
Log ("Budu hledat sekvence o 1024 bajtech...")
597
For n = 0 To FileLen(exTgtGETFROM.Text)
598
    If Large(n) = 0 Then ' jestlize nejsem v sekvenci
599
            If CurrentSekvence1024 = 1024 Then 'jestli je sekvence kompletni
600
                Log ("Sekvence o 1024 bajtech nalezena!")
601
                PocetSekvenci = PocetSekvenci + 1
602
                For xx = 1 To 1024 'Zapis sekvenci jako jeden z vysledku
603
                    VysledneSekvence(PocetSekvenci, xx) = Sekvence1024(xx - 1)
604
                Next xx
605
            End If
606
        Zapocata1024 = False
607
        CurrentSekvence1024 = 0 'vynulovat pocitadlo
608
        GoTo SKIP__ONE ' tohle tu nemusi bejt, protoze to tak jak tak jde hned na konec
609
    Else ' jinak
610
        Zapocata1024 = True
611
        ReDim Preserve Sekvence1024(CurrentSekvence1024) ' predimenzuj pole s funkci
612
                                                         ' zachrany soucasnych dat
613
                                                         ' (preserve) na aktualni
614
                                                         ' velikost sekvence a
615
 
616
        Sekvence1024(CurrentSekvence1024) = Large(n) ' zapis vysledek
617
        CurrentSekvence1024 = CurrentSekvence1024 + 1 ' inc.
618
    End If
619
 
620
SKIP__ONE:
621
Next n
622
 
623
Log ("Celkem sekvenci o 1024 bajtech: " & PocetSekvenci)
624
 
625
' tak a mame pole v trema 1024 sekvencema, ted uz zbyva je rozdelit do
626
' 24 128 sekvenci a tak dale a tak dale ....
627
 
628
'### ROZDELIM TYTO 1024 BITOVE SEKVENCE DO 24 128 BITOVYCH
629
'### A VSE SETRIDIM DO PREHLEDNEHO POLE
630
 
631
Log ("Budu tridit 1024sekvence do pole...")
632
Dim Temp128(1 To 128) ' nevyuzita promenna=)
633
Dim Multiple128()
634
ReDim Multiple128(1 To PocetSekvenci, 1 To 8, 1 To 128) 'nase prehledny pole
635
 
636
For qq = 1 To PocetSekvenci
637
    For ww = 1 To 8
638
        For ee = 1 To 128
639
            Multiple128(qq, ww, ee) = VysledneSekvence(qq, ((128 * ww) - 128) + ee)
640
            ' tenhle zakrok uklada do pole 3,8,128 a pocita s posunem pocatku...
641
            ' doufam, ze je to jasny
642
        Next ee
643
    Next ww
644
Next qq
645
Log ("Roztrizeno")
646
 
647
' a ted prevod do bin,8
648
 
649
'### PREVEDU DO BINARNIHO FORMATU
650
 
651
Log ("Budu prevadet do binarniho formatu o zakladu 8...")
652
Dim Bin128() As String
653
ReDim Bin128(1 To PocetSekvenci, 1 To 8, 1 To 128) As String
654
 
655
For qqq = 1 To PocetSekvenci
656
    For www = 1 To 8
657
        For eee = 1 To 128
658
            Bin128(qqq, www, eee) = DecToBin(CLng(Multiple128(qqq, www, eee)), 8)
659
        Next eee
660
    Next www
661
Next qqq
662
Log ("Prevedeno")
663
Log ("ANALYZA DOKONCENA BEZ CHYB")
664
 
665
'###################################################
666
'### SIMULACE GRAFICKEHO SUBSYSTEMU ################
667
'###################################################
668
 
669
' Toto je znamy "derny stitek"
670
 
671
Log ("SPOUSTIM SIMULACI GRAFICKEHO SUBSYSTEMU...")
672
 
673
Dim BIGG ' tohle je 1024 charakteru dlouha pomlcak
674
For biggc = 1 To 1024
675
BIGG = BIGG & "-"
676
Next biggc
677
 
678
Dim Glyph ' tady bude vysledek
679
Dim GlyphX0 ' osa X, status Y=0
680
Dim GlyphX1 ' osa X, status Y=1
681
Dim DownGlyph ' popisky na ose X
682
Dim TempChar ' docasne misto pro prave nactenej neco...
683
 
684
Log ("Zpracovavam linii grafu...")
685
 
686
Log ("Manualne nastaveno a=" & CStr(a) & " b=" & CStr(b))
687
Log ("sekv. " & CStr(a) & "/" & PocetSekvenci & "; sekv." & CStr(b) & "/8")
688
 
689
For gl1a = 1 To 128
690
    For gl1b = 1 To 8
691
        TempChar = Mid(CStr(Bin128(a, b, gl1a)), (gl1b), 1)
692
        ' Tohle je moc Basicovsky a je to takova lepsi prace se stringy,
693
        ' muze se stat ze ti to nebude moc jasny. Funkce Mid, vraci znaky,
694
        ' ktere jsou dany parametrem, odkud a kolik =).
695
        Select Case TempChar ' mame nula nebo jedna? jestli nula tak, v jedna
696
                             ' bude mezera a v nula znak, vice versa.
697
            Case "0"
698
                GlyphX0 = GlyphX0 & GCH
699
                GlyphX1 = GlyphX1 & " "
700
            Case "1"
701
                GlyphX0 = GlyphX0 & " "
702
                GlyphX1 = GlyphX1 & GCH
703
        End Select
704
        DownGlyph = DownGlyph & TempChar
705
    Next gl1b
706
Next gl1a
707
 
708
Log ("Zpracovano")
709
 
710
Log ("Vykresluji...")
711
 
712
Glyph = "" & GlyphX1 & vbCrLf & _
713
        "" & GlyphX0 & vbCrLf & _
714
        BIGG & vbCrLf & _
715
        DownGlyph & vbCrLf 'vysledek
716
 
717
TestText.Text = Glyph 'vykreslim
718
 
719
Log ("Vykresleno")
720
 
721
 
722
Log ("UKONCUJI SIMULACI GRAFICKEHO SUBSYSTEMU")
723
Log ("ALGORITMUS UKONCEN")
724
STATUS.Caption = "READY"
725
 
726
Exit Sub
727
 
728
FuckOff:
729
Log ("#CHYBA: Potrebujes soubor obsahujici 3 sekvence 1024 bajtu oddelene minimalne jednou nulou !!!")
730
 
731
Exit Sub
732
ErrHand:
733
MsgBox Err.Description, vbCritical, "ERROR!"
734
End Sub
735
 
736
Public Function Log(Str)
737
LOGBOX.Text = LOGBOX.Text & Time & ": " & Str & vbCrLf
738
End Function
739
 
740
Private Sub Form_Load()
741
On Error GoTo ErrHand
742
GCH = "¤"
743
 
744
pX.Top = (Picture1.Top + (Picture1.Height / 2))
745
pX.Left = Picture1.Left
746
pY.Left = (Picture1.Left + (Picture1.Width / 20))
747
pY.Top = Picture1.Top
748
pX.Width = Picture1.Width
749
 
750
nulaY = Picture1.Height / 2
751
nulaX = Picture1.Width / 20
752
 
753
Call init
754
 
755
Exit Sub
756
ErrHand:
757
MsgBox Err.Description, vbCritical, "ERROR!"
758
End Sub
759
 
760
 
761
 
762
 
763
 
764
 
765
'################################################
766
'################################################
767
Public Function Spoj(AnoNe As Boolean)
768
 
769
Select Case AnoNe
770
    Case True
771
        dravv = True
772
    Case False
773
        dravv = False
774
End Select
775
 
776
End Function
777
 
778
Public Function PxPy(zeroX As Single, zeroY As Single, destX As Single, destY As Single, Wdt As Long, Sclr As ColorConstants)
779
 
780
Pencil Picture1, zeroX, zeroY, Wdt, 1, Sclr
781
Pencil Picture1, XJplus(destX), YJplus(destY), Wdt, 1, Sclr
782
dravv = False
783
 
784
End Function
785
Public Function PxMy(zeroX As Single, zeroY As Single, destX As Single, destY As Single, Wdt As Long, Sclr As ColorConstants)
786
 
787
Pencil Picture1, zeroX, zeroY, Wdt, 1, Sclr
788
Pencil Picture1, XJplus(destX), YJminus(destY), Wdt, 1, Sclr
789
dravv = False
790
 
791
End Function
792
 
793
Public Function MxPy(zeroX As Single, zeroY As Single, destX As Single, destY As Single, Wdt As Long, Sclr As ColorConstants)
794
 
795
Pencil Picture1, zeroX, zeroY, Wdt, 1, Sclr
796
Pencil Picture1, XJminus(destX), YJplus(destY), Wdt, 1, Sclr
797
dravv = False
798
 
799
End Function
800
 
801
Public Function MxMy(zeroX As Single, zeroY As Single, destX As Single, destY As Single, Wdt As Long, Sclr As ColorConstants)
802
 
803
Pencil Picture1, zeroX, zeroY, Wdt, 1, Sclr
804
Pencil Picture1, XJminus(destX), YJminus(destY), Wdt, 1, Sclr
805
dravv = False
806
 
807
End Function
808
 
809
Public Function XY(zeroX As Single, zeroY As Single, destX As Single, destY As Single, Wdt As Long, Sclr As ColorConstants)
810
 
811
Pencil Picture1, zeroX, zeroY, Wdt, 1, Sclr
812
Pencil Picture1, destX, destY, Wdt, 1, Sclr
813
dravv = False
814
 
815
End Function
816
 
817
 
818
 
819
Private Sub init()
820
 
821
'POZOR!!!!!
822
'toto je neoptimalizovany kod, pouzil jsem Ctrl+C Ctrl+V z jednoho
823
'ze svych straych projektu, kdy jsem jeste nepouzival cykly
824
'for...next ; POUZE TATO CAST JE NEOPTIMALIZOVANA !!!!!!!
825
 
826
 
827
Pencil Picture1, Xminus(0), Yplus(25), 1, 1, vbBlack
828
Pencil Picture1, Xminus(10), Yplus(25), 1, 1, vbBlack
829
dravv = False
830
 
831
Pencil Picture1, Xminus(0), Yplus(150), 1, 1, vbBlack
832
Pencil Picture1, Xminus(10), Yplus(150), 1, 1, vbBlack
833
dravv = False
834
 
835
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
836
 
837
Pencil Picture1, Xplus(25), Yplus(0), 1, 1, vbBlack
838
Pencil Picture1, Xplus(25), Yplus(10), 1, 1, vbBlack
839
dravv = False
840
 
841
Pencil Picture1, Xplus(50), Yplus(0), 1, 1, vbBlack
842
Pencil Picture1, Xplus(50), Yplus(10), 1, 1, vbBlack
843
dravv = False
844
 
845
Pencil Picture1, Xplus(75), Yplus(0), 1, 1, vbBlack
846
Pencil Picture1, Xplus(75), Yplus(10), 1, 1, vbBlack
847
dravv = False
848
 
849
Pencil Picture1, Xplus(100), Yplus(0), 1, 1, vbBlack
850
Pencil Picture1, Xplus(100), Yplus(10), 1, 1, vbBlack
851
dravv = False
852
 
853
Pencil Picture1, Xplus(125), Yplus(0), 1, 1, vbBlack
854
Pencil Picture1, Xplus(125), Yplus(10), 1, 1, vbBlack
855
dravv = False
856
 
857
Pencil Picture1, Xplus(150), Yplus(0), 1, 1, vbBlack
858
Pencil Picture1, Xplus(150), Yplus(10), 1, 1, vbBlack
859
dravv = False
860
 
861
Pencil Picture1, Xplus(175), Yplus(0), 1, 1, vbBlack
862
Pencil Picture1, Xplus(175), Yplus(10), 1, 1, vbBlack
863
dravv = False
864
 
865
Pencil Picture1, Xplus(200), Yplus(0), 1, 1, vbBlack
866
Pencil Picture1, Xplus(200), Yplus(10), 1, 1, vbBlack
867
dravv = False
868
 
869
Pencil Picture1, Xplus(225), Yplus(0), 1, 1, vbBlack
870
Pencil Picture1, Xplus(225), Yplus(10), 1, 1, vbBlack
871
dravv = False
872
 
873
Pencil Picture1, Xplus(250), Yplus(0), 1, 1, vbBlack
874
Pencil Picture1, Xplus(250), Yplus(10), 1, 1, vbBlack
875
dravv = False
876
 
877
Pencil Picture1, Xplus(275), Yplus(0), 1, 1, vbBlack
878
Pencil Picture1, Xplus(275), Yplus(10), 1, 1, vbBlack
879
dravv = False
880
 
881
Pencil Picture1, Xplus(300), Yplus(0), 1, 1, vbBlack
882
Pencil Picture1, Xplus(300), Yplus(10), 1, 1, vbBlack
883
dravv = False
884
 
885
Pencil Picture1, Xplus(325), Yplus(0), 1, 1, vbBlack
886
Pencil Picture1, Xplus(325), Yplus(10), 1, 1, vbBlack
887
dravv = False
888
 
889
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
890
 
891
Pencil Picture1, Xminus(25), Yplus(0), 1, 1, vbBlack
892
Pencil Picture1, Xminus(25), Yplus(10), 1, 1, vbBlack
893
dravv = False
894
 
895
Pencil Picture1, Xminus(50), Yplus(0), 1, 1, vbBlack
896
Pencil Picture1, Xminus(50), Yplus(10), 1, 1, vbBlack
897
dravv = False
898
 
899
Pencil Picture1, Xminus(75), Yplus(0), 1, 1, vbBlack
900
Pencil Picture1, Xminus(75), Yplus(10), 1, 1, vbBlack
901
dravv = False
902
 
903
Pencil Picture1, Xminus(100), Yplus(0), 1, 1, vbBlack
904
Pencil Picture1, Xminus(100), Yplus(10), 1, 1, vbBlack
905
dravv = False
906
 
907
Pencil Picture1, Xminus(125), Yplus(0), 1, 1, vbBlack
908
Pencil Picture1, Xminus(125), Yplus(10), 1, 1, vbBlack
909
dravv = False
910
 
911
Pencil Picture1, Xminus(150), Yplus(0), 1, 1, vbBlack
912
Pencil Picture1, Xminus(150), Yplus(10), 1, 1, vbBlack
913
dravv = False
914
 
915
Pencil Picture1, Xminus(175), Yplus(0), 1, 1, vbBlack
916
Pencil Picture1, Xminus(175), Yplus(10), 1, 1, vbBlack
917
dravv = False
918
 
919
Pencil Picture1, Xminus(200), Yplus(0), 1, 1, vbBlack
920
Pencil Picture1, Xminus(200), Yplus(10), 1, 1, vbBlack
921
dravv = False
922
 
923
Pencil Picture1, Xminus(225), Yplus(0), 1, 1, vbBlack
924
Pencil Picture1, Xminus(225), Yplus(10), 1, 1, vbBlack
925
dravv = False
926
 
927
Pencil Picture1, Xminus(250), Yplus(0), 1, 1, vbBlack
928
Pencil Picture1, Xminus(250), Yplus(10), 1, 1, vbBlack
929
dravv = False
930
 
931
Pencil Picture1, Xminus(275), Yplus(0), 1, 1, vbBlack
932
Pencil Picture1, Xminus(275), Yplus(10), 1, 1, vbBlack
933
dravv = False
934
 
935
Pencil Picture1, Xminus(300), Yplus(0), 1, 1, vbBlack
936
Pencil Picture1, Xminus(300), Yplus(10), 1, 1, vbBlack
937
dravv = False
938
 
939
Pencil Picture1, Xminus(325), Yplus(0), 1, 1, vbBlack
940
Pencil Picture1, Xminus(325), Yplus(10), 1, 1, vbBlack
941
dravv = False
942
 
943
Dim i As Single
944
i = 350
945
For i = 350 To 1000 Step 25
946
 
947
Pencil Picture1, Xplus(i), Yplus(0), 1, 1, vbBlack
948
Pencil Picture1, Xplus(i), Yplus(10), 1, 1, vbBlack
949
dravv = False
950
 
951
Next i
952
 
953
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
954
 
955
Pencil Picture1, Xminus(0), Yminus(25), 1, 1, vbBlack
956
Pencil Picture1, Xminus(10), Yminus(25), 1, 1, vbBlack
957
dravv = False
958
 
959
Pencil Picture1, Xminus(0), Yminus(150), 1, 1, vbBlack
960
Pencil Picture1, Xminus(10), Yminus(150), 1, 1, vbBlack
961
dravv = False
962
End Sub
963
 
964
 
965
Private Sub Command6_Click()
966
On Error GoTo ErrHand
967
'XY XJplus(0), YJplus(6), XJplus(1), YJplus(6), 1, vbBlack
968
'XY XJplus(1), YJplus(6), XJplus(2), YJplus(6), 1, vbBlack
969
'XY XJplus(2), YJplus(6), XJplus(2), YJplus(1), 1, vbBlack
970
CD1.Filter = "*.txt - predloha pro graf z LOG.AN. | *.txt"
971
CD1.ShowOpen
972
Dim SMODL1 As New Opt
973
SMODL1.BasicInputFromFileToMultiLine Soubor, CD1.FileName
974
 
975
Soubor = Replace(Soubor, vbCrLf, "")
976
Soubor = Replace(Soubor, "-", "")
977
MsgBox Len(Soubor)
978
 
979
S1 = Mid(Soubor, 1, 1024)
980
S0 = Mid(Soubor, 1025, 2049)
981
CA = Mid(Soubor, 2049, 3072)
982
SP = Mid(Soubor, 3073, 4097)
983
 
984
Text1.Text = S1
985
MsgBox Len(Text1.Text)
986
Text2.Text = S0
987
MsgBox Len(Text2.Text)
988
Text3.Text = SP
989
MsgBox Len(Text3.Text)
990
 
991
Exit Sub
992
ErrHand:
993
MsgBox Err.Description, vbCritical, "ERROR!"
994
End Sub
995
 
996
Private Sub DX_Change()
997
If DX.Text = "+" Or DX.Text = "-" Then
998
DX.Text = " " & DX.Text & " "
999
End If
1000
End Sub
1001
 
1002
Private Sub DY_Change()
1003
If DY.Text = "+" Or DY.Text = "-" Then
1004
DY.Text = " " & DY.Text & " "
1005
End If
1006
End Sub
1007
 
1008
Public Function Xplus(n As Single)
1009
Xplus = nulaX + (n * 10)
1010
End Function
1011
 
1012
Public Function Yplus(n As Single)
1013
Yplus = nulaY - (n * 10)
1014
End Function
1015
 
1016
Public Function Xminus(n As Single)
1017
Xminus = nulaX - (n * 10)
1018
End Function
1019
 
1020
Public Function Yminus(n As Single)
1021
Yminus = nulaY + (n * 10)
1022
End Function
1023
 
1024
Public Function XJplus(n) ' As Single)
1025
XJplus = nulaX + (n * 250)
1026
End Function
1027
 
1028
Public Function YJplus(n) ' As Single)
1029
YJplus = nulaY - (n * 250)
1030
End Function
1031
 
1032
Public Function XJminus(n) ' As Single)
1033
XJminus = nulaX - (n * 250)
1034
End Function
1035
 
1036
Public Function YJminus(n) ' As Single)
1037
YJminus = nulaY + (n * 250)
1038
End Function
1039
 
1040
 
1041
 
1042
'###################################################
1043
'###################################################