-

 -

(0)

EEPROM

, 04 2017 . 23:56 +

: -1.10.1 AD7755 TFT LCD , 🤑 , - .


 -1.10.1 AD7755  ATMega8 (700x525, 95Kb)

, +3,3 +50, 220 . , , , 2 , , , AD7755. , , . , , . - , , . , USB- Aliexpress 49₽, +5, .



, , , . , EEPROM. EEPROM - 100 000 . 4000 1 , EEPROM 25 . , , DWORD (32 , 4 ). TRIM, SSD EEPROM, , EEPROM (512 ATMega8, 4 1 ) ((512/4)*100 000)/4000=3 200 ⋅. . , EEPROM ATMega , WORD DWORD -
, , .


EEPROM ? ? EEPROM AVR?


- / , 3,7 , , . EEPROM .


. , (R1, R2) (PC0). 🎄.



 EEPROM    (640x323, 19Kb)

, +5 Aliexpress, ( ), , +4,2 - . . 2106, . 2 . 1000 , , , , . , - (AVCC, AREF).


220? ( ), Aliexpress USB- , 1,5...2 . , , , 4 EEPROM. , , CH340G USB-UART, . . , , , AVR.


: Watchdog'🐶, , , , +1...2, (AC back, DC back) RESET, END. - RESET .


(BASCOM-AVR):





Config Pind.6 = Input ' ,
Config Adc = Single , Prescaler = 16 , Reference = Internal '
'
Dim Currentcounts As Dword , Checkcounts As Dword , Emptydword As Dword
Dim Megacounts As Byte
Dim Eepromaddress As Byte ' 256 (64 ) &H00 &HFF
Dim Voltage As Word ' ,

Emptydword = &HFFFFFFFF ' !!!!!11
' 32 (DWORD) (
' &H104, DWORD.
' Megacounts

Readeeprom Megacounts , &H104
If Megacounts = &HFF Then ' ,
Megacounts = 0
Writeeeprom Megacounts , &H104
Elseif Megacounts = &HFE Then
Print "Counter locked!" ' !
End
' 4 294 967 295 * 255 = 1095216660225,
' 274 877 906.
' .
End If
' EEPROM (TRIM :)
'
' EEPROM,
' .
For Eepromaddress = 0 To &HFF Step 4
Readeeprom Currentcounts , Eepromaddress
If Currentcounts = &HFFFFFFFF Then
Eepromaddress = Eepromaddress - 4
Readeeprom Currentcounts , Eepromaddress
Eepromaddress = Eepromaddress + 4
Exit For '
End If
Next Eepromaddress
' , Eepromaddress &H00,
' EEPROM. !
If Eepromaddress = &H00 Then
If Currentcounts <> &HFFFFFFFF Then
Print "Erasing EEPROM..."
For Eepromaddress = 0 To &HFF Step 4
Writeeeprom Emptydword , Eepromaddress
Next Eepromaddress
End If
End If
Print "Null place:" ; Hex(eepromaddress) ' ,
Print "Previous counts:" ; Hex(megacounts) ; " " ; Hex(currentcounts) ' ,
'

Start Adc '
Do
Voltage = Getadc(0) ' , . ,
' ,
If Pind.6 = 0 Then '
While Pind.6 = 0 : Wend ' .
' 5 =)
If Currentcounts = &HFFFFFFFF Then ' ,
' .
' &H00 !
Incr Megacounts
Writeeeprom Megacounts , &H100
Currentcounts = 0
Else
Incr Currentcounts ' : 0,25
End If
Print Hex(megacounts) ; " " ; Currentcounts ' print,
' . .
End If
If Voltage < 450 Then '! ! 450
' . -0,5.
Stop Adc ' .. .. ..
Disable Interrupts ' ٨
Repeatwrite: ' !
Writeeeprom Currentcounts , Eepromaddress
Readeeprom Checkcounts , Eepromaddress
If Currentcounts <> Checkcounts Then Goto Repeatwrite ',
' , Checkcounts Currentcounts
' ???
Print "Saved " ; Hex(currentcounts) ' ,
' . ,
' .
End ' .
End If
Loop
End ' .



, . 6 .₽. - , Android. , - , ap , 🙃. , Travel - , Apple - 1 .₽. 50, microUSB 49₽ Aliexpress. iPhone 4S - , iPhone 7 Plus . , , Apple Inc. U2, BGA-, 6 .₽., . , , , , . . , U2 . , : ‼️iPhone Android.‼️ 🔴 Apple 🔴 , , , , +5,5 ( USB ) +5, . , .



