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 |
|
|
|
'################################################### |
'################################################### |