- Code: Select all
'resistor colors
DEFSTR temp$ next$ ohm$
DEFNUM startp endp px1 py1 px2 py2
DEFNUM color
'open window
WIN 0 0 386 480 WS_CAPTION "Resistor Colors"
MainColor 220 220 230
LET ohm$ = " OHM"
'0-//color 1
wControl Wbutton 40 120 50 20 SYS_TYPE 100
ControlColor 100 RGB 250 250 250 0 0 0
SetText 100 "BLACK"
'1
wControl Wbutton 40 150 50 20 SYS_TYPE 101
ControlColor 101 RGB 250 250 250 160 100 100
SetText 101 "BROWN"
'2
wControl Wbutton 40 180 50 20 SYS_TYPE 102
ControlColor 102 RGB 250 250 250 200 0 0
SetText 102 "RED"
'3
wControl Wbutton 40 210 50 20 SYS_TYPE 103
ControlColor 103 RGB 250 250 250 255 160 0
SetText 103 "ORANGE"
'4
wControl Wbutton 40 240 50 20 SYS_TYPE 104
ControlColor 104 RGB 0 0 150 240 240 0
SetText 104 "YELLOW"
'5
wControl Wbutton 40 270 50 20 SYS_TYPE 105
ControlColor 105 RGB 250 250 250 0 160 0
SetText 105 "GREEN"
'6
wControl Wbutton 40 300 50 20 SYS_TYPE 106
ControlColor 106 RGB 250 250 250 0 80 200
SetText 106 "BLUE"
'7
wControl Wbutton 40 330 50 20 SYS_TYPE 107
ControlColor 107 RGB 250 250 250 160 32 220
SetText 107 "PURPLE"
'8
wControl Wbutton 40 360 50 20 SYS_TYPE 108
ControlColor 108 RGB 250 250 250 160 160 180
SetText 108 "GRAY"
'9
wControl Wbutton 40 390 50 20 SYS_TYPE 109
ControlColor 109 RGB 0 0 50 250 250 250
SetText 109 "WHITE"
'------------------------------------------
wControl Wbutton 100 120 50 20 SYS_TYPE 110
ControlColor 110 RGB 250 250 250 0 0 0
SetText 110 "BLACK"
'1
wControl Wbutton 100 150 50 20 SYS_TYPE 111
ControlColor 111 RGB 250 250 250 160 100 100
SetText 111 "BROWN"
'2
wControl Wbutton 100 180 50 20 SYS_TYPE 112
ControlColor 112 RGB 250 250 250 200 0 0
SetText 112 "RED"
'3
wControl Wbutton 100 210 50 20 SYS_TYPE 113
ControlColor 113 RGB 250 250 250 255 160 0
SetText 113 "ORANGE"
'4
wControl Wbutton 100 240 50 20 SYS_TYPE 114
ControlColor 114 RGB 0 0 150 240 240 0
SetText 114 "YELLOW"
'5
wControl Wbutton 100 270 50 20 SYS_TYPE 115
ControlColor 115 RGB 250 250 250 0 160 0
SetText 115 "GREEN"
'6
wControl Wbutton 100 300 50 20 SYS_TYPE 116
ControlColor 116 RGB 250 250 250 0 80 200
SetText 116 "BLUE"
'7
wControl Wbutton 100 330 50 20 SYS_TYPE 117
ControlColor 117 RGB 250 250 250 160 32 220
SetText 117 "PURPLE"
'8
wControl Wbutton 100 360 50 20 SYS_TYPE 118
ControlColor 118 RGB 250 250 250 160 160 180
SetText 118 "GRAY"
'9
wControl Wbutton 100 390 50 20 SYS_TYPE 119
ControlColor 119 RGB 0 0 50 250 250 250
SetText 119 "WHITE"
'----------------------------------------------------
wControl Wbutton 160 120 50 20 SYS_TYPE 120
ControlColor 120 RGB 250 250 250 0 0 0
SetText 120 "BLACK"
'1
wControl Wbutton 160 150 50 20 SYS_TYPE 121
ControlColor 121 RGB 250 250 250 160 100 100
SetText 121 "BROWN"
'2
wControl Wbutton 160 180 50 20 SYS_TYPE 122
ControlColor 122 RGB 250 250 250 200 0 0
SetText 122 "RED"
'3
wControl Wbutton 160 210 50 20 SYS_TYPE 123
ControlColor 123 RGB 250 250 250 255 160 0
SetText 123 "ORANGE"
'4
wControl Wbutton 160 240 50 20 SYS_TYPE 124
ControlColor 124 RGB 0 0 150 240 240 0
SetText 124 "YELLOW"
'5
wControl Wbutton 160 270 50 20 SYS_TYPE 125
ControlColor 125 RGB 250 250 250 0 160 0
SetText 125 "GREEN"
'6
wControl Wbutton 160 300 50 20 SYS_TYPE 126
ControlColor 126 RGB 250 250 250 0 80 200
SetText 126 "BLUE"
'7
wControl Wbutton 160 330 50 20 SYS_TYPE 127
ControlColor 127 RGB 250 250 250 160 32 220
SetText 127 "PURPLE"
'8
wControl Wbutton 160 360 50 20 SYS_TYPE 128
ControlColor 128 RGB 250 250 250 160 160 180
SetText 128 "GRAY"
'9
wControl Wbutton 160 390 50 20 SYS_TYPE 129
ControlColor 129 RGB 0 0 50 250 250 250
SetText 129 "WHITE"
'-------------------
wControl Wbutton 220 120 50 20 SYS_TYPE 130
ControlColor 130 RGB 50 50 50 255 215 0
SetText 130 "GOLD"
'1
wControl Wbutton 220 150 50 20 SYS_TYPE 131
ControlColor 131 RGB 250 250 250 198 198 210
SetText 131 "SILVER"
GOSUB draw_resistor
wControl WEditbox 40 420 50 20 FLAT 141
wControl WEditbox 100 420 50 20 FLAT 142
wControl WEditbox 160 420 70 20 FLAT 143
'result
wControl WEditbox 240 420 100 20 FLAT 144
'calc button
wControl Wbutton 240 380 100 34 XP_TYPE 150
ControlFont 150 10 400 0 "Courier New"
SetText 150 "Show value"
WAIT
SUB draw_resistor
RECT 44 30 280 70 RGB 0 0 0 240 240 220
'left contact
CIRCLE 15 62 10
FillColor 12 60 RGB 100 160 100
RECT 12 71 5 358 RGB 0 120 0 100 160 100
RECT 12 428 353 5 RGB 0 120 0 100 160 100
'left pin
RECT 15 60 30 5 RGB 0 0 0 190 190 200
'right contact
CIRCLE 363 62 10
FillColor 368 60 RGB 100 160 100
RECT 360 71 5 358 RGB 0 120 0 100 160 100
'right pin
RECT 323 60 40 5 RGB 0 0 0 190 190 200
RETURN
'show value *******************************
SUBID 150
Settext 144 ""
LET next$ = ""
LET temp$ = GetText 141
LET next$ = next$ + temp$
LET temp$ = GetText 142
LET next$ = next$ + temp$
LET temp$ = GetText 143
LET next$ = next$ + temp$
LET next$ = next$ + ohm$
SetText 144 next$
ENDSUB
'****************************************
'col 1----------------
SUBID 100
color = 0
GOSUB color_1
ENDSUB
SUBID 101
color = 1
GOSUB color_1
ENDSUB
SUBID 102
color = 2
GOSUB color_1
ENDSUB
SUBID 103
color = 3
GOSUB color_1
ENDSUB
SUBID 104
color = 4
GOSUB color_1
ENDSUB
SUBID 105
color = 5
GOSUB color_1
ENDSUB
SUBID 106
color = 6
GOSUB color_1
ENDSUB
SUBID 107
color = 7
GOSUB color_1
ENDSUB
SUBID 108
color = 8
GOSUB color_1
ENDSUB
SUBID 109
color = 9
GOSUB color_1
ENDSUB
'col 2---------------
SUBID 110
color = 0
GOSUB color_2
ENDSUB
SUBID 111
color = 1
GOSUB color_2
ENDSUB
SUBID 112
color = 2
GOSUB color_2
ENDSUB
SUBID 113
color = 3
GOSUB color_2
ENDSUB
SUBID 114
color = 4
GOSUB color_2
ENDSUB
SUBID 115
color = 5
GOSUB color_2
ENDSUB
SUBID 116
color = 6
GOSUB color_2
ENDSUB
SUBID 117
color = 7
GOSUB color_2
ENDSUB
SUBID 118
color = 8
GOSUB color_2
ENDSUB
SUBID 119
color = 9
GOSUB color_2
ENDSUB
'col 3----------------
SUBID 120
color = 0
GOSUB color_3
ENDSUB
SUBID 121
color = 1
GOSUB color_3
ENDSUB
SUBID 122
color = 2
GOSUB color_3
ENDSUB
SUBID 123
color = 3
GOSUB color_3
ENDSUB
SUBID 124
color = 4
GOSUB color_3
ENDSUB
SUBID 125
color = 5
GOSUB color_3
ENDSUB
SUBID 126
color = 6
GOSUB color_3
ENDSUB
SUBID 127
color = 7
GOSUB color_3
ENDSUB
SUBID 128
color = 8
GOSUB color_3
ENDSUB
SUBID 129
color = 9
GOSUB color_3
ENDSUB
'col 4----------------
SUBID 130
color = 5
GOSUB color_4
ENDSUB
SUBID 131
color = 10
GOSUB color_4
ENDSUB
'///////////////////////////////////////
SUB color_1
IF color = 0
RECT 60 30 20 70 RGB 0 0 0 0 0 0
SetText 141 "0"
ENDIF
IF color = 1
RECT 60 30 20 70 RGB 0 0 0 160 100 100
SetText 141 "1"
ENDIF
IF color = 2
RECT 60 30 20 70 RGB 0 0 0 200 0 0
SetText 141 "2"
ENDIF
IF color = 3
RECT 60 30 20 70 RGB 0 0 0 255 160 0
SetText 141 "3"
ENDIF
IF color = 4
RECT 60 30 20 70 RGB 0 0 0 240 240 0
SetText 141 "4"
ENDIF
IF color = 5
RECT 60 30 20 70 RGB 0 0 0 0 160 0
SetText 141 "5"
ENDIF
IF color = 6
RECT 60 30 20 70 RGB 0 0 0 0 80 200
SetText 141 "6"
ENDIF
IF color = 7
RECT 60 30 20 70 RGB 0 0 0 160 32 220
SetText 141 "7"
ENDIF
IF color = 8
RECT 60 30 20 70 RGB 0 0 0 160 160 180
SetText 141 "8"
ENDIF
IF color = 9
RECT 60 30 20 70 RGB 0 0 0 250 250 250
SetText 141 "9"
ENDIF
RETURN
'/////////////////////////////////////////
SUB color_2
IF color = 0
RECT 120 30 20 70 RGB 0 0 0 0 0 0
SetText 142 "0"
ENDIF
IF color = 1
RECT 120 30 20 70 RGB 0 0 0 160 100 100
SetText 142 "1"
ENDIF
IF color = 2
RECT 120 30 20 70 RGB 0 0 0 200 0 0
SetText 142 "2"
ENDIF
IF color = 3
RECT 120 30 20 70 RGB 0 0 0 255 160 0
SetText 142 "3"
ENDIF
IF color = 4
RECT 120 30 20 70 RGB 0 0 0 240 240 0
SetText 142 "4"
ENDIF
IF color = 5
RECT 120 30 20 70 RGB 0 0 0 0 160 0
SetText 142 "5"
ENDIF
IF color = 6
RECT 120 30 20 70 RGB 0 0 0 0 80 200
SetText 142 "6"
ENDIF
IF color = 7
RECT 120 30 20 70 RGB 0 0 0 160 32 220
SetText 142 "7"
ENDIF
IF color = 8
RECT 120 30 20 70 RGB 0 0 0 160 160 180
SetText 142 "8"
ENDIF
IF color = 9
RECT 120 30 20 70 RGB 0 0 0 250 250 250
SetText 142 "9"
ENDIF
RETURN
'////////////////////////////////////////
SUB color_3
IF color = 0
RECT 180 30 20 70 RGB 0 0 0 0 0 0
SetText 143 " "
ENDIF
IF color = 1
RECT 180 30 20 70 RGB 0 0 0 160 100 100
SetText 143 "0"
ENDIF
IF color = 2
RECT 180 30 20 70 RGB 0 0 0 200 0 0
SetText 143 "00"
ENDIF
IF color = 3
RECT 180 30 20 70 RGB 0 0 0 255 160 0
SetText 143 "000"
ENDIF
IF color = 4
RECT 180 30 20 70 RGB 0 0 0 240 240 0
SetText 143 "0000"
ENDIF
IF color = 5
RECT 180 30 20 70 RGB 0 0 0 0 160 0
SetText 143 "00000"
ENDIF
IF color = 6
RECT 180 30 20 70 RGB 0 0 0 0 80 200
SetText 143 "000000"
ENDIF
IF color = 7
RECT 180 30 20 70 RGB 0 0 0 160 32 220
SetText 143 "0000000"
ENDIF
IF color = 8
RECT 180 30 20 70 RGB 0 0 0 160 160 180
SetText 143 "00000000"
ENDIF
IF color = 9
RECT 180 30 20 70 RGB 0 0 0 250 250 250
SetText 143 "000000000"
ENDIF
RETURN
'///////////////////////////////////////////////////////
SUB color_4
IF color = 5 THEN RECT 240 30 20 70 RGB 0 0 0 255 215 0
IF color = 10 THEN RECT 240 30 20 70 RGB 0 0 0 198 198 210
RETURN
Dink Software
Offering free niche software products...
| Welcome | ||
|---|---|---|
| Welcome to dinksoftware You are currently viewing our boards as a guest, which gives you limited access to view most discussions and access our other features. By joining our free community, you will have access to post topics, communicate privately with other members (PM), respond to polls, upload content, and access many other special features. In addition, registered members also see less advertisements. Registration is fast, simple, and absolutely free, so please, join our community today! |
||
Aurel Basic
42 posts
• Page 5 of 5 • 1, 2, 3, 4, 5
Re: Aurel Basic
by Aurel » Sun May 22, 2011 5:36 pm
- Attachments
-
- rcRun.png (33.1 KiB) Viewed 49 times
author of Aurel Basic
http://aurelmm.byethost6.com/htdocs/
http://aurelmm.byethost6.com/htdocs/
-
Aurel - Active member
- Posts: 48
- Joined: Thu Nov 25, 2010 4:30 pm
Re: Aurel Basic
by Aurel » Mon May 30, 2011 4:56 pm
archivio lottery...
- Code: Select all
' note----> YOU MUST PUT AT THE END OF THE
' FILE A LINE WITH THE WORD "END" AT THE VERY BEGINNING OF THE LAST LINE
'note 2 ---> 'MAXIMUM NUMBER OF LINES THAT CAN BE READ FROM FILE = 1000
DEFNUM a b x y edid totallines totallines2 count nch
DEFFILE file1
DEFSTR filename line$ empty w$ w2$ date$ empty2 a$ backcopy
DEFSTR linear[1002] gg
DEFNUM got number newlinenum
DEFSTR gototarget day2$ month2$
DEFSTR day$ month$ year$ singlespace newnum[51] getedit$
DEFNUM test test2 lungh l numgetedit test3
DEFNUM nday nmonth nyear counter k counter2
WIN 0 0 360 520 WS_SYSMENU "ARCHIVIO LOTTO"
MAINCOLOR 220 200 130
'''''''''''''''''''''''''''''''''''''''
'''THIS ARE THE NAMES OF THE WHEELS (ABBREVIATED)
''''''''''''''''''''''''''''''''''''''''
PRINT 5 30 "BA"
PRINT 5 60 "CA"
PRINT 5 90 "FI"
PRINT 5 120 "GE"
PRINT 5 150 "MI"
PRINT 5 180 "NA"
PRINT 5 210 "PA"
PRINT 5 240 "RO"
PRINT 5 270 "TO"
PRINT 5 300 "VE"
LET empty = "END"
LET empty2 = ""
LET y = 30
'''''''''''NOW I WILL DESIGN THE 50 EDITBOXES SINGLE LINE
''''''''''''''''WITH NESTED FOR --> edid IS THE ID OF EACH EDITBOX
''''''''''''''''''''''''SPECIFIED WITH VARIABLE FROM 100 TO 149
LET edid = 100
FOR b = 1 TO 10
LET x = 35
FOR a = 1 TO 5
WCONTROL weditbox x y 30 25 CLASSIC edid
LET edid = edid + 1
LET x = x + 33
NEXT a
LET y = y + 30
NEXT b
'''''''THIS ARE THE BUTTON THAT ALLOWS TO MOVE TROUGH THE STRING ARRAY
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
WCONTROL wbutton 5 5 50 20 FLAT_TYPE 200
SETTEXT 200 "LOAD"
WCONTROL wbutton 10 350 40 30 FLAT_TYPE 201
SETTEXT 201 "<<"
WCONTROL wbutton 60 350 40 30 FLAT_TYPE 202
SETTEXT 202 "<"
WCONTROL wbutton 110 350 40 30 FLAT_TYPE 203
SETTEXT 203 ">"
WCONTROL wbutton 160 350 40 30 FLAT_TYPE 204
SETTEXT 204 ">>"
WCONTROL wbutton 30 395 55 40 FLAT_TYPE 205
SETTEXT 205 "GOTO"
WCONTROL weditbox 110 395 80 30 CLASSIC 206
WCONTROL wbutton 30 440 95 40 FLAT_TYPE 207
SETTEXT 207 "GOTO LAST"
'''''this button is for creating a backcopy of the archive
WCONTROL wbutton 220 25 105 60 FLAT_TYPE 208
SETTEXT 208 "BACK COPY"
PRINT 90 405 "--->"
LINE 210 10 210 100 RGB 200 0 120
LINE 340 10 340 100 RGB 200 0 120
LINE 210 10 220 10 RGB 200 0 120
FRONTCOLOR 0 0 0
PRINT 222 5 "backcopy"
LINE 270 10 340 10 RGB 200 0 120
LINE 210 100 340 100 RGB 200 0 120
''''this part is for insert a new line in the archive''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'TRANSLATION :
' NUOVA ESTRAZIONE = NEW DRAWING OF LOTTERY
' GIORNO = DAY
' MESE = MONTH
' ANNO = YEAR
' SALVA = SAVE
LINE 210 130 220 130 RGB 200 0 120
FRONTCOLOR 0 0 0
PRINT 222 125 "nuova estrazione"
LINE 307 130 349 130 RGB 200 0 120
WCONTROL wbutton 220 140 120 40 FLAT_TYPE 220
SETTEXT 220 "NUOVA ESTRAZIONE"
PRINT 220 190 "GIORNO"
WCONTROL weditbox 270 190 30 25 CLASSIC 210
PRINT 220 230 "MESE"
WCONTROL weditbox 270 230 30 25 CLASSIC 211
PRINT 220 270 "ANNO"
WCONTROL weditbox 270 270 60 25 CLASSIC 212
WCONTROL wbutton 220 315 120 40 FLAT_TYPE 213
SETTEXT 213 " SALVA "
LINE 210 130 210 370 RGB 200 0 120
LINE 349 130 349 370 RGB 200 0 120
LINE 210 370 349 370 RGB 200 0 120
WAIT
SUB SHOW
'THIS SUB IS USED FOR SHOWING NUMBERS IN EACH EDITBOX
''''''''''''''''''''''''''''''''''''''''''''''''''''''
PRINT 65 5 " "
PRINT 65 5 totallines
GETSTRDIM w$ = linear.totallines
LET date$ = MID$ w$ 1 11
PRINT 100 5 " "
PRINT 100 5 date$
LET count = 14
LET x = 1
LET nch = 2
LET edid = 100
' I USE MID$ FUNCTION FOR SPLITTING EACH LINE SAVED IN A STRING ARRAY
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
FOR y = 1 TO 10
FOR x = 1 TO 5
LET w2$ = MID$ w$ count nch
SETTEXT edid w2$
LET edid = edid + 1
LET count = count + 3
NEXT x
LET count = count + 1
NEXT y
RETURN
SUBID 200
'''''''THIS IS THE SUB THAT SAVES EACH LINE OF THE FILE IN A STRING ARRAY
''''''''''SINCE IT IS NOT POSSIBLE TO EXIT FROM FOR LOOP I PUT THE MARK "END"
''''''''''''''''IN THE LAST LINE OF THE FILE FOR KNOWING WHAT IS THE LAST LINE
'''''''''''''''''''(IT CONTINUES TO READ BUT IN THIS WAY I KNOW WHAT IS THE LAST LINE)
LET filename = "ARCHIVIO.TXT"
OPENFILE file1 <READ> filename
'NOTE MAX 1000 LINES IN THE FILE + LAST LINE WITH "END"
FOR x = 1 TO 1001
READSTRING file1 line$
SETSTRDIM linear.x = line$
IF line$ = empty THEN LET totallines = x
NEXT x
CLOSEFILE file1
LET totallines = totallines - 1
LET totallines2 = totallines
'''''''''''''''''' NOW totallines AND totallines2 CONTAIN THE LAST ELEMENT IN THE STRING
'''''''''''''''''''''' ARRAY WITH DATA
''''AFTER SAVING THE FILE IN A STRING ARRAY , IT IS SHOWED THE LAST LINE IN THE VARIOUS EDITBOXES
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
GOSUB SHOW
ENDSUB
SUBID 201
''''''''''''THIS SUB IS ASSOCIATED WITH THE BUTTON "<<"
''''''''''''''''''''''IT LETS YOU GO BACK OF 10 LINES''''
''''''''''''(REMEMBER THAT EACH LINE IS SAVED IN A STRING ARRAY)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
IF totallines > 1
LET totallines = totallines - 10
IF totallines < 1 THEN LET totallines = 1
GOSUB SHOW
ENDIF
ENDSUB
SUBID 202
''''''''''''THIS SUB IS ASSOCIATED WITH THE BUTTON "<"
''''''''''''''''''''''IT LETS YOU GO BACK OF 1 LINE''''
''''''''''''(REMEMBER THAT EACH LINE IS SAVED IN A STRING ARRAY)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
IF totallines > 1
LET totallines = totallines - 1
IF totallines < 1 THEN LET totallines = 1
GOSUB SHOW
ENDIF
ENDSUB
SUBID 203
''''''''''''THIS SUB IS ASSOCIATED WITH THE BUTTON ">"
''''''''''''''''''''''IT LETS YOU GO FORWARD OF 1 LINE''''
''''''''''''(REMEMBER THAT EACH LINE IS SAVED IN A STRING ARRAY)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
IF totallines < totallines2
LET totallines = totallines + 1
IF totallines > totallines2 THEN LET totallines = totallines2
GOSUB SHOW
ENDIF
ENDSUB
SUBID 204
''''''''''''THIS SUB IS ASSOCIATED WITH THE BUTTON ">>"
''''''''''''''''''''''IT LETS YOU GO FORWARD OF 10 LINES''''
''''''''''''(REMEMBER THAT EACH LINE IS SAVED IN A STRING ARRAY)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
IF totallines < totallines2
LET totallines = totallines + 10
IF totallines > totallines2 THEN LET totallines = totallines2
GOSUB SHOW
ENDIF
ENDSUB
SUBID 205
'''''''''''''''''THIS SUB IS ASSOCIATED WITH GOTO BUTTON''''''''''
'''''''''''''''''''''FIRST YOU MUST SET WHAT LINE/ARRAY ELEMENT YOU WANT TO SHOW
''''''''''''''''''''''''''''IN THE EDITBOX THAT IS NEAR , AND THEN PRESS THE BUTTON GOTO.
'''''''IF YOU SPECIFY A NUMBER THAT IS LESS THEN 1 OR BIGGER THAT THE NUMBER OF LINES OF THE FILE
''''''''''''''''''''''YOU ARE ADVISED
LET gototarget = GETTEXT 206
LET number = 1
CONVERT got = VAL(gototarget)
IF got < 1
MESSAGEBOX "AVVISO" & "ESTRAZIONE TARGET NON CORRETTA"
LET number = 0
ENDIF
IF got > totallines2
MESSAGEBOX "AVVISO..." & "ESTRAZIONE NON IN ARCHIVIO"
LET number = 0
ENDIF
IF number = 1
LET totallines = got
GOSUB SHOW
ENDIF
ENDSUB
SUBID 207
'''AND FINALLY THIS BUTTON LETS YOU GO TO THE LAST STRING ARRAY ELEMENT
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
LET totallines = totallines2
GOSUB SHOW
ENDSUB
SUBID 208
'''''''''''''''WITH THE BUTTON "BACK COPY" YOU CAN CREATE A BACK COPY OF THE ARCHIVE FILE
'''''''''''''''''''''''' IN ORDER TO USE THE BACK COPY THIS MUST BE RENAMED WITH .TXT EXTENSION
IF totallines2 > 0
LET backcopy = "ARCHIVIO"
OPENFILE file1 <WRITE> backcopy
FOR x = 1 TO totallines2
GETSTRDIM a$ = linear.x
LET a$ = MID$ a$ 1 171
WRITEFILE file1 a$
NEXT x
LET a$ = "END"
WRITEFILE file1 a$
CLOSEFILE file1
MESSAGEBOX "MESSAGGIO" & "CREATA LA BACK COPY (PER UTILIZZARLA RINOMINARLA CON ESTENSIONE .TXT)"
ENDIF
'''''THERE IS A PROBLEM IF YOU CANCEL THE PREVIOUS ENDIF , AND IF YOU WRITE THIS, THE CODE AFTER ELSE IS EXECUTED...
'ELSE
'MESSAGEBOX "MESSAGGIO..." & "PRIMA PREMI LOAD!!!"
'ENDIF
IF totallines2 = 0 THEN MESSAGEBOX "MESSAGGIO..." & "PRIMA PREMI LOAD!!!"
ENDSUB
SUBID 220
'clear all editboxes
'''''''''''''''''''''''''''''''
FOR edid = 100 TO 149
SETTEXT edid ""
NEXT edid
'SET THE NEW LINE NUMBER = LAST LINE + 1
LET newlinenum = totallines2 + 1
'PRINT THE NEW LINE NUMBER
PRINT 65 5 " "
PRINT 65 5 newlinenum
PRINT 100 5 " "
ENDSUB
SUB autobackcopy
'this sub is automaticly called when you want to save a new line in the text file
IF totallines2 > 0 THEN GOSUB auto
RETURN
SUB auto
LET backcopy = "ARCHIVIO"
OPENFILE file1 <WRITE> backcopy
FOR x = 1 TO totallines2
GETSTRDIM a$ = linear.x
LET a$ = MID$ a$ 1 171
WRITEFILE file1 a$
NEXT x
LET a$ = "END"
WRITEFILE file1 a$
CLOSEFILE file1
MESSAGEBOX "MESSAGGIO" & "HO CREATO UNA BACK COPY DELL' ARCHIVIO (PER UTILIZZARLA RINOMINARLA CON ESTENSIONE .TXT)"
RETURN
SUBID 213
' this sub saves a new line in the text file
' it takes care to mantain the archive with maximum 1001 lines
' if the archive is bigger the first lines in the text file are cancelled
LET test = 1
LET lungh = 1
LET test2 = 1
LET test3 = 1
LET counter = 0
LET counter2 = 0
LET gg = "\"
LET singlespace = " "
IF totallines2 = 0
MESSAGEBOX "ERRORE..." & "ERRORE : NON HAI PREMUTO PRIMA LOAD"
ENDIF
IF totallines2 > 0
LET k = totallines2 + 1
IF newlinenum <> k
MESSAGEBOX "ERRORE.." & " NON HAI PREMUTO PRIMA NUOVA ESTRAZIONE"
ENDIF
IF newlinenum2 = k
''''' '''''''''''NOW I READ EDITBOXES GIORNO,MESE,ANNO......
''''' '''''''''''''''''''''''''IF GIORNO = DAY < 9 THEN YOU MUST PUT THE ZERO BEFORE --> 09
''''' '''''''''''''''''''''''''''''IF MESE = MONTH < 9 THEN THEN YOU MUST PUT THE ZERO BEFORE --> 03
''''''''''''''''''''''''''''''YEAR = ANNO MUST BE FROM 1945 TO 9999
LET day$ = GETTEXT 210
LET l = STRLEN(day$)
IF l < 2 THEN GOSUB a1
CONVERT nday = VAL(day$)
IF nday < 1 THEN GOSUB a2
IF nday > 31 THEN GOSUB a2
LET month$ = GETTEXT 211
LET l = STRLEN(month$)
IF l < 2 THEN GOSUB a3
CONVERT nmonth = VAL(month$)
IF nmonth < 1 THEN GOSUB a4
IF nmonth > 12 THEN GOSUB a4
LET year$ = GETTEXT 212
CONVERT nyear = VAL(year$)
IF nyear < 1945 THEN GOSUB a5
IF nyear > 9999 THEN GOSUB a5
IF test = 1
LET date$ = singlespace + day$
LET date$ = date$ + gg
LET date$ = date$ + month$
LET date$ = date$ + gg
LET date$ = date$ + year$
LET date$ = date$ + singlespace
LET date$ = date$ + singlespace
LET edid = 100
LET x = 1
FOR edid = 100 TO 149
LET getedit$ = GETTEXT edid
CONVERT numgetedit = VAL(getedit$)
IF numgetedit < 1 THEN GOSUB text2
IF numgetedit > 90 THEN GOSUB text3
LET l = STRLEN(getedit$)
IF l < 2 THEN LET lungh = 0
SETSTRDIM newnum.x = getedit$
LET x = x + 1
NEXT edid
IF test2 = 0 THEN GOSUB advise1
IF test3 = 0 THEN GOSUB advise2
IF lungh = 0 THEN GOSUB advise3
IF test2 = 1
IF lungh = 1
IF test3 = 1
GOSUB autobackcopy
' IF IT IS ALL OK , NOW WRITE THE NEW LINE.....
'''''''''''''''''''''''''''''''''''''''''''''''''''
LET a = 1
FOR x = 1 TO 5
GETSTRDIM w$ = newnum.x
LET date$ = date$ + w$
LET date$ = date$ + singlespace
NEXT x
LET date$ = date$ + singlespace
FOR x = 6 TO 10
GETSTRDIM w$ = newnum.x
LET date$ = date$ + w$
LET date$ = date$ + singlespace
NEXT x
LET date$ = date$ + singlespace
FOR x = 11 TO 15
GETSTRDIM w$ = newnum.x
LET date$ = date$ + w$
LET date$ = date$ + singlespace
NEXT x
LET date$ = date$ + singlespace
FOR x = 16 TO 20
GETSTRDIM w$ = newnum.x
LET date$ = date$ + w$
LET date$ = date$ + singlespace
NEXT x
LET date$ = date$ + singlespace
FOR x = 21 TO 25
GETSTRDIM w$ = newnum.x
LET date$ = date$ + w$
LET date$ = date$ + singlespace
NEXT x
LET date$ = date$ + singlespace
FOR x = 26 TO 30
GETSTRDIM w$ = newnum.x
LET date$ = date$ + w$
LET date$ = date$ + singlespace
NEXT x
LET date$ = date$ + singlespace
FOR x = 31 TO 35
GETSTRDIM w$ = newnum.x
LET date$ = date$ + w$
LET date$ = date$ + singlespace
NEXT x
LET date$ = date$ + singlespace
FOR x = 36 TO 40
GETSTRDIM w$ = newnum.x
LET date$ = date$ + w$
LET date$ = date$ + singlespace
NEXT x
LET date$ = date$ + singlespace
FOR x = 41 TO 45
GETSTRDIM w$ = newnum.x
LET date$ = date$ + w$
LET date$ = date$ + singlespace
NEXT x
LET date$ = date$ + singlespace
FOR x = 46 TO 50
GETSTRDIM w$ = newnum.x
LET date$ = date$ + w$
LET date$ = date$ + singlespace
NEXT x
OPENFILE file1 <WRITE> filename
''''''''''''''''''''REWRITE THE FILE
'''''''''''''''''''''''''''''''''''''
IF totallines2 > 999 THEN GOSUB mantain
FOR x = 1 TO totallines2
GETSTRDIM a$ = linear.x
WRITEFILE file1 a$
NEXT x
''''''''''''''ADD NEW LINE
IF totallines2 < 1000 THEN WRITEFILE file1 date$
'WRITE THE WORD END
LET w2$ = "END"
WRITEFILE file1 w2$
CLOSEFILE file1
MESSAGEBOX "MESSAGGIO..." & "OPERAZIONE COMPLETATA CON SUCCESSO"
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDSUB
SUB mantain
' this sub reindex the string array AND MANTAIN THE ARCHIVE WITH MAX 1000 LINES
FOR x = 1 TO 999
LET y = x + 1
GETSTRDIM w$ = linear.x
GETSTRDIM w2$ = linear.y
LET w2$ = w$ + empty2
SETSTRDIM linear.x = w2$
NEXT x
SETSTRDIM linear.1000 = date$
RETURN
SUB advise1
MESSAGEBOX "ATTENZIONE..." & "HAI IMMESSO NUMERI MINORI DI 1!!!"
RETURN
SUB advise2
MESSAGEBOX "ATTENZIONE..." & "HAI IMMESSO NUMERI MAGGIORI DI 90!!!"
RETURN
SUB advise3
MESSAGEBOX "ATTENZIONE.." & "DEVI IMMETTERE I NUMERI TRA 0 E 9 CON LO ZERO DAVANTI--> 04"
RETURN
SUB text2
LET test2 = 0
RETURN
SUB text3
LET test3 = 0
RETURN
SUB a1
MESSAGEBOX "ATTENZIONE" & "IMMETTERE I GIORNI TRA 1 E 9 CON LO ZERO DAVANTI..."
LET test = 0
RETURN
SUB a2
MESSAGEBOX "ATTENZIONE.." & "GIORNO NUOVA ESTRAZIONE NON CORRETTO"
LET test = 0
RETURN
SUB a3
MESSAGEBOX "ATTENZIONE" & "IMMETTERE I MESI TRA 1 E 9 CON LO ZERO DAVANTI..."
LET test = 0
RETURN
SUB a4
MESSAGEBOX "ATTENZIONE.." & "MESE NUOVA ESTRAZIONE NON CORRETTO"
LET test = 0
RETURN
SUB a5
MESSAGEBOX "ATTENZIONE..." & "L'ANNO DEVE ESSERE COMPRESO TRA 1945 E 9999"
LET test = 0
RETURN
author of Aurel Basic
http://aurelmm.byethost6.com/htdocs/
http://aurelmm.byethost6.com/htdocs/
-
Aurel - Active member
- Posts: 48
- Joined: Thu Nov 25, 2010 4:30 pm
42 posts
• Page 5 of 5 • 1, 2, 3, 4, 5
Who is online
Users browsing this forum: No registered users and 0 guests