:  
(0)

-,

, 27 2016 . 22:22 +
, . ,
, , . , .
, Windows.
microsoft .

-, , , Logging, Keylogger, , , USB, , , . . ENTER.
keylogger (416x475, 44Kb)
LOG.INI . KEYLOGGER.EXE /?, . - / , systray / . , , . VB6.   Ctrl + Alt + Shift + NumLk ,   Ctrl + Alt + Shift + ScrLk . .

, , :

. - , . , . . , , - , .
, , ENTER - , - , - .
, 2011 . --, - , .

LOG.INI:

[Logging]
LogFile=S:\X-Files\Tracking\current.log
; LogFile . %TEMP%
Language=RU
; . RU/EN English version.
ShowWindow=0
; .
ShowTrayIcon=1
;
WindowX=100
WindowY=100
; ,

[Debug]
Timer=1
; , 1 .
HookLayout=1
; .
HookShiftCapitals=1
; Shift/CapsLock
HookMouse=1
;
HookUSB=1
; USB- GUID.
SymbolsOnly=0
; -
Buffer=0
; ( * 1024) . 0 = . .
HookWindows=3
; : 0 - , 1 - , 2 - , 3 - , .. . .

[Screenshots]
Quality=7
; JPEG-, %
Enabled=0
; 1 0
ShotsByEnter=1
; Enter
FolderPath=B:\Shots
;


:
- JPEG-, 100% ;
- Windows ;
- .

1.5.0.0, Zip-: , www lowercase. , . VB Decompiler, , .


:  
(0)

(-)

, 08 2013 . 21:38 +

floyd_steinberg_vb6_basic_soxie (325x428, 203Kb) , - VB6 24 RGB 256 .



(dithering, dither), , - . , VB6 xSize, ySize picturebox. 256 , ( R: byte, G: byte, B: byte, ). : LoadPalette ".PAL": DitherThis __PICTUREBOX




'   LONG    
Dim RArray(256) As Long, GArray(256) As Long, BArray(256) As Long, xSize as long, ySize as long

Function LoadPalette(PalFileName$)
'    
dummy$ = "  " 
tf = FreeFile
Open PalFileName$ For Binary As tf
 Do
   Get #tf, , dummy$
   RArray(Counter) = Asc(dummy$)
   Get #tf, , dummy$
   GArray(Counter) = Asc(dummy$)
   Get #tf, , dummy$
   BArray(Counter) = Asc(dummy$)
   Counter = Counter + 1
  Loop Until EOF(tf)
 Close tf
End Function

Sub NearColor(r, g, b, outcolor)
  '          
  minI = 255
  For i = 0 To 255
    difR = r - RArray(i)
    difG = g - GArray(i)
    difB = b - BArray(i)
    dif = Sqr(difR * difR + difG * difG + difB * difB)
    If dif < minI Then minI = dif: outcolor = i
  Next i
End Sub

Sub ValidateColor(r, g, b)
  '    0...255
  If r > 255 Then r = 255
  If r < 0 Then r = 0
  If g > 255 Then g = 255
  If g < 0 Then g = 0
  If b > 255 Then b = 255
  If b < 0 Then b = 0
End Sub

Sub ToRGB(ColorLong, r, g, b)
    '    LONG-   RGB
    r = &HFF& And ColorLong
    g = (&HFF00& And ColorLong) \ 256
    b = (&HFF0000 And ColorLong) \ 65536
End Sub

