| /programy/VB/joystick/INPOUT32.DLL |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /programy/VB/joystick/INPOUT32.DPR |
|---|
| 0,0 → 1,38 |
| {Source code for inpout32.dll. |
| Enables 32-bit Visual Basic programs to do direct port I/O |
| (Inp and Out) under Windows 95. |
| To be compiled with Borland's Delphi 2.0.} |
| library inpout32; |
| uses SysUtils; |
| procedure Out32(PortAddress:smallint;Value:smallint);stdcall;export; |
| var |
| ByteValue:Byte; |
| begin |
| ByteValue:=Byte(Value); |
| asm |
| push dx |
| mov dx,PortAddress |
| mov al, ByteValue |
| out dx,al |
| pop dx |
| end; |
| end; |
| function Inp32(PortAddress:smallint):smallint;stdcall;export; |
| var |
| ByteValue:byte; |
| begin |
| asm |
| push dx |
| mov dx, PortAddress |
| in al,dx |
| mov ByteValue,al |
| pop dx |
| end; |
| Inp32:=smallint(ByteValue) and $00FF; |
| end; |
| Exports |
| Inp32, |
| Out32; |
| begin |
| end. |
| /programy/VB/joystick/INPOUT32.TXT |
|---|
| 0,0 → 1,72 |
| Documentation for inpout32.zip |
| Inpout32.zip contains a DLL that enables direct reading and writing to I/O ports in 32-bit Visual-Basic programs running under Windows 95. |
| by Jan Axelson |
| Lakeview Research |
| Email: jaxelson@lvr.com |
| WWW: http://www.lvr.com |
| Important information and cautions: |
| 1. Use this DLL at your own risk. Writing directly to hardware ports can result in system crashes, loss of data, and even permanent damage. Inpout32 was developed to allow access to parallel ports and other ports on custom hardware, but you can use it to attempt to access any hardware that is mapped as an I/O port. You've been warned! |
| 2. Use this DLL only with 32-bit programs. 16-bit programs require a 16-bit DLL (inpout16.dll). |
| 3. Windows 95 allows direct port reads and writes unless a VxD has control of the port and blocks access. Under Windows NT, direct port access is not allowed, and you must use a kernel-mode device driver. |
| 4. For the latest parallel-port programming and interfacing information and tools, visit Parallel Port Central at: |
| http://www.lvr.com |
| *** |
| Inpout32.zip contains the following files: |
| inpout32.txt |
| This file |
| inpout32.dll |
| A DLL that enables the use of Inp and Out routines in 32-bit Visual Basic 4 and Visual Basic 5 programs. |
| inpout32.bas |
| Visual-Basic declarations for Inp and Out |
| inpout32.vbp |
| Visual Basic 4 test project for inpout32. The project will also load into and run under Visual Basic 5. |
| inpout32.frm |
| Startup form for the test project |
| inpout32.dpr |
| Source code for inpout32.dll. The DLL was compiled with Borland's Delphi 2.0 Object Pascal compiler. |
| *** |
| How to run the test program (inpout32.vbp): |
| 1. Copy inpout32.dll to one of these locations: your default Windows directory (usually \Windows), your Windows system directory (usually \Windows\system), or your application's working directory. In the VB programming environment, the working directory is the default VB directory. |
| 2. Open the project inpout32.vbp. |
| 3. In the Form_Load subroutine, set PortAddress equal to the port address you want to test. |
| 3. Clicking the command button causes the program to do the following: write a value to the port, read the port, and display the result. The value increments with each click, resetting to 0 at 255. |
| *** |
| How to use inpout32 in your programs: |
| 1. Copy inpout32.dll to your default Windows directory (or other directory as described above). |
| 2. Add inpout32.bas to your Visual-Basic project (File menu, Add File). |
| 3. Use this syntax to write to a port: |
| Out PortAddress, ValueToWrite |
| Example: |
| Out &h378, &h55 |
| Use this syntax to read a port: |
| ValueRead = Inp(PortAddress) |
| Example: |
| ValueRead = Inp(&h378) |
| (The syntax is identical to QuickBasic's Inp and Out). |
| /programy/VB/joystick/INPOUT32.VBP |
|---|
| 0,0 → 1,31 |
| Type=Exe |
| Form=inpout32.frm |
| Module=inpout; Inpout32.bas |
| IconForm="inpout32" |
| Startup="inpout32" |
| HelpFile="" |
| Command32="" |
| Name="Project1" |
| HelpContextID="0" |
| CompatibleMode="0" |
| MajorVer=1 |
| MinorVer=0 |
| RevisionVer=0 |
| AutoIncrementVer=0 |
| ServerSupportFiles=0 |
| VersionCompanyName="doma" |
| CompilationType=0 |
| OptimizationType=0 |
| FavorPentiumPro(tm)=0 |
| CodeViewDebugInfo=0 |
| NoAliasing=0 |
| BoundsCheck=0 |
| OverflowCheck=0 |
| FlPointCheck=0 |
| FDIVCheck=0 |
| UnroundedFP=0 |
| StartMode=0 |
| Unattended=0 |
| Retained=0 |
| ThreadPerObject=0 |
| MaxNumberOfThreads=1 |
| /programy/VB/joystick/INPOUT32.vbw |
|---|
| 0,0 → 1,2 |
| inpout32 = 25, -2, 354, 453, Z, -2, -9, 554, 447, C |
| inpout = 66, 66, 317, 328, |
| /programy/VB/joystick/Inpout32.bas |
|---|
| 0,0 → 1,29 |
| Attribute VB_Name = "inpout" |
| 'Inp and Out declarations for direct port I/O |
| 'in 32-bit Visual Basic 4 programs. |
| Public Declare Function Input32 Lib "inpout32.dll" _ |
| Alias "Inp32" (ByVal PortAddress As Integer) As Integer |
| Public Declare Sub Output Lib "inpout32.dll" _ |
| Alias "Out32" (ByVal PortAddress As Integer, ByVal Value As Integer) |
| Sub out(ByVal Value As Integer) |
| Output &H3BC, Value |
| End Sub |
| Function inp() As Integer |
| inp = Input32(&H3BD) |
| End Function |
| Function inp11() As Boolean |
| inp11 = ((inp And &H80) = 0) |
| End Function |
| Function inp10() As Boolean |
| inp10 = Not ((inp And &H40) = 0) |
| End Function |
| Function inp12() As Boolean |
| inp12 = Not ((inp And &H20) = 0) |
| End Function |
| Function inp13() As Boolean |
| inp13 = Not ((inp And &H10) = 0) |
| End Function |
| /programy/VB/joystick/inpout32.frm |
|---|
| 0,0 → 1,78 |
| VERSION 5.00 |
| Begin VB.Form inpout32 |
| Caption = "Form1" |
| ClientHeight = 4710 |
| ClientLeft = 915 |
| ClientTop = 1410 |
| ClientWidth = 4770 |
| LinkTopic = "Form1" |
| PaletteMode = 1 'UseZOrder |
| ScaleHeight = 4710 |
| ScaleWidth = 4770 |
| Begin VB.Timer TimerY |
| Left = 1680 |
| Top = 600 |
| End |
| Begin VB.TextBox TextY |
| Height = 375 |
| Left = 960 |
| TabIndex = 1 |
| Text = "Y" |
| Top = 600 |
| Width = 615 |
| End |
| Begin VB.Timer TimerX |
| Left = 1680 |
| Top = 120 |
| End |
| Begin VB.TextBox TextX |
| Height = 372 |
| Left = 960 |
| TabIndex = 0 |
| Text = "X" |
| Top = 120 |
| Width = 615 |
| End |
| End |
| Attribute VB_Name = "inpout32" |
| Attribute VB_GlobalNameSpace = False |
| Attribute VB_Creatable = False |
| Attribute VB_PredeclaredId = True |
| Attribute VB_Exposed = False |
| Dim pocitadlo |
| Private Sub Form_Load() |
| TimerX.Interval = 500 |
| TimerX.Enabled = True |
| TimerY.Interval = 500 |
| TimerY.Enabled = True |
| End Sub |
| Private Sub TimerX_Timer() |
| Dim vstup |
| Output &H201, &HFF |
| For n = 1 To 1000 |
| pocitadlo = n |
| vstup = Input32(&H201) And 1 |
| If vstup = 0 Then |
| GoTo ven |
| End If |
| Next n |
| ven: |
| TextX.Text = pocitadlo |
| End Sub |
| Private Sub TimerY_Timer() |
| Dim vstup |
| Output &H201, &HFF |
| For n = 1 To 1000 |
| pocitadlo = n |
| vstup = Input32(&H201) And 2 |
| If vstup = 0 Then |
| GoTo ven |
| End If |
| Next n |
| ven: |
| TextY.Text = pocitadlo |
| End Sub |
| /programy/VB/joystick/mssccprj.scc |
|---|
| 0,0 → 1,5 |
| SCC = This is a Source Code Control file |
| [INPOUT32.VBP] |
| SCC_Aux_Path = "C:\PROGRAM FILES\MICROSOFT VISUAL STUDIO\COMMON\VSS" |
| SCC_Project_Name = "$/programy/VB/joystick", ZEBAAAAA |
| /programy/VB/joystick/vssver.scc |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /programy/VB/kombinator/Form1.frm |
|---|
| 0,0 → 1,25 |
| VERSION 5.00 |
| Begin VB.Form Form1 |
| Caption = "Form1" |
| ClientHeight = 3195 |
| ClientLeft = 60 |
| ClientTop = 345 |
| ClientWidth = 4110 |
| LinkTopic = "Form1" |
| ScaleHeight = 3195 |
| ScaleWidth = 4110 |
| StartUpPosition = 3 'Windows Default |
| Begin VB.CommandButton Command1 |
| Caption = "Command1" |
| Height = 615 |
| Left = 2160 |
| TabIndex = 0 |
| Top = 2280 |
| Width = 1455 |
| End |
| End |
| Attribute VB_Name = "Form1" |
| Attribute VB_GlobalNameSpace = False |
| Attribute VB_Creatable = False |
| Attribute VB_PredeclaredId = True |
| Attribute VB_Exposed = False |
| /programy/VB/kombinator/Project1.vbp |
|---|
| 0,0 → 1,29 |
| Type=Exe |
| Form=Form1.frm |
| Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\SYSTEM\stdole2.tlb#OLE Automation |
| Startup="Form1" |
| Command32="" |
| Name="Project1" |
| HelpContextID="0" |
| CompatibleMode="0" |
| MajorVer=1 |
| MinorVer=0 |
| RevisionVer=0 |
| AutoIncrementVer=0 |
| ServerSupportFiles=0 |
| VersionCompanyName="DOMA" |
| CompilationType=0 |
| OptimizationType=0 |
| FavorPentiumPro(tm)=0 |
| CodeViewDebugInfo=0 |
| NoAliasing=0 |
| BoundsCheck=0 |
| OverflowCheck=0 |
| FlPointCheck=0 |
| FDIVCheck=0 |
| UnroundedFP=0 |
| StartMode=0 |
| Unattended=0 |
| Retained=0 |
| ThreadPerObject=0 |
| MaxNumberOfThreads=1 |
| /programy/VB/kombinator/Project1.vbw |
|---|
| 0,0 → 1,0 |
| Form1 = 0, 0, 0, 0, C, 44, 44, 410, 382, C |
| /programy/VB/kombinator/mssccprj.scc |
|---|
| 0,0 → 1,5 |
| SCC = This is a Source Code Control file |
| [Project1.vbp] |
| SCC_Aux_Path = "C:\PROGRAM FILES\MICROSOFT VISUAL STUDIO\COMMON\VSS" |
| SCC_Project_Name = "$/programy/VB/kombinator", HFBAAAAA |
| /programy/VB/kombinator/vssver.scc |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /programy/VB/logic_analyzer/Form1.frm |
|---|
| 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 |
| '################################################### |
| '################################################### |
| /programy/VB/logic_analyzer/Form1.frx |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /programy/VB/logic_analyzer/Form1.log |
|---|
| 0,0 → 1,3 |
| Line 76: Class MSComctlLib.Slider of control Slider1 was not a loaded control class. |
| Line 270: Class MSComDlg.CommonDialog of control CD1 was not a loaded control class. |
| Line 289: Class MSComDlg.CommonDialog of control CD2 was not a loaded control class. |
| /programy/VB/logic_analyzer/MSSCCPRJ.SCC |
|---|
| 0,0 → 1,5 |
| [SCC] |
| SCC=This is a source code control file |
| [Project1.vbp] |
| SCC_Project_Name=this project is not under source code control |
| SCC_Aux_Path=<This is an empty string for the mssccprj.scc file> |
| /programy/VB/logic_analyzer/Nasroj.bas |
|---|
| 0,0 → 1,363 |
| Attribute VB_Name = "Nasroj" |
| Public ClrSet As ColorConstants |
| Public dravv |
| Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long |
| Public Declare Function ExtFloodFill Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long, ByVal wFillType As Long) As Long |
| Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long |
| Public ha As Double |
| Public Type BITMAPINFOHEADER |
| biSize As Long |
| biWidth As Long |
| biHeight As Long |
| biPlanes As Integer |
| biBitCount As Integer |
| biCompression As Long |
| biSizeImage As Long |
| biXPelsPerMeter As Long |
| biYPelsPerMeter As Long |
| biClrUsed As Long |
| biClrImportant As Long |
| End Type |
| Public Type RGBQUAD |
| rgbBlue As Byte |
| rgbGreen As Byte |
| rgbRed As Byte |
| rgbReserved As Byte |
| End Type |
| Public Type rgb |
| R As Byte |
| g As Byte |
| b As Byte |
| End Type |
| Public Type BITMAPINFO |
| bmiHeader As BITMAPINFOHEADER |
| bmiColors As RGBQUAD |
| End Type |
| Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long |
| Public Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long |
| Public Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long |
| Public Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal DX As Long, ByVal DY As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long |
| Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long |
| Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long |
| Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long |
| Public 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 |
| Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long |
| Public Declare Function TranslateColor Lib "olepro32.dll" Alias "OleTranslateColor" (ByVal Clr As OLE_COLOR, ByVal palet As Long, col As Long) As Long |
| 'TUZKA |
| Public Sub Pencil(Img As PictureBox, x As Single, y As Single, Width As Long, Button As Integer, Clr As Long) |
| Img.DrawWidth = Width |
| Img.AutoRedraw = True |
| If Button = 1 Then |
| If dravv = False Then |
| dravv = True |
| Img.Line (x, y)-(x, y) |
| Else |
| Img.Line -(x, y), Clr |
| End If |
| Img.Refresh |
| Else |
| dravv = False |
| End If |
| End Sub |
| 'Pencil Picture1, X, Y, 3, Button,&H0 |
| 'KULATY ST. |
| Public Sub Brush2(Img As PictureBox, x As Single, y As Single, Button As Integer, Clr As Long, Clr2 As Long, Value As Long) |
| If Button = 1 Then |
| Img.Refresh |
| Img.AutoRedraw = True |
| a = (Value / 2) |
| Do |
| Img.Circle (x + 1, y + 1), a, Clr |
| a = a - 1 |
| Loop Until a = 0 |
| a = (Value / 2) |
| Do |
| Img.Circle (x + 1, y), a, Clr |
| a = a - 1 |
| Loop Until a = 0 |
| a = (Value / 2) |
| Do |
| Img.Circle (x, y + 1), a, Clr |
| a = a - 1 |
| Loop Until a = 0 |
| a = (Value / 2) |
| Do |
| Img.Circle (x, y), a, Clr |
| a = a - 1 |
| Loop Until a = 0 |
| Img.AutoRedraw = False |
| End If |
| If Button = 2 Then |
| Img.Refresh |
| Img.AutoRedraw = True |
| a = (Value / 2) |
| Do |
| Img.Circle (x + 1, y + 1), a, Clr2 |
| a = a - 1 |
| Loop Until a = 0 |
| a = (Value / 2) |
| Do |
| Img.Circle (x + 1, y), a, Clr2 |
| a = a - 1 |
| Loop Until a = 0 |
| a = (Value / 2) |
| Do |
| Img.Circle (x, y + 1), a, Clr2 |
| a = a - 1 |
| Loop Until a = 0 |
| a = (Value / 2) |
| Do |
| Img.Circle (x, y), a, Clr2 |
| a = a - 1 |
| Loop Until a = 0 |
| Img.AutoRedraw = False |
| End If |
| If Button = 0 Then |
| Img.Refresh |
| Img.AutoRedraw = False |
| a = (Value / 2) |
| Do |
| Img.Circle (x + 1, y + 1), a, Clr |
| a = a - 1 |
| Loop Until a = 0 |
| a = (Value / 2) |
| Do |
| Img.Circle (x + 1, y), a, Clr |
| a = a - 1 |
| Loop Until a = 0 |
| a = (Value / 2) |
| Do |
| Img.Circle (x, y + 1), a, Clr |
| a = a - 1 |
| Loop Until a = 0 |
| a = (Value / 2) |
| Do |
| Img.Circle (x, y), a, Clr |
| a = a - 1 |
| Loop Until a = 0 |
| End If |
| End Sub |
| 'HRANATY ST. |
| Public Sub Brush1(Img As PictureBox, x As Single, y As Single, Button As Integer, Clr As Long, Clr2 As Long, Value As Long) |
| If Button = 1 Then |
| Img.Refresh |
| Img.AutoRedraw = True |
| Do |
| a = a + 1 |
| Img.Line (x + a, y)-(x + a, y + Value), Clr |
| Loop Until a >= Value |
| Img.AutoRedraw = False |
| End If |
| If Button = 2 Then |
| Img.Refresh |
| Img.AutoRedraw = True |
| Do |
| a = a + 1 |
| Img.Line (x + a, y)-(x + a, y + Value), Clr2 |
| Loop Until a >= Value |
| Img.AutoRedraw = False |
| End If |
| If Button = 0 Then |
| Img.Refresh |
| Img.AutoRedraw = False |
| Do |
| a = a + 1 |
| Img.Line (x + a, y)-(x + a, y + Value), Clr |
| Loop Until a >= Value |
| End If |
| End Sub |
| 'Brush1 Picture1, X, y, button, &H0, &HFF, 10 |
| 'PLECHOVKA |
| Public Sub Vybarvi(Img As PictureBox, x As Single, y As Single, mode As Boolean, Clr As Long) |
| 'On Error Resume Next |
| Imgp = Img.Point(x, y) |
| Img.FillColor = Clr |
| Img.FillStyle = vbSolid |
| If mode = True Then |
| rtn = ExtFloodFill(Img.hdc, x, y, Clr2, 0) |
| End If |
| If mode = False Then |
| rtn = ExtFloodFill(Img.hdc, x, y, Imgp, 1) |
| End If |
| 'Vybarvi Picture1, x, y, False, Picture2.BackColor |
| End Sub |
| 'text: |
| Public Sub Textwr(Img As PictureBox, x As Single, y As Single, Text As TextBox, Size As Long, Font As ComboBox, Tucne As CheckBox, Kurziva As CheckBox, Podtrzene As CheckBox, Preskrtle As CheckBox, Transparent As CheckBox, Clr As Long, Clr2 As Long) |
| Img.CurrentX = x |
| Img.CurrentY = y |
| Img.Font.Name = Font |
| Img.Font.Size = Size |
| If Tucne = 0 Then Img.FontBold = False |
| If Tucne = 1 Then Img.FontBold = True |
| If Kurziva = 0 Then Img.FontItalic = False |
| If Kurziva = 1 Then Img.FontItalic = True |
| If Podtrzene = 0 Then Img.FontUnderline = False |
| If Podtrzene = 1 Then Img.FontUnderline = True |
| If Preskrtle = 0 Then Img.FontStrikethru = False |
| If Preskrtle = 1 Then Img.FontStrikethru = True |
| If Transparent = 0 Then Img.FontTransparent = False |
| If Transparent = 1 Then Img.FontTransparent = True |
| Img.ForeColor = Clr |
| Img.AutoRedraw = True |
| Img.Print Property.tBox |
| Img.Refresh |
| Img.AutoRedraw = False |
| End Sub |
| 'Textwr Picture1, X, Y, Text1, 10, Combo1, Check3, Check4, Check5, Check6, Check7, &H0, &HFF |
| 'spray: |
| Public Sub spray(Img As PictureBox, x As Single, y As Single, Button As Integer, Area As Long, Density As Long, Clr As Long) |
| Randomize Timer |
| If Button = 1 Then |
| Img.DrawWidth = 1 |
| For a = 0 To (Density / 10) * Area |
| t = Int(Rnd * 10) |
| C = Int(Rnd * 10) |
| If t <= 5 Then ttf = -1 |
| If t >= 5 Then ttf = 1 |
| If C <= 5 Then ttb = -1 |
| If C >= 5 Then ttb = 1 |
| Img.PSet (x + (Rnd * Area) * ttf, y + (Rnd * Area) * ttb), Clr |
| Next a |
| End If |
| 'spray Picture1, X, Y, Button, 40, 10, &H0 |
| End Sub |
| 'GuMa |
| Public Sub rubber(Img As PictureBox, Xa As Single, Ya As Single, Big As Long, Button As Integer) |
| Img.Refresh |
| Img.AutoRedraw = False |
| Img.Line (Xa, Ya)-(Xa - Big, Ya - Big), &HFFFFFF, BF |
| If Button = 1 Then |
| Img.AutoRedraw = True |
| Img.Line (Xa, Ya)-(Xa - Big, Ya - Big), &HFFFFFF, BF |
| Img.AutoRedraw = False |
| End If 'rubber Picture1, X, Y, 10, Button |
| End Sub |
| 'kapatkoo: |
| Public Sub Droper(Img As PictureBox, GetClr As PictureBox, Clr1 As PictureBox, Clr2 As PictureBox, Button As Integer, x As Single, y As Single, RGBr As TextBox, RGBg As TextBox, RGBb As TextBox) |
| RGBmax = 256 |
| i = StretchBlt(GetClr.hdc, 0, 0, 80, 80, Img.hdc, x, y, 1, 1, 13369376) |
| Imgp = GetClr.Point(5, 5) |
| RGBb = Imgp \ RGBmax \ RGBmax |
| RGBg = (Imgp \ RGBmax) Mod RGBmax |
| RGBr = Imgp Mod RGBmax |
| If Button = 1 Then Clr1.BackColor = GetClr.Point(5, 5) |
| If Button = 2 Then Clr2.BackColor = GetClr.Point(5, 5) |
| End Sub 'Droper Picture1, Picture2, Picture3, Picture4, Button, X, Y, Text1, Text2, Text3 |
| 'lupa:: |
| Public Sub lupa(Img As PictureBox, outImg As PictureBox, x As Single, y As Single, zveceni As Byte) |
| i = StretchBlt(outImg.hdc, 0, 0, outImg.ScaleWidth, outImg.ScaleHeight, Img.hdc, x, y, outImg.ScaleWidth / zveceni, outImg.ScaleHeight / zveceni, 13369376) |
| End Sub |
| 'lupa Picture1, Picture4, X, Y, 2 |
| 'AIRBRUSH:: |
| Public Sub Airbrush(Img As PictureBox, x As Single, y As Single, radius As Long, color As Long, hard As Long, Button As Integer) |
| Dim iBitmap As Long |
| Dim iDC As Long |
| Dim i As Integer |
| Dim bi24BitInfo As BITMAPINFO, bBytes() As Byte |
| Dim Cnt As Long |
| Dim xC As Long |
| Dim yC As Long |
| Dim Clr As rgb |
| Dim DimtmpRad As String |
| If Button = 1 Then |
| Clr = getRGB(color) |
| Img.AutoRedraw = True |
| tmpRad = CStr(radius) |
| For i = 1 To 9 Step 2 |
| If Right(tmpRad, 1) = i Then |
| radius = radius + 1 |
| Exit For |
| End If |
| Next |
| With bi24BitInfo.bmiHeader |
| .biBitCount = 24 |
| .biCompression = 0& |
| .biPlanes = 1 |
| .biSize = Len(bi24BitInfo.bmiHeader) |
| .biWidth = CLng(radius * 2) |
| .biHeight = CLng(radius * 2) |
| End With |
| ReDim bBytes(1 To (bi24BitInfo.bmiHeader.biWidth + 1) * (bi24BitInfo.bmiHeader.biHeight + 1) * 3) As Byte |
| iDC = CreateCompatibleDC(0) |
| iBitmap = CreateDIBSection(iDC, bi24BitInfo, 0, ByVal 0&, ByVal 0&, ByVal 0&) |
| SelectObject iDC, iBitmap |
| BitBlt iDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, Img.hdc, x - radius, y - radius, vbSrcCopy |
| GetDIBits iDC, iBitmap, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, 0 |
| Cnt = 1 |
| For yC = -radius To radius - 1 |
| For xC = -radius To radius - 1 |
| If (xC * xC) + (yC * yC) <= (radius * radius) - 1 Then |
| aplha = CByte((255 * ((Sqr((radius * radius)) - Sqr((xC * xC) + (yC * yC))) / radius)) / 100 * hard) |
| bBytes(Cnt) = getAlpha(CByte(aplha), CLng(Clr.b), CLng(bBytes(Cnt))) |
| bBytes(Cnt + 1) = getAlpha(CByte(aplha), CLng(Clr.g), CLng(bBytes(Cnt + 1))) |
| bBytes(Cnt + 2) = getAlpha(CByte(aplha), CLng(Clr.R), CLng(bBytes(Cnt + 2))) |
| End If |
| Cnt = Cnt + 3 |
| Next xC |
| Next yC |
| SetDIBitsToDevice Img.hdc, x - radius, y - radius, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, 0 |
| DeleteDC iDC |
| DeleteObject iBitmap |
| Img.Refresh |
| End If |
| End Sub |
| Private Function getAlpha(Alpha As Byte, Clr1 As Long, Clr2 As Long) |
| getAlpha = Clr2 + (((Clr1 * Alpha) / 255) - ((Clr2 * Alpha) / 255)) |
| End Function |
| Private Function getRGB(C As Long) As rgb |
| getRGB.R = CByte(C Mod 255) |
| getRGB.g = CByte((C \ 255) Mod 255) |
| getRGB.b = CByte(C \ 255 \ 255) |
| End Function |
| 'Airbrush Picture1, X, Y, 30, &H0, 21, button |
| /programy/VB/logic_analyzer/Opt.cls |
|---|
| 0,0 → 1,69 |
| VERSION 1.0 CLASS |
| BEGIN |
| MultiUse = -1 'True |
| Persistable = 0 'NotPersistable |
| DataBindingBehavior = 0 'vbNone |
| DataSourceBehavior = 0 'vbNone |
| MTSTransactionMode = 0 'NotAnMTSObject |
| END |
| Attribute VB_Name = "Opt" |
| Attribute VB_GlobalNameSpace = False |
| Attribute VB_Creatable = True |
| Attribute VB_PredeclaredId = False |
| Attribute VB_Exposed = False |
| Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes" |
| Attribute VB_Ext_KEY = "Top_Level" ,"Yes" |
| '##################################################### |
| '# # |
| '# OPT - Trida usnadnujici vstup a vystup do souboru # |
| '# by Michal Frdlík 2005, verze 1.2 # |
| '# # |
| '##################################################### |
| Public Function BasicInputFromFileToOneLine(ByRef Str, Path As String) As Boolean |
| On Error GoTo nf |
| Dim ofile |
| ofile = Path |
| wrap$ = Chr$(13) + Chr$(10) |
| Open ofile For Input As #1 |
| Do Until EOF(1) |
| Line Input #1, lineoftext$ |
| alltext$ = alltext$ & lineoftext$ |
| Loop |
| Str = alltext$ |
| Close #1 |
| BasicInputFromFileToOneLine = True |
| Exit Function |
| nf: BasicInputFromFileToOneLine = False |
| End Function |
| Public Function BasicInputFromFileToMultiLine(ByRef Str, Path As String) As Boolean |
| On Error GoTo nf |
| Dim ofile |
| ofile = Path |
| wrap$ = Chr$(13) + Chr$(10) |
| Open ofile For Input As #1 |
| Do Until EOF(1) |
| Line Input #1, lineoftext$ |
| alltext$ = alltext$ & lineoftext$ & wrap$ |
| Loop |
| Str = alltext$ |
| Close #1 |
| BasicInputFromFileToMultiLine = True |
| Exit Function |
| nf: BasicInputFromFileToMultiLine = False |
| End Function |
| Public Function BasicOutputToFile(Str, Path As String) As Boolean |
| On Error GoTo nf |
| Dim save$ |
| Dim hFile As Integer |
| save = Str |
| hFile = FreeFile |
| Open Path For Output As hFile |
| Print #hFile, save |
| Close hFile |
| BasicOutputToFile = True |
| Exit Function |
| nf: BasicOutputToFile = False |
| End Function |
| /programy/VB/logic_analyzer/Project1.vbp |
|---|
| 0,0 → 1,43 |
| Type=Exe |
| Form=Form1.frm |
| Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\System32\stdole2.tlb#OLE Automation |
| Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.OCX |
| Class=Opt; Opt.cls |
| Module=m_Fce; m_Fce.bas |
| Module=Nasroj; Nasroj.bas |
| Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX |
| IconForm="Form1" |
| Startup="Form1" |
| HelpFile="" |
| Title="LOG.AN." |
| ExeName32="log.exe" |
| Command32="" |
| Name="Project1" |
| HelpContextID="0" |
| CompatibleMode="0" |
| MajorVer=1 |
| MinorVer=0 |
| RevisionVer=0 |
| AutoIncrementVer=0 |
| ServerSupportFiles=0 |
| VersionCompanyName="Michal Frdlík 2005" |
| VersionLegalTrademarks="(MSD)2005" |
| VersionProductName="LOG.AN." |
| CompilationType=0 |
| OptimizationType=0 |
| FavorPentiumPro(tm)=0 |
| CodeViewDebugInfo=0 |
| NoAliasing=0 |
| BoundsCheck=0 |
| OverflowCheck=0 |
| FlPointCheck=0 |
| FDIVCheck=0 |
| UnroundedFP=0 |
| StartMode=0 |
| Unattended=0 |
| Retained=0 |
| ThreadPerObject=0 |
| MaxNumberOfThreads=1 |
| [MS Transaction Server] |
| AutoRefresh=1 |
| /programy/VB/logic_analyzer/Project1.vbw |
|---|
| 0,0 → 1,4 |
| Form1 = 44, 44, 591, 504, Z, 22, 22, 569, 482, C |
| Opt = 110, 110, 643, 556, C |
| m_Fce = 44, 44, 577, 490, |
| Nasroj = 0, 0, 0, 0, C |
| /programy/VB/logic_analyzer/demo.tst |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /programy/VB/logic_analyzer/graf1.bmp |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /programy/VB/logic_analyzer/incremen.tst |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /programy/VB/logic_analyzer/klic.tst |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /programy/VB/logic_analyzer/log.exe |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /programy/VB/logic_analyzer/m_Fce.bas |
|---|
| 0,0 → 1,85 |
| Attribute VB_Name = "m_Fce" |
| Public Function sec(x) |
| On Error Resume Next |
| sec = 1 / Cos(x) |
| End Function |
| Public Function cosec(x) |
| On Error Resume Next |
| cosec = 1 / Sin(x) |
| End Function |
| Public Function cotg(x) |
| On Error Resume Next |
| cotg = 1 / Tan(x) |
| End Function |
| Public Function arcsin(x) |
| On Error Resume Next |
| arcsin = Atn(x / Sqr(-x * x + 1)) |
| End Function |
| Public Function arccos(x) |
| On Error Resume Next |
| arccos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1) |
| End Function |
| Public Function arcsec(x) |
| On Error Resume Next |
| arcsec = 2 * Atn(1) * Atn(Sgn(x) / Sqr(x * x * 1)) |
| End Function |
| Public Function arccosec(x) |
| On Error Resume Next |
| arccosec = Atn(Sgn(x) / Sqr(x * x * 1)) |
| End Function |
| Public Function arccotg(x) |
| On Error Resume Next |
| arccotg = 2 * Atn(1) - Atn(x) |
| End Function |
| Public Function hsin(x) |
| On Error Resume Next |
| hsin = Exp(x) / 2 |
| End Function |
| Public Function hcos(x) |
| On Error Resume Next |
| hcos = Exp(x) / 2 ' exp(-x) |
| End Function |
| Public Function htan(x) |
| On Error Resume Next |
| htan = Exp(x) / (Exp(x) + Exp(-x)) |
| End Function |
| Public Function hsec(x) |
| On Error Resume Next |
| hsec 2 / (Exp(x) + Exp(-x)) |
| End Function |
| Public Function hcosec(x) |
| On Error Resume Next |
| hcosec = 2 / (Exp(x) * Exp(-x)) |
| End Function |
| Public Function hcotg(x) |
| On Error Resume Next |
| hcotg = (Exp(x) + Exp(-x)) / Exp(x) |
| End Function |
| Public Function harcsin() |
| On Error Resume Next |
| harcsin = Log(x + Sqr(x * x + 1)) |
| End Function |
| Public Function harccos() |
| On Error Resume Next |
| harccos = Log(x + Sqr(x * x * 1)) |
| End Function |
| Public Function harctan(x) |
| On Error Resume Next |
| harctanLog = ((1 + x) / (1 * x)) / 2 |
| End Function |
| Public Function harcsec(x) |
| On Error Resume Next |
| harcsec = Log((Sqr(-x * x + 1) + 1) / x) |
| End Function |
| Public Function harccosec(x) |
| On Error Resume Next |
| harccosec = Log((Sgn(x) * Sqr(x * x + 1) + 1) / x) |
| End Function |
| Public Function harccotg(x) |
| On Error Resume Next |
| harccotg = Log((x + 1) / (x * 1)) / 2 |
| End Function |
| Public Function logn(x, n) |
| On Error Resume Next |
| logn = Log(x) / Log(n) |
| End Function |
| /programy/VB/logic_analyzer/vysilac.tst |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /programy/VB/work/1st_program/INPOUT32.DPR |
|---|
| 0,0 → 1,38 |
| {Source code for inpout32.dll. |
| Enables 32-bit Visual Basic programs to do direct port I/O |
| (Inp and Out) under Windows 95. |
| To be compiled with Borland's Delphi 2.0.} |
| library inpout32; |
| uses SysUtils; |
| procedure Out32(PortAddress:smallint;Value:smallint);stdcall;export; |
| var |
| ByteValue:Byte; |
| begin |
| ByteValue:=Byte(Value); |
| asm |
| push dx |
| mov dx,PortAddress |
| mov al, ByteValue |
| out dx,al |
| pop dx |
| end; |
| end; |
| function Inp32(PortAddress:smallint):smallint;stdcall;export; |
| var |
| ByteValue:byte; |
| begin |
| asm |
| push dx |
| mov dx, PortAddress |
| in al,dx |
| mov ByteValue,al |
| pop dx |
| end; |
| Inp32:=smallint(ByteValue) and $00FF; |
| end; |
| Exports |
| Inp32, |
| Out32; |
| begin |
| end. |
| /programy/VB/work/1st_program/INPOUT32.TXT |
|---|
| 0,0 → 1,72 |
| Documentation for inpout32.zip |
| Inpout32.zip contains a DLL that enables direct reading and writing to I/O ports in 32-bit Visual-Basic programs running under Windows 95. |
| by Jan Axelson |
| Lakeview Research |
| Email: jaxelson@lvr.com |
| WWW: http://www.lvr.com |
| Important information and cautions: |
| 1. Use this DLL at your own risk. Writing directly to hardware ports can result in system crashes, loss of data, and even permanent damage. Inpout32 was developed to allow access to parallel ports and other ports on custom hardware, but you can use it to attempt to access any hardware that is mapped as an I/O port. You've been warned! |
| 2. Use this DLL only with 32-bit programs. 16-bit programs require a 16-bit DLL (inpout16.dll). |
| 3. Windows 95 allows direct port reads and writes unless a VxD has control of the port and blocks access. Under Windows NT, direct port access is not allowed, and you must use a kernel-mode device driver. |
| 4. For the latest parallel-port programming and interfacing information and tools, visit Parallel Port Central at: |
| http://www.lvr.com |
| *** |
| Inpout32.zip contains the following files: |
| inpout32.txt |
| This file |
| inpout32.dll |
| A DLL that enables the use of Inp and Out routines in 32-bit Visual Basic 4 and Visual Basic 5 programs. |
| inpout32.bas |
| Visual-Basic declarations for Inp and Out |
| inpout32.vbp |
| Visual Basic 4 test project for inpout32. The project will also load into and run under Visual Basic 5. |
| inpout32.frm |
| Startup form for the test project |
| inpout32.dpr |
| Source code for inpout32.dll. The DLL was compiled with Borland's Delphi 2.0 Object Pascal compiler. |
| *** |
| How to run the test program (inpout32.vbp): |
| 1. Copy inpout32.dll to one of these locations: your default Windows directory (usually \Windows), your Windows system directory (usually \Windows\system), or your application's working directory. In the VB programming environment, the working directory is the default VB directory. |
| 2. Open the project inpout32.vbp. |
| 3. In the Form_Load subroutine, set PortAddress equal to the port address you want to test. |
| 3. Clicking the command button causes the program to do the following: write a value to the port, read the port, and display the result. The value increments with each click, resetting to 0 at 255. |
| *** |
| How to use inpout32 in your programs: |
| 1. Copy inpout32.dll to your default Windows directory (or other directory as described above). |
| 2. Add inpout32.bas to your Visual-Basic project (File menu, Add File). |
| 3. Use this syntax to write to a port: |
| Out PortAddress, ValueToWrite |
| Example: |
| Out &h378, &h55 |
| Use this syntax to read a port: |
| ValueRead = Inp(PortAddress) |
| Example: |
| ValueRead = Inp(&h378) |
| (The syntax is identical to QuickBasic's Inp and Out). |
| /programy/VB/work/1st_program/INPOUT32.VBP |
|---|
| 0,0 → 1,30 |
| Type=Exe |
| Form=inpout32.frm |
| Module=inpout; Inpout32.bas |
| IconForm="inpout32" |
| Startup="inpout32" |
| Command32="" |
| Name="Project1" |
| HelpContextID="0" |
| CompatibleMode="0" |
| MajorVer=1 |
| MinorVer=0 |
| RevisionVer=0 |
| AutoIncrementVer=0 |
| ServerSupportFiles=0 |
| VersionCompanyName="doma" |
| CompilationType=0 |
| OptimizationType=0 |
| FavorPentiumPro(tm)=0 |
| CodeViewDebugInfo=0 |
| NoAliasing=0 |
| BoundsCheck=0 |
| OverflowCheck=0 |
| FlPointCheck=0 |
| FDIVCheck=0 |
| UnroundedFP=0 |
| StartMode=0 |
| Unattended=0 |
| Retained=0 |
| ThreadPerObject=0 |
| MaxNumberOfThreads=1 |
| /programy/VB/work/1st_program/INPOUT32.vbw |
|---|
| 0,0 → 1,2 |
| inpout32 = 25, -2, 354, 453, Z, -2, -9, 554, 447, C |
| inpout = 66, 66, 317, 328, C |
| /programy/VB/work/1st_program/Inpout32.bas |
|---|
| 0,0 → 1,29 |
| Attribute VB_Name = "inpout" |
| 'Inp and Out declarations for direct port I/O |
| 'in 32-bit Visual Basic 4 programs. |
| Public Declare Function Input32 Lib "inpout32.dll" _ |
| Alias "Inp32" (ByVal PortAddress As Integer) As Integer |
| Public Declare Sub Output Lib "inpout32.dll" _ |
| Alias "Out32" (ByVal PortAddress As Integer, ByVal Value As Integer) |
| Sub out(ByVal Value As Integer) |
| Output &H3BC, Value |
| End Sub |
| Function inp() As Integer |
| inp = Input32(&H3BD) |
| End Function |
| Function inp11() As Boolean |
| inp11 = ((inp And &H80) = 0) |
| End Function |
| Function inp10() As Boolean |
| inp10 = Not ((inp And &H40) = 0) |
| End Function |
| Function inp12() As Boolean |
| inp12 = Not ((inp And &H20) = 0) |
| End Function |
| Function inp13() As Boolean |
| inp13 = Not ((inp And &H10) = 0) |
| End Function |
| /programy/VB/work/1st_program/inpout32.frm |
|---|
| 0,0 → 1,323 |
| VERSION 5.00 |
| Begin VB.Form inpout32 |
| Caption = "Form1" |
| ClientHeight = 4710 |
| ClientLeft = 915 |
| ClientTop = 1410 |
| ClientWidth = 4770 |
| LinkTopic = "Form1" |
| PaletteMode = 1 'UseZOrder |
| ScaleHeight = 4710 |
| ScaleWidth = 4770 |
| Begin VB.CheckBox Check2 |
| Caption = "Check2" |
| Height = 375 |
| Left = 2640 |
| Style = 1 'Graphical |
| TabIndex = 22 |
| Top = 2880 |
| Width = 135 |
| End |
| Begin VB.CheckBox Check1 |
| Caption = "Check1" |
| Height = 375 |
| Left = 2520 |
| Style = 1 'Graphical |
| TabIndex = 21 |
| Top = 2880 |
| Width = 135 |
| End |
| Begin VB.CommandButton Command11 |
| Caption = "Command11" |
| Height = 195 |
| Left = 4320 |
| TabIndex = 20 |
| Top = 2280 |
| Width = 135 |
| End |
| Begin VB.CommandButton Command10 |
| Caption = "Command10" |
| Height = 195 |
| Left = 4080 |
| TabIndex = 19 |
| Top = 2280 |
| Width = 135 |
| End |
| Begin VB.CommandButton Command9 |
| Caption = "Command9" |
| Height = 195 |
| Left = 3840 |
| TabIndex = 18 |
| Top = 2280 |
| Width = 135 |
| End |
| Begin VB.CommandButton Command8 |
| Caption = "Command8" |
| Height = 195 |
| Left = 3600 |
| TabIndex = 17 |
| Top = 2280 |
| Width = 135 |
| End |
| Begin VB.CommandButton Command7 |
| Caption = "Command7" |
| Height = 195 |
| Left = 3240 |
| TabIndex = 16 |
| Top = 2280 |
| Width = 135 |
| End |
| Begin VB.CommandButton Command6 |
| Caption = "Command6" |
| Height = 195 |
| Left = 3000 |
| TabIndex = 15 |
| Top = 2280 |
| Width = 135 |
| End |
| Begin VB.CommandButton Command5 |
| Caption = "Command5" |
| Height = 195 |
| Left = 2760 |
| TabIndex = 14 |
| Top = 2280 |
| Width = 135 |
| End |
| Begin VB.CommandButton Command4 |
| Caption = "Command4" |
| Height = 195 |
| Left = 2520 |
| TabIndex = 13 |
| Top = 2280 |
| Width = 135 |
| End |
| Begin VB.Timer Timer3 |
| Left = 3120 |
| Top = 3960 |
| End |
| Begin VB.TextBox Text13 |
| Height = 285 |
| Left = 3240 |
| TabIndex = 8 |
| Text = "Text5" |
| Top = 1680 |
| Width = 495 |
| End |
| Begin VB.TextBox Text12 |
| Height = 285 |
| Left = 3240 |
| TabIndex = 7 |
| Text = "Text4" |
| Top = 1200 |
| Width = 495 |
| End |
| Begin VB.TextBox Text10 |
| Height = 285 |
| Left = 3240 |
| TabIndex = 6 |
| Text = "Text3" |
| Top = 240 |
| Width = 495 |
| End |
| Begin VB.TextBox Text11 |
| Height = 285 |
| Left = 3240 |
| TabIndex = 5 |
| Text = "Text2" |
| Top = 720 |
| Width = 495 |
| End |
| Begin VB.CommandButton Command3 |
| Caption = "Command3" |
| Height = 615 |
| Left = 240 |
| TabIndex = 4 |
| Top = 3840 |
| Width = 2055 |
| End |
| Begin VB.Timer Timer2 |
| Left = 1680 |
| Top = 120 |
| End |
| Begin VB.CommandButton Command2 |
| Caption = "Command2" |
| Height = 615 |
| Left = 240 |
| TabIndex = 3 |
| Top = 2760 |
| Width = 2055 |
| End |
| Begin VB.CommandButton Command1 |
| Caption = "Command1" |
| Height = 615 |
| Left = 240 |
| TabIndex = 2 |
| Top = 1680 |
| Width = 2055 |
| End |
| Begin VB.Timer Timer1 |
| Left = 2400 |
| Top = 3960 |
| End |
| Begin VB.TextBox Text1 |
| Height = 372 |
| Left = 960 |
| TabIndex = 1 |
| Text = "Text1" |
| Top = 120 |
| Width = 615 |
| End |
| Begin VB.CommandButton cmdWriteToPort |
| Caption = "Write to Port" |
| Height = 732 |
| Left = 240 |
| TabIndex = 0 |
| Top = 720 |
| Width = 1932 |
| End |
| Begin VB.Label Label13 |
| Caption = "13" |
| Height = 375 |
| Left = 3840 |
| TabIndex = 12 |
| Top = 1680 |
| Width = 375 |
| End |
| Begin VB.Label Label3 |
| Caption = "12" |
| Height = 375 |
| Left = 3840 |
| TabIndex = 11 |
| Top = 1200 |
| Width = 375 |
| End |
| Begin VB.Label Label2 |
| Caption = "10" |
| Height = 375 |
| Left = 3840 |
| TabIndex = 10 |
| Top = 240 |
| Width = 375 |
| End |
| Begin VB.Label Label1 |
| Caption = "11" |
| Height = 255 |
| Left = 3840 |
| TabIndex = 9 |
| Top = 720 |
| Width = 255 |
| End |
| End |
| Attribute VB_Name = "inpout32" |
| Attribute VB_GlobalNameSpace = False |
| Attribute VB_Creatable = False |
| Attribute VB_PredeclaredId = True |
| Attribute VB_Exposed = False |
| Option Explicit |
| Dim Value As Integer |
| Dim PortAddress As Integer |
| Dim stav As Boolean |
| Dim promena As Byte |
| Private Sub cmdWriteToPort_Click() |
| 'Write to a port. |
| out Value |
| 'Read back and display the result. |
| Value = Value + 1 |
| If Value = 255 Then Value = 0 |
| End Sub |
| Private Sub Command1_Click() |
| out 1 |
| Timer1.Enabled = True |
| End Sub |
| Private Sub Command10_Click() |
| out &H40 |
| End Sub |
| Private Sub Command11_Click() |
| out &H80 |
| End Sub |
| Private Sub Command2_Click() |
| out &HFF |
| Timer1.Enabled = True |
| End Sub |
| Private Sub Command3_Click() |
| out 3 |
| Timer1.Enabled = True |
| End Sub |
| Private Sub Command4_Click() |
| out &H1 |
| End Sub |
| Private Sub Command5_Click() |
| out &H2 |
| End Sub |
| Private Sub Command6_Click() |
| out &H4 |
| End Sub |
| Private Sub Command7_Click() |
| out &H8 |
| End Sub |
| Private Sub Command8_Click() |
| out &H10 |
| End Sub |
| Private Sub Command9_Click() |
| out &H20 |
| End Sub |
| Private Sub Form_Load() |
| Timer1.Interval = 1000 |
| Timer2.Interval = 10 |
| Timer3.Interval = 100 |
| End Sub |
| Private Sub Check1_Click() |
| If Check1.Value = 1 Then |
| promena = promena Or &H1 |
| Else |
| promena = promena And &HFE |
| End If |
| out promena |
| End Sub |
| Private Sub Check2_Click() |
| If Check2.Value = 1 Then |
| promena = promena Or &H2 |
| Else |
| promena = promena And &HFD |
| End If |
| out promena |
| End Sub |
| Private Sub Timer1_Timer() |
| out 0 |
| Timer1.Enabled = False |
| End Sub |
| Private Sub Timer2_Timer() |
| 'toto se provede kazdych 10ms |
| Text1.Text = inp |
| Text10.Text = inp10 |
| Text11.Text = inp11 |
| Text12.Text = inp12 |
| Text13.Text = inp13 |
| If Not inp10 Then |
| Command2_Click |
| End If |
| End Sub |
| 'Private Sub Timer3_Timer() |
| 'If stav Then |
| 'out 1 |
| 'stav = False |
| 'Else |
| 'out 0 |
| 'stav = True |
| 'End If |
| 'End Sub |
| /programy/VB/work/1st_program/mssccprj.scc |
|---|
| 0,0 → 1,5 |
| SCC = This is a Source Code Control file |
| [INPOUT32.VBP] |
| SCC_Aux_Path = "C:\PROGRAM FILES\MICROSOFT VISUAL STUDIO\COMMON\VSS" |
| SCC_Project_Name = "$/programy/VB/work/1st_program", ZDBAAAAA |
| /programy/VB/work/1st_program/vssver.scc |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /programy/VB/work/INPOUT32.DLL |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /programy/VB/work/INPOUT32.DPR |
|---|
| 0,0 → 1,38 |
| {Source code for inpout32.dll. |
| Enables 32-bit Visual Basic programs to do direct port I/O |
| (Inp and Out) under Windows 95. |
| To be compiled with Borland's Delphi 2.0.} |
| library inpout32; |
| uses SysUtils; |
| procedure Out32(PortAddress:smallint;Value:smallint);stdcall;export; |
| var |
| ByteValue:Byte; |
| begin |
| ByteValue:=Byte(Value); |
| asm |
| push dx |
| mov dx,PortAddress |
| mov al, ByteValue |
| out dx,al |
| pop dx |
| end; |
| end; |
| function Inp32(PortAddress:smallint):smallint;stdcall;export; |
| var |
| ByteValue:byte; |
| begin |
| asm |
| push dx |
| mov dx, PortAddress |
| in al,dx |
| mov ByteValue,al |
| pop dx |
| end; |
| Inp32:=smallint(ByteValue) and $00FF; |
| end; |
| Exports |
| Inp32, |
| Out32; |
| begin |
| end. |
| /programy/VB/work/INPOUT32.TXT |
|---|
| 0,0 → 1,72 |
| Documentation for inpout32.zip |
| Inpout32.zip contains a DLL that enables direct reading and writing to I/O ports in 32-bit Visual-Basic programs running under Windows 95. |
| by Jan Axelson |
| Lakeview Research |
| Email: jaxelson@lvr.com |
| WWW: http://www.lvr.com |
| Important information and cautions: |
| 1. Use this DLL at your own risk. Writing directly to hardware ports can result in system crashes, loss of data, and even permanent damage. Inpout32 was developed to allow access to parallel ports and other ports on custom hardware, but you can use it to attempt to access any hardware that is mapped as an I/O port. You've been warned! |
| 2. Use this DLL only with 32-bit programs. 16-bit programs require a 16-bit DLL (inpout16.dll). |
| 3. Windows 95 allows direct port reads and writes unless a VxD has control of the port and blocks access. Under Windows NT, direct port access is not allowed, and you must use a kernel-mode device driver. |
| 4. For the latest parallel-port programming and interfacing information and tools, visit Parallel Port Central at: |
| http://www.lvr.com |
| *** |
| Inpout32.zip contains the following files: |
| inpout32.txt |
| This file |
| inpout32.dll |
| A DLL that enables the use of Inp and Out routines in 32-bit Visual Basic 4 and Visual Basic 5 programs. |
| inpout32.bas |
| Visual-Basic declarations for Inp and Out |
| inpout32.vbp |
| Visual Basic 4 test project for inpout32. The project will also load into and run under Visual Basic 5. |
| inpout32.frm |
| Startup form for the test project |
| inpout32.dpr |
| Source code for inpout32.dll. The DLL was compiled with Borland's Delphi 2.0 Object Pascal compiler. |
| *** |
| How to run the test program (inpout32.vbp): |
| 1. Copy inpout32.dll to one of these locations: your default Windows directory (usually \Windows), your Windows system directory (usually \Windows\system), or your application's working directory. In the VB programming environment, the working directory is the default VB directory. |
| 2. Open the project inpout32.vbp. |
| 3. In the Form_Load subroutine, set PortAddress equal to the port address you want to test. |
| 3. Clicking the command button causes the program to do the following: write a value to the port, read the port, and display the result. The value increments with each click, resetting to 0 at 255. |
| *** |
| How to use inpout32 in your programs: |
| 1. Copy inpout32.dll to your default Windows directory (or other directory as described above). |
| 2. Add inpout32.bas to your Visual-Basic project (File menu, Add File). |
| 3. Use this syntax to write to a port: |
| Out PortAddress, ValueToWrite |
| Example: |
| Out &h378, &h55 |
| Use this syntax to read a port: |
| ValueRead = Inp(PortAddress) |
| Example: |
| ValueRead = Inp(&h378) |
| (The syntax is identical to QuickBasic's Inp and Out). |
| /programy/VB/work/INPOUT32.VBP |
|---|
| 0,0 → 1,30 |
| Type=Exe |
| Form=inpout32.frm |
| Module=inpout; Inpout32.bas |
| IconForm="inpout32" |
| Startup="inpout32" |
| Command32="" |
| Name="Project1" |
| HelpContextID="0" |
| CompatibleMode="0" |
| MajorVer=1 |
| MinorVer=0 |
| RevisionVer=0 |
| AutoIncrementVer=0 |
| ServerSupportFiles=0 |
| VersionCompanyName="doma" |
| CompilationType=0 |
| OptimizationType=0 |
| FavorPentiumPro(tm)=0 |
| CodeViewDebugInfo=0 |
| NoAliasing=0 |
| BoundsCheck=0 |
| OverflowCheck=0 |
| FlPointCheck=0 |
| FDIVCheck=0 |
| UnroundedFP=0 |
| StartMode=0 |
| Unattended=0 |
| Retained=0 |
| ThreadPerObject=0 |
| MaxNumberOfThreads=1 |
| /programy/VB/work/INPOUT32.vbw |
|---|
| 0,0 → 1,2 |
| inpout32 = 25, -2, 354, 453, , -2, -9, 554, 447, C |
| inpout = 66, 66, 317, 328, C |
| /programy/VB/work/Inpout32.bas |
|---|
| 0,0 → 1,29 |
| Attribute VB_Name = "inpout" |
| 'Inp and Out declarations for direct port I/O |
| 'in 32-bit Visual Basic 4 programs. |
| Public Declare Function Input32 Lib "inpout32.dll" _ |
| Alias "Inp32" (ByVal PortAddress As Integer) As Integer |
| Public Declare Sub Output Lib "inpout32.dll" _ |
| Alias "Out32" (ByVal PortAddress As Integer, ByVal Value As Integer) |
| Sub out(ByVal Value As Integer) |
| Output &H3BC, Value |
| End Sub |
| Function inp() As Integer |
| inp = Input32(&H3BD) |
| End Function |
| Function inp11() As Boolean |
| inp11 = ((inp And &H80) = 0) |
| End Function |
| Function inp10() As Boolean |
| inp10 = Not ((inp And &H40) = 0) |
| End Function |
| Function inp12() As Boolean |
| inp12 = Not ((inp And &H20) = 0) |
| End Function |
| Function inp13() As Boolean |
| inp13 = Not ((inp And &H10) = 0) |
| End Function |
| /programy/VB/work/inpout32.frm |
|---|
| 0,0 → 1,271 |
| VERSION 5.00 |
| Begin VB.Form inpout32 |
| Caption = "Form1" |
| ClientHeight = 4710 |
| ClientLeft = 915 |
| ClientTop = 1410 |
| ClientWidth = 4770 |
| LinkTopic = "Form1" |
| PaletteMode = 1 'UseZOrder |
| ScaleHeight = 4710 |
| ScaleWidth = 4770 |
| Begin VB.Timer Timer2 |
| Left = 2400 |
| Top = 3480 |
| End |
| Begin VB.HScrollBar HScroll1 |
| Height = 375 |
| Left = 240 |
| Max = 500 |
| TabIndex = 17 |
| Top = 3000 |
| Value = 5 |
| Width = 1695 |
| End |
| Begin VB.Timer Timer1 |
| Left = 360 |
| Top = 3480 |
| End |
| Begin VB.CommandButton Command11 |
| Caption = "8" |
| Height = 195 |
| Left = 4320 |
| TabIndex = 16 |
| Top = 2280 |
| Width = 135 |
| End |
| Begin VB.CommandButton Command10 |
| Caption = "7" |
| Height = 195 |
| Left = 4080 |
| TabIndex = 15 |
| Top = 2280 |
| Width = 135 |
| End |
| Begin VB.CommandButton Command9 |
| Caption = "6" |
| Height = 195 |
| Left = 3840 |
| TabIndex = 14 |
| Top = 2280 |
| Width = 135 |
| End |
| Begin VB.CommandButton Command8 |
| Caption = "5" |
| Height = 195 |
| Left = 3600 |
| TabIndex = 13 |
| Top = 2280 |
| Width = 135 |
| End |
| Begin VB.CommandButton Command7 |
| Caption = "4" |
| Height = 195 |
| Left = 3240 |
| TabIndex = 12 |
| Top = 2280 |
| Width = 135 |
| End |
| Begin VB.CommandButton Command6 |
| Caption = "3" |
| Height = 195 |
| Left = 3000 |
| TabIndex = 11 |
| Top = 2280 |
| Width = 135 |
| End |
| Begin VB.CommandButton Command5 |
| Caption = "2" |
| Height = 195 |
| Left = 2760 |
| TabIndex = 10 |
| Top = 2280 |
| Width = 135 |
| End |
| Begin VB.CommandButton Command4 |
| Caption = "1" |
| Height = 195 |
| Left = 2520 |
| TabIndex = 9 |
| Top = 2280 |
| Width = 135 |
| End |
| Begin VB.TextBox Text13 |
| Height = 285 |
| Left = 3240 |
| TabIndex = 4 |
| Top = 1680 |
| Width = 495 |
| End |
| Begin VB.TextBox Text12 |
| Height = 285 |
| Left = 3240 |
| TabIndex = 3 |
| Top = 1200 |
| Width = 495 |
| End |
| Begin VB.TextBox Text10 |
| Height = 285 |
| Left = 3240 |
| TabIndex = 2 |
| Top = 240 |
| Width = 495 |
| End |
| Begin VB.TextBox Text11 |
| Height = 285 |
| Left = 3240 |
| TabIndex = 1 |
| Top = 720 |
| Width = 495 |
| End |
| Begin VB.Timer Timer_input |
| Left = 1680 |
| Top = 120 |
| End |
| Begin VB.TextBox Text1 |
| Height = 372 |
| Left = 960 |
| TabIndex = 0 |
| Top = 120 |
| Width = 615 |
| End |
| Begin VB.Label Label13 |
| Caption = "13" |
| Height = 375 |
| Left = 3840 |
| TabIndex = 8 |
| Top = 1680 |
| Width = 375 |
| End |
| Begin VB.Label Label3 |
| Caption = "12" |
| Height = 375 |
| Left = 3840 |
| TabIndex = 7 |
| Top = 1200 |
| Width = 375 |
| End |
| Begin VB.Label Label2 |
| Caption = "10" |
| Height = 375 |
| Left = 3840 |
| TabIndex = 6 |
| Top = 240 |
| Width = 375 |
| End |
| Begin VB.Label Label1 |
| Caption = "11" |
| Height = 255 |
| Left = 3840 |
| TabIndex = 5 |
| Top = 720 |
| Width = 255 |
| End |
| End |
| Attribute VB_Name = "inpout32" |
| Attribute VB_GlobalNameSpace = False |
| Attribute VB_Creatable = False |
| Attribute VB_PredeclaredId = True |
| Attribute VB_Exposed = False |
| Dim pocitadlo |
| Dim stare_cislo |
| Private Sub Command10_Click() |
| out &H40 |
| End Sub |
| Private Sub Command11_Click() |
| out &H80 |
| End Sub |
| Private Sub Command2_Click() |
| out &HFF |
| Timer1.Enabled = True |
| End Sub |
| Private Sub Command3_Click() |
| out 3 |
| Timer1.Enabled = True |
| End Sub |
| Private Sub Command4_Click() |
| out &H1 |
| End Sub |
| Private Sub Command5_Click() |
| out &H2 |
| End Sub |
| Private Sub Command6_Click() |
| out &H4 |
| End Sub |
| Private Sub Command7_Click() |
| out &H8 |
| End Sub |
| Private Sub Command8_Click() |
| out &H10 |
| End Sub |
| Private Sub Command9_Click() |
| out &H20 |
| End Sub |
| Private Sub Form_Load() |
| Timer_input.Interval = 100 |
| Timer_input.Enabled = True |
| stare_cislo = HScroll1.Value |
| End Sub |
| Private Sub HScroll1_Change() |
| If HScroll1.Value < stare_cislo Then |
| Timer1.Interval = 1 |
| Timer1.Enabled = True |
| End If |
| If HScroll1.Value > stare_cislo Then |
| Timer2.Interval = 1 |
| Timer2.Enabled = True |
| End If |
| stare_cislo = HScroll1.Value |
| End Sub |
| Private Sub Timer_input_Timer() |
| Text1.Text = inp |
| Text10.Text = inp10 |
| Text11.Text = inp11 |
| Text12.Text = inp12 |
| Text13.Text = inp13 |
| End Sub |
| Private Sub Timer1_Timer() |
| Select Case pocitadlo |
| Case 1 |
| Call Command8_Click |
| Case 2 |
| Call Command10_Click |
| Case 3 |
| Call Command9_Click |
| Case 4 |
| Call Command11_Click |
| Timer1.Enabled = False |
| pocitadlo = 0 |
| End Select |
| pocitadlo = pocitadlo + 1 |
| End Sub |
| Private Sub Timer2_Timer() |
| Select Case pocitadlo |
| Case 1 |
| Call Command11_Click |
| Case 2 |
| Call Command9_Click |
| Case 3 |
| Call Command10_Click |
| Case 4 |
| Call Command8_Click |
| Timer2.Enabled = False |
| pocitadlo = 0 |
| End Select |
| pocitadlo = pocitadlo + 1 |
| End Sub |
| /programy/VB/work/joystick/INPOUT32.DLL |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /programy/VB/work/joystick/INPOUT32.DPR |
|---|
| 0,0 → 1,38 |
| {Source code for inpout32.dll. |
| Enables 32-bit Visual Basic programs to do direct port I/O |
| (Inp and Out) under Windows 95. |
| To be compiled with Borland's Delphi 2.0.} |
| library inpout32; |
| uses SysUtils; |
| procedure Out32(PortAddress:smallint;Value:smallint);stdcall;export; |
| var |
| ByteValue:Byte; |
| begin |
| ByteValue:=Byte(Value); |
| asm |
| push dx |
| mov dx,PortAddress |
| mov al, ByteValue |
| out dx,al |
| pop dx |
| end; |
| end; |
| function Inp32(PortAddress:smallint):smallint;stdcall;export; |
| var |
| ByteValue:byte; |
| begin |
| asm |
| push dx |
| mov dx, PortAddress |
| in al,dx |
| mov ByteValue,al |
| pop dx |
| end; |
| Inp32:=smallint(ByteValue) and $00FF; |
| end; |
| Exports |
| Inp32, |
| Out32; |
| begin |
| end. |
| /programy/VB/work/joystick/INPOUT32.TXT |
|---|
| 0,0 → 1,72 |
| Documentation for inpout32.zip |
| Inpout32.zip contains a DLL that enables direct reading and writing to I/O ports in 32-bit Visual-Basic programs running under Windows 95. |
| by Jan Axelson |
| Lakeview Research |
| Email: jaxelson@lvr.com |
| WWW: http://www.lvr.com |
| Important information and cautions: |
| 1. Use this DLL at your own risk. Writing directly to hardware ports can result in system crashes, loss of data, and even permanent damage. Inpout32 was developed to allow access to parallel ports and other ports on custom hardware, but you can use it to attempt to access any hardware that is mapped as an I/O port. You've been warned! |
| 2. Use this DLL only with 32-bit programs. 16-bit programs require a 16-bit DLL (inpout16.dll). |
| 3. Windows 95 allows direct port reads and writes unless a VxD has control of the port and blocks access. Under Windows NT, direct port access is not allowed, and you must use a kernel-mode device driver. |
| 4. For the latest parallel-port programming and interfacing information and tools, visit Parallel Port Central at: |
| http://www.lvr.com |
| *** |
| Inpout32.zip contains the following files: |
| inpout32.txt |
| This file |
| inpout32.dll |
| A DLL that enables the use of Inp and Out routines in 32-bit Visual Basic 4 and Visual Basic 5 programs. |
| inpout32.bas |
| Visual-Basic declarations for Inp and Out |
| inpout32.vbp |
| Visual Basic 4 test project for inpout32. The project will also load into and run under Visual Basic 5. |
| inpout32.frm |
| Startup form for the test project |
| inpout32.dpr |
| Source code for inpout32.dll. The DLL was compiled with Borland's Delphi 2.0 Object Pascal compiler. |
| *** |
| How to run the test program (inpout32.vbp): |
| 1. Copy inpout32.dll to one of these locations: your default Windows directory (usually \Windows), your Windows system directory (usually \Windows\system), or your application's working directory. In the VB programming environment, the working directory is the default VB directory. |
| 2. Open the project inpout32.vbp. |
| 3. In the Form_Load subroutine, set PortAddress equal to the port address you want to test. |
| 3. Clicking the command button causes the program to do the following: write a value to the port, read the port, and display the result. The value increments with each click, resetting to 0 at 255. |
| *** |
| How to use inpout32 in your programs: |
| 1. Copy inpout32.dll to your default Windows directory (or other directory as described above). |
| 2. Add inpout32.bas to your Visual-Basic project (File menu, Add File). |
| 3. Use this syntax to write to a port: |
| Out PortAddress, ValueToWrite |
| Example: |
| Out &h378, &h55 |
| Use this syntax to read a port: |
| ValueRead = Inp(PortAddress) |
| Example: |
| ValueRead = Inp(&h378) |
| (The syntax is identical to QuickBasic's Inp and Out). |
| /programy/VB/work/joystick/INPOUT32.VBP |
|---|
| 0,0 → 1,31 |
| Type=Exe |
| Form=inpout32.frm |
| Module=inpout; Inpout32.bas |
| IconForm="inpout32" |
| Startup="inpout32" |
| HelpFile="" |
| Command32="" |
| Name="Project1" |
| HelpContextID="0" |
| CompatibleMode="0" |
| MajorVer=1 |
| MinorVer=0 |
| RevisionVer=0 |
| AutoIncrementVer=0 |
| ServerSupportFiles=0 |
| VersionCompanyName="doma" |
| CompilationType=0 |
| OptimizationType=0 |
| FavorPentiumPro(tm)=0 |
| CodeViewDebugInfo=0 |
| NoAliasing=0 |
| BoundsCheck=0 |
| OverflowCheck=0 |
| FlPointCheck=0 |
| FDIVCheck=0 |
| UnroundedFP=0 |
| StartMode=0 |
| Unattended=0 |
| Retained=0 |
| ThreadPerObject=0 |
| MaxNumberOfThreads=1 |
| /programy/VB/work/joystick/INPOUT32.vbw |
|---|
| 0,0 → 1,2 |
| inpout32 = 25, -2, 354, 453, Z, -2, -9, 554, 447, C |
| inpout = 66, 66, 317, 328, |
| /programy/VB/work/joystick/Inpout32.bas |
|---|
| 0,0 → 1,29 |
| Attribute VB_Name = "inpout" |
| 'Inp and Out declarations for direct port I/O |
| 'in 32-bit Visual Basic 4 programs. |
| Public Declare Function Input32 Lib "inpout32.dll" _ |
| Alias "Inp32" (ByVal PortAddress As Integer) As Integer |
| Public Declare Sub Output Lib "inpout32.dll" _ |
| Alias "Out32" (ByVal PortAddress As Integer, ByVal Value As Integer) |
| Sub out(ByVal Value As Integer) |
| Output &H3BC, Value |
| End Sub |
| Function inp() As Integer |
| inp = Input32(&H3BD) |
| End Function |
| Function inp11() As Boolean |
| inp11 = ((inp And &H80) = 0) |
| End Function |
| Function inp10() As Boolean |
| inp10 = Not ((inp And &H40) = 0) |
| End Function |
| Function inp12() As Boolean |
| inp12 = Not ((inp And &H20) = 0) |
| End Function |
| Function inp13() As Boolean |
| inp13 = Not ((inp And &H10) = 0) |
| End Function |
| /programy/VB/work/joystick/inpout32.frm |
|---|
| 0,0 → 1,78 |
| VERSION 5.00 |
| Begin VB.Form inpout32 |
| Caption = "Form1" |
| ClientHeight = 4710 |
| ClientLeft = 915 |
| ClientTop = 1410 |
| ClientWidth = 4770 |
| LinkTopic = "Form1" |
| PaletteMode = 1 'UseZOrder |
| ScaleHeight = 4710 |
| ScaleWidth = 4770 |
| Begin VB.Timer TimerY |
| Left = 1680 |
| Top = 600 |
| End |
| Begin VB.TextBox TextY |
| Height = 375 |
| Left = 960 |
| TabIndex = 1 |
| Text = "Y" |
| Top = 600 |
| Width = 615 |
| End |
| Begin VB.Timer TimerX |
| Left = 1680 |
| Top = 120 |
| End |
| Begin VB.TextBox TextX |
| Height = 372 |
| Left = 960 |
| TabIndex = 0 |
| Text = "X" |
| Top = 120 |
| Width = 615 |
| End |
| End |
| Attribute VB_Name = "inpout32" |
| Attribute VB_GlobalNameSpace = False |
| Attribute VB_Creatable = False |
| Attribute VB_PredeclaredId = True |
| Attribute VB_Exposed = False |
| Dim pocitadlo |
| Private Sub Form_Load() |
| TimerX.Interval = 500 |
| TimerX.Enabled = True |
| TimerY.Interval = 500 |
| TimerY.Enabled = True |
| End Sub |
| Private Sub TimerX_Timer() |
| Dim vstup |
| Output &H201, &HFF |
| For n = 1 To 1000 |
| pocitadlo = n |
| vstup = Input32(&H201) And 1 |
| If vstup = 0 Then |
| GoTo ven |
| End If |
| Next n |
| ven: |
| TextX.Text = pocitadlo |
| End Sub |
| Private Sub TimerY_Timer() |
| Dim vstup |
| Output &H201, &HFF |
| For n = 1 To 1000 |
| pocitadlo = n |
| vstup = Input32(&H201) And 2 |
| If vstup = 0 Then |
| GoTo ven |
| End If |
| Next n |
| ven: |
| TextY.Text = pocitadlo |
| End Sub |
| /programy/VB/work/joystick/mssccprj.scc |
|---|
| 0,0 → 1,5 |
| SCC = This is a Source Code Control file |
| [INPOUT32.VBP] |
| SCC_Aux_Path = "C:\PROGRAM FILES\MICROSOFT VISUAL STUDIO\COMMON\VSS" |
| SCC_Project_Name = "$/programy/VB/work/joystick", RDBAAAAA |
| /programy/VB/work/joystick/vssver.scc |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /programy/VB/work/mssccprj.scc |
|---|
| 0,0 → 1,5 |
| SCC = This is a Source Code Control file |
| [INPOUT32.VBP] |
| SCC_Aux_Path = "C:\PROGRAM FILES\MICROSOFT VISUAL STUDIO\COMMON\VSS" |
| SCC_Project_Name = "$/programy/VB/work", QDBAAAAA |
| /programy/VB/work/vssver.scc |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
