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