Sub DitherThis(inputPicture As PictureBox)
 ' 
 Dim r As Long, g As Long, b As Long, near As Long, curPoint As Long
 For y = 0 To ySize
  For x = 0 To xSize
    '    
    curPoint = inputPicture.Point(x, y)
    ToRGB curPoint, r, g, b
    NearColor r, g, b, near
    '        (!)  
    quantError_Red = (r - RArray(near))
    quantError_Green = (g - GArray(near))
    quantError_Blue = (b - BArray(near))
    inputPicture.PSet (x, y), RGB(RArray(near), GArray(near), BArray(near))
    '  

    '    ,     -
    curPoint = inputPicture.Point(x + 1, y)
    ToRGB curPoint, r, g, b
    '      (   )
    r = r + quantError_Red * (7 / 16)
    g = g + quantError_Green * (7 / 16)
    b = b + quantError_Blue * (7 / 16)
    ValidateColor r, g, b
    '     .     
    inputPicture.PSet (x + 1, y), RGB(r, g, b)

    curPoint = inputPicture.Point(x - 1, y + 1)
    ToRGB curPoint, r, g, b
    r = r + quantError_Red * (3 / 16)
    g = g + quantError_Green * (3 / 16)
    b = b + quantError_Blue * (3 / 16)
    ValidateColor r, g, b
    inputPicture.PSet (x - 1, y + 1), RGB(r, g, b)
    
    curPoint = inputPicture.Point(x, y + 1)
    ToRGB curPoint, r, g, b
    r = r + quantError_Red * (5 / 16)
    g = g + quantError_Green * (5 / 16)
    b = b + quantError_Blue * (5 / 16)
    ValidateColor r, g, b
    inputPicture.PSet (x, y + 1), RGB(r, g, b)
    
    curPoint = inputPicture.Point(x + 1, y + 1)
    ToRGB curPoint, r, g, b
    r = r + quantError_Red * (1 / 16)
    g = g + quantError_Green * (1 / 16)
    b = b + quantError_Blue * (1 / 16)
    ValidateColor r, g, b
    inputPicture.PSet (x + 1, y + 1), RGB(r, g, b)
  Next x
 Next y
, . , . , . , ( , ).


:  
(0)

, 29 2013 . 02:33 +
:
Hex (hexadeimal) .
Hexen , , to hex .
- , . , , ....
, html- , . , , , , VB6 -, , - BASIC. , . ASM, VB , Excel.
, .
CP1251 CP866 (VB, QB)
Function String1251To866$(strWin$)
   '   1251  866
   TwinTodos$ = ""
   For i = 1 To Len(strWin$)
      k = Asc(Mid$(strWin$, i, 1))
      If k >= 192 And k <= 239 Then
        TwinTodos$ = TwinTodos$ + Chr$(k - 64)
      ElseIf k >= 240 And k <= 255 Then
        TwinTodos$ = TwinTodos$ + Chr$(k - 16)
      ElseIf k = 9 Then ' 
        TwinTodos$ = TwinTodos$ + Space$(8)
      Else
        TwinTodos$ = TwinTodos$ + Chr$(k)
      End If
   Next i
   String1251To866$ = TwinTodos$
End Function

Function String866To1251$(strDos$)
   '   866  1251
   TdosTowin$ = ""
   For i = 1 To Len(strDos$)
      k = Asc(Mid$(strDos$, i, 1))
      If k >= 128 And k <= 175 Then
        TdosTowin$ = TdosTowin$ + Chr$(k + 64)
      ElseIf k >= 224 And k <= 239 Then
        TdosTowin$ = TdosTowin$ + Chr$(k + 16)
      ElseIf k = 9 Then ' 
        TdosTowin$ = TdosTowin$ + Space$(8)
      Else
        TdosTowin$ = TdosTowin$ + Chr$(k)
      End If
   Next i
   String866To1251$ = TdosTowin$
End Function

(VB,QB)
Sub LineSegmentCross(x1, y1, x2, y2, x3, y3, x4, y4, xCross, yCross)
  '    
  LineEquation x1, y1, x2, y2, AP1, BP1, CP1
  LineEquation x3, y3, x4, y4, AP2, BP2, CP2
  LineCrossing AP1, BP1, CP1, AP2, BP2, CP2, xCross, yCross
End Sub

Sub LineEquation(x1, y1, x2, y2, AP, BP, CP)
  '       X,Y  
  If x1 = x2 And y1 = y2 Then
    AP = 0
    BP = 0
    CP = 0
  Else
    AP = y2 - y1
    BP = x1 - x2
    CP = -AP * x1 - BP * y1
    coeff = Sqr(AP * AP + BP * BP)
    AP = AP / coeff
    BP = BP / coeff
    CP = CP / coeff
  End If
End Sub

Sub LineCrossing(AP1, BP1, CP1, AP2, BP2, CP2, xCross, yCross)
 '  
 Delta = AP1 * BP2 - BP1 * AP2
 If Delta <> 0 Then
   xCross = -(CP1 * BP2 - BP1 * CP2) / Delta
   yCross = -(AP1 * CP2 - CP1 * AP2) / Delta
 End If
End Sub

-, VB
() (X0,Y0,X1,Y1), xMin,xMax,yMin,yMax. False .
Private Enum EdgeCode
 ecNone = &H0
 ecLeft = &H1
 ecRight = &H2
 ecBottom = &H4
 ecTop = &H8
End Enum

Public Function CohenSutherlandLineClip(x0, y0, x1, y1, xMin, xMax, yMin, yMax) As Boolean
 '  
 Dim accept As Boolean, done As Boolean
 Dim outcode0 As EdgeCode, outcode1 As EdgeCode, outcodeOut As EdgeCode
 Dim X As Double, Y As Double
 accept = False
 done = False
 Call CompOutCode(x0, y0, xmin, xmax, ymin, ymax, outcode0)
 Call CompOutCode(x1, y1, xmin, xmax, ymin, ymax, outcode1)
 Do
  If (outcode0 = ecNone) And (outcode1 = ecNone) Then
   accept = True
   done = True
  ElseIf ((outcode0 And outcode1) <> ecNone) Then
   done = True
  Else
   If (outcode0 <> ecNone) Then outcodeOut = outcode0 Else outcodeOut = outcode1
   If (outcodeOut And ecTop) Then
     X = x0 + (x1 - x0) * (ymax - y0) / (y1 - y0)
     Y = ymax
   End If
   If (outcodeOut And ecBottom) Then
     X = x0 + (x1 - x0) * (ymin - y0) / (y1 - y0)
     Y = ymin
   ElseIf (outcodeOut And ecRight) Then
     Y = y0 + (y1 - y0) * (xmax - x0) / (x1 - x0)
     X = xmax
   ElseIf (outcodeOut And ecLeft) Then
     Y = y0 + (y1 - y0) * (xmin - x0) / (x1 - x0)
     X = xmin
   End If
   If (outcodeOut = outcode0) Then
     x0 = X
     y0 = Y
     Call CompOutCode(x0, y0, xmin, xmax, ymin, ymax, outcode0)
   Else
     x1 = X
     y1 = Y
     Call CompOutCode(x1, y1, xmin, xmax, ymin, ymax, outcode1)
   End If
  End If
 Loop Until done
 CohenSutherlandLineClip = accept
 End Function

 Private Sub CompOutCode(X, Y, xMin, xMax, yMin, yMax, code As EdgeCode)
   '     ()
   code = 0
   If (Y > yMax) Then code = ecTop _
   Else If (Y < yMin) Then code = ecBottom
   If (X > xMax) Then code = code Or ecRight 
   Else If (X < xMin) Then code = code Or ecLeft
 End Sub

    For i = 0 To UBound(MyArray) ' 
        For j = i + 1 To UBound(MyArray)
            If MyArray(i) > MyArray(j) Then
                temp = MyArray(i)
                MyArray(i) = MyArray(j)
                MyArray(j) = temp
             End If
       Next j
    Next i
'---------------------------------------------
'   ( , N = UBound(MyArray)
         For q = 1 To N - 1
            Min = MyArray(q)
            k_min = q
            For j = q + 1 To N
               If MyArray(j) < Min Then
                 MinY = MyArray(j)
                 k_min = j
               End If
             Next j
             MyArray(k_min) = MyArray(q)
             MyArray(q) = MinY
         Next q

3D 2D- (, ;)?)
Dim camX, camY, camZ    '  
Dim aX, aY '     X  Y
Dim xSize As Integer, ySize As Integer '  ( )

Function Calculate(X, Y, Z, xscr, yscr) As Boolean
  ',       
  ' True   
  CalculateTemporaryAxis X, Y, Z, tmpX, tmpY, tmpZ
  If tmpZ > 0 Then Calculate = False: Exit Function

  tempZ = ySize / tmpz
  xScr = Int(tmpX * tempZ + (xSize / 2))  'xSize
  yScr = Int(tmpY * tempZ + (ySize / 2))
  Calculate = True
  '    FOV
End Function

Sub CalculateTemporaryAxis(X, Y, Z, tmpX, tmpY, tmpZ)
 '      Z,   
 tmpX = (X - camX) * Cos(aY) - (Z - camZ) * Sin(aY)
 tmpZ = ((X - camX) * Sin(aY) + (Z - camZ) * Cos(aY)) * (Cos(aX) - (Y - camY) * Sin(aX))
 tmpY = tmpZ * Sin(aX) + (Y - camY) * Cos(aX)
End Sub
soxie_pure_visual_basic_3d (700x406, 55Kb) soxie_pure_visual_basic_3d_1 (700x406, 153Kb)


:  

 : [1]