|
|
Post by tsh73 on Oct 22, 2022 21:08:50 GMT
Sometimes forum software inserts lot's of empty lines in posted program. Like in recent thread justbasiccom.proboards.com/thread/902/understand-why-numbers-decreasingEDIT: example of problems it is fixing
Problem code looks like this (part from the middle) call pset xpos/multiplier, ypos/multiplier
'call circ xpos/distancemultipiernum, ypos/distancemultipiernum, 2
'sometimes need to clear display
if iters mod howoftentocls = 1 then
print #gr, "fill black"
end if
next
'============================== sets drawing
#gr "flush"
Every other line is blank Then there were a blank line, it is doubled too This program supposed to fix exactly this kind of problem
This could be prevented by posting in "BBCode" editor tab, not in "Preview" tab (tabs are visible under post editor window) Or you can change it in a profile settings: Profile .Edit profile ..Settings Forum Preferences .Posting Default ..Sets what editor you default to when creating posts. set to - BBCode Anyway. Post is done, program takes a lot of vertical space / looks bad How to fix that? Notepad++ has menu item "Remove empty lines" But it will remove all empty lines, even ones inserted by author with a meaning (code separating) We cannot simply remove only odd or only even lines - first, we can copy extra first empty line, second, sometimes it switched in the middle (like example linked) This program tries to be clever It reads 10 lines, checks which lines are empty - odd or even then rewinds file back (did you know it is possible? read part of the file then rewind it back?) and tries to remove only empty lines on that position. And if on that position happens non-empty line, it repeats aligning process. Give it a try. 'Remove extra empty lines
'which are inserted by forum
' output is to mainwin, examine then copy or save as a new file
'tsh73 Oct 2022
'put name of a file fo remove extra lines from
'If file exists it will be processed
'else program asks for a file to process
'I put "untitled.bas" - this is the name I get on fresh BASIC IDE
dim info$(10, 10)
fileName$ = "untitled.bas"
if fileExists(DefaultDir$, fileName$) then [proceed]
'else
FILEDIALOG "Select a file"+chr$(0)+"open", "*.bas", fileName$
if fileName$ = "" then
print "Cancelled by user - quitting"
end
end if
if fileExists(DefaultDir$, fileName$) then [proceed]
print "File :"; fileName$
print " does not exist - quitting"
end
[proceed]
open fileName$ for input as #1
i = 0
doAlign=1
noSync=0
while not(eof(#1))
'only on first and the same lines
if doAlign and (i mod 2 = 0) then
'print "*******Align*********************"
gosub [align]
'print "toSkip ";toSkip
doAlign=0
end if
i=i+1
line input #1, line$
'if i <20 then print ,i,line$
skip=0
select case toSkip
case 0
if (i mod 2 =0) then
if trim$(line$)="" then skip=1 else doAlign=1
end if
case 1
if (i mod 2 =1) then
if trim$(line$)="" then skip=1 else doAlign=1
end if
case else
'never skip, but shedule to re-sync after 10 lines
if noSync=0 then
noSync=10
else
noSync=noSync-1
if noSync=0 then doAlign=1
end if
end select
if skip=0 then print line$
if eof(#1) then exit while
wend
close #1
'print
'print" ---Over ---"
end
[align]
''align::
'look ahead 2*K lines
pos=loc(#1)
dim notEmpt(1) 'actually 0 and 1, for even/odd lines
K=5
for j = 1 to 2*K
if eof(#1) then exit for
line input #1, line$
if trim$(line$)<>"" then notEmpt(j mod 2)=notEmpt(j mod 2)+1
next
'print notEmpt(0), notEmpt(1)
'K 0 or 0 K is good signs
toSkip=999 'undecided
if notEmpt(1)= 0 then
toSkip=1
else
if notEmpt(0)= 0 then
toSkip=0
end if
end if
seek #1, pos
return
function fileExists(path$, filename$)
'dimension the array info$( at the beginning of your program
files path$, filename$, info$()
fileExists = val(info$(0, 0)) 'non zero is true
end function
|
|
|
|
Post by honkytonk on Oct 26, 2022 9:43:12 GMT
Well, if you want me to fix it, post code on which it fails it's your code taked from the forum
'Remove extra empty lines
'which are inserted by forum
' output is to mainwin, examine then copy or save as a new file
'tsh73 Oct 2022
'put name of a file fo remove extra lines from
'If file exists it will be processed
'else program asks for a file to process
'I put "untitled.bas" - this is the name I get on fresh BASIC IDE
dim info$(10, 10)
fileName$ = "untitled.bas"
if fileExists(DefaultDir$, fileName$) then [proceed]
'else
FILEDIALOG "Select a file"+chr$(0)+"open", "*.bas", fileName$
if fileName$ = "" then
print "Cancelled by user - quitting"
end
end if
if fileExists(DefaultDir$, fileName$) then [proceed]
print "File :"; fileName$
print " does not exist - quitting"
end
[proceed]
open fileName$ for input as #1
i = 0
doAlign=1
noSync=0
while not(eof(#1))
'only on first and the same lines
if doAlign and (i mod 2 = 0) then
'print "*******Align*********************"
gosub [align]
'print "toSkip ";toSkip
doAlign=0
end if
i=i+1
line input #1, line$
'if i <20 then print ,i,line$
skip=0
select case toSkip
case 0
if (i mod 2 =0) then
if trim$(line$)="" then skip=1 else doAlign=1
end if
case 1
if (i mod 2 =1) then
if trim$(line$)="" then skip=1 else doAlign=1
end if
case else
'never skip, but shedule to re-sync after 10 lines
if noSync=0 then
noSync=10
else
noSync=noSync-1
if noSync=0 then doAlign=1
end if
end select
if skip=0 then print line$
if eof(#1) then exit while
wend
close #1
'print
'print" ---Over ---"
end
[align]
''align::
'look ahead 2*K lines
pos=loc(#1)
dim notEmpt(1) 'actually 0 and 1, for even/odd lines
K=5
for j = 1 to 2*K
if eof(#1) then exit for
line input #1, line$
if trim$(line$)<>"" then notEmpt(j mod 2)=notEmpt(j mod 2)+1
next
'print notEmpt(0), notEmpt(1)
'K 0 or 0 K is good signs
toSkip=999 'undecided
if notEmpt(1)= 0 then
toSkip=1
else
if notEmpt(0)= 0 then
toSkip=0
end if
end if
seek #1, pos
return
function fileExists(path$, filename$)
'dimension the array info$( at the beginning of your program
files path$, filename$, info$()
fileExists = val(info$(0, 0)) 'non zero is true
end function
and the code charged with blank lines
nomainwin
GLOBAL Mois$, Jour$, Gwidth, Gheight, YearLimitDown, nYearLimitUp, Xref, Yref, index, current, selection
DIM info$(10,10)
DIM nDay(2,42)
dim date.g(2)
dim rcx(2)
dim rcy(2)
dim dow(2)
dim mon$(12)
dim names$(20)
dim Name$(20)
dim temp$(20)
Mois$ = "Janvier Février Mars Avril Mai Juin Juillet Août Septembre Octobre Novembre Décembre" 'EU format
' Mois$ = "January February March April May June July August September October November December" 'US format
Jour$ = "Mar Mer Jeu Ven Sam Dim Lun"
' Jour$ = "Tue Wed Thu Fri Sat Sun Mon"
aDay$ = Date$("mm/dd/yyyy")
j = date$(aDay$)
date$ = JourSem$(j)+" "+mid$(aDay$,4,2)+" "+NomMois$(j)+" "+right$(aDay$,4)+space$(6)+left$(time$(),5)
if fileExists(DefaultDir$, "Gadget.ini") then
open "Gadget.ini" for input as #bgk
WHILE EOF(#bgk)=0
LINE INPUT #bgk, n$
index = index + 1 'Count DATAs in the file
WEND
close #bgk
REDIM names$(index + 20) 'dimensionne la variable namas$() aux nbre de noms existant + 20 ajouts potentiels
REDIM Name$(index + 20)
open "Gadget.ini" for input as #bgk
WHILE EOF(#bgk)=0
k = k + 1
LINE INPUT #bgk, names$(k) 'Load in the array
Name$(k) = word$(names$(k),2)
WEND
lastselected = val(word$(names$(k),1))
close #bgk
else
date.g(1) = date$("08/10/1961") 'date.born
index = 1
Name$(index) = "Moi"
names$(index) = date.g(1);" ";Name$(index) 'futur first record of Gadget.ini
lastselected = index
nobody = 1
end if
date.g(2) = date$("days") 'date.bio
YearLimitDown = 1904
nYearLimitUp = 180
Xref = 29
Yref = 16
' dtbio$ = aDay$ 'date format US
dtbio$ = word$(aDay$,2,"/");"/";word$(aDay$,1,"/");"/";word$(aDay$,3,"/") 'date format Europe
dim year$(nYearLimitUp)
for m = 1 to 12 :mon$(m) = word$(Mois$,m) :next 'list for months
for y = 1 to nYearLimitUp :year$(y) = str$(YearLimitDown+y) :next 'list for years
WindowWidth = 850: WindowHeight = 430
UpperLeftX=20: UpperLeftY=5
' UpperLeftX = 100: UpperLeftY = 100
ForegroundColor$ = "darkgreen"
Graphicbox #cal.g1, 7, 35, 219, 170
Graphicbox #cal.g2, 620, 35, 219, 170
Graphicbox #cal.bio, 230, 7, 384, 200
Graphicbox #cal.gr, 30, 315, 300, 75
combobox #cal.month1, mon$(), MonthYear, 40, 42, 95, 20
combobox #cal.year1, year$(), MonthYear, 130, 42, 60, 20
combobox #cal.month2, mon$(), MonthYear, 655, 42, 95, 20
combobox #cal.year2, year$(), MonthYear, 744, 42, 60, 20
statictext #cal.born, "Date de naissance", 28, 6, 200, 20
BUTTON #cal.default, "", ValidName, UL, 850, 206, 10, 20 'hidden button for validate name combobox...
combobox #cal.who, Name$(), Names, 7, 206, 120, 18
statictext #cal.dtbio, "Date du biorythme", 640, 6, 210, 20
statictext #cal.cycle, "Nbre de Jours dans les cycles au :", 140, 210, 200, 20
statictext #cal.dbio, dtbio$, 348, 210, 100, 20
statictext #cal.valeurs, "", 425, 210, 400, 20
statictext #cal.com, "Observation", 10, 230, 835, 37
groupbox #cal.grp, "", 5, 260, 834, 51
statictext #cal.naiss, "Né(e) le ", 10, 270, 240, 20
statictext #cal.anniv, "Anniversaire dans ", 10, 289, 300, 20
statictext #cal.age, "Age ", 360, 270, 450, 20
statictext #cal.zodiac, "Zodiac : ", 320, 289, 515, 18
Open "GADGETS Date de Naissance"+space$(15)+date$ for Dialog_modal as #cal
' Open "GADGETS Date de Naissance"+space$(15)+date$ for graphics_nf_nsb as #cal
#cal, "trapclose [quit]"
#cal.bio "home; posxy CenterX CenterY"
Gwidth = CenterX * 2
Gheight = CenterY * 2
#cal.born "!font Arial bold 14"
#cal.dtbio "!font Arial bold 14"
#cal.com "!font Comic_Sans_MS 10"
#cal.cycle "!font Arial 10"
#cal.dbio "!font Arial 10 bold"
#cal.valeurs "!font Arial 10"
#cal.naiss "!font Arial 10 bold"
#cal.age "!font Arial 10 bold"
#cal.anniv "!font Arial 10 bold"
#cal.zodiac "!font Arial 10 bold"
#cal.who "font Arial 9 bold"
#cal.gr, "color blue"
#cal.gr, "place 10 20": #cal.gr, "\ Physique"
#cal.gr, "color green"
#cal.gr, "place 10 40": #cal.gr, "\ Emotinnel"
#cal.gr, "color red"
#cal.gr, "place 10 60": #cal.gr, "\ Intellectuel"
if lastselected > date$("01/01/1902") then 'read last date or item used...
#cal.who "selectindex ";0
date.g(1) = lastselected
else
#cal.who "selectindex ";lastselected
date.g(1) = val(word$(names$(lastselected),1))
end if
if nobody = 0 then index = index - 1 'erase the last record, just here to remenber the last date or item used...
call biorythm date.g(1), date.g(2)
for i = 1 to 2
call InitilizeGB "#cal.g";i', x, y
call CalendarRePrint "#cal.g";i, x, y
next
wait
sub InitilizeGB Handle$', x, y
w$ = right$(Handle$,1)
aDay$ = Date$("mm/dd/yyyy")
handle.m$ = "#cal.month"+w$ 'comboboxes
handle.y$ = "#cal.year"+w$
#handle.m$ "font courier_new bold 10"
#handle.y$ "font courier_new bold 10"
#Handle$ "down; rule xor"
#Handle$ "font courier_new bold 10" '; cls"
#Handle$ "Place 10 20"
#Handle$ "\<< >>"
if val(w$) = 1 then #Handle$ "color lightgray"
#Handle$ "Place 15 161"
' #Handle$ "\ Today: ";aDay$ 'US format
#Handle$ "\Aujourd'hui: ";word$(aDay$,2,"/");"/";word$(aDay$,1,"/");"/";word$(aDay$,3,"/") 'EU format
if val(w$) = 1 then #Handle$ "color darkgreen"
#Handle$ "font ms_sans_serif bold 9"
#Handle$ "Place 7 47"
' #Handle$ "\Sun Mon Tue Wed Thu Fri Sat" 'US format
#Handle$ "\Lun Mar Mer Jeu Ven Sam Dim" 'EU format
#Handle$ "font ms_sans_serif bold 10"
#Handle$ "when leftButtonDown calgButton"
end sub
sub CalendarRePrint Handle$, PosX, PosY
w = val(right$(Handle$,1))
Handle.g$ = "#cal.g";w
aDay$ = date$(date.g(w))
if w = 1 then call MajWho date.g(w) 'maj who combobox...
firstDay = Date$(Left$(aDay$,3);1;Right$(aDay$,5))
lastDay$ = Date$(Date$(Left$(Date$(firstDay+31),3);1;Right$(Date$(firstDay+31),5))-1)
dow(w) = (firstDay+1) Mod 7 + 1 'EU format
' dow(w) = (firstDay+2) Mod 7 + 1 'US format
If dow(w) < 1 Then dow(w) = (dow(w)+13) Mod 7 + 1
MonthName$ = Word$(Mois$,Val(Word$(lastDay$,1,"/")))
Yr$ = Right$(lastDay$,4)
handle.m$ = "#cal.month";w 'comboboxes
handle.y$ = "#cal.year";w
#handle.m$ "select ";MonthName$
#handle.y$ "select ";Yr$
#Handle.g$ "setfocus"
ldow = dow(w) :d = 0 :da = 0 :dd = 0
for nd = 1 to 42
lig = int(nd/7)
col = nd - (lig*7)
if nd mod 7 = 0 then col = 7 :lig = lig - 1 'case of must col = 7
select case
case ldow-1 > 0
d = d + 1
i = val(Mid$(date$(firstDay - d),4,2))
ldow = ldow - 1
nDay(w,nd) = i - ldow + d
#Handle.g$ "color lightgray"
case dd < Val(Mid$(lastDay$,4,2))
dd = dd + 1
nDay(w,nd) = dd
#Handle.g$ "color black"
if dd = val(word$(aDay$,2,"/")) then 'the day of aDay$
rcx(w) = col
rcy(w) = 4 + lig
end if
case else
da = da + 1
nDay(w,nd) = da
#Handle.g$ "color lightgray"
end select
#Handle.g$ "place ";(col-1)*Xref+6;" ";1+(4+lig)*Yref
#Handle.g$ "\";Space$(7)
#Handle.g$ "place ";(col-1)*Xref+12;" ";1+(4+lig)*Yref
#Handle.g$ "\"; Using("##",nDay(w,nd))
next
#Handle.g$ "color black"
#Handle.g$ "Place ";(rcx(w)-1)*Xref+6;" ";(rcy(w)-1)*Yref+4 ' show specific date w/box around date
#Handle.g$ "box ";rcx(w)*Xref+6;" ";rcy(w)*Yref+4
#Handle.g$ "flush; discard"
End sub
sub ValidName Handle$ 'hidden button for validate name combobox...
if current then ind = current else ind = selection
#cal.g1 "setfocus"
#cal.who "contents? text$"
for i = 1 to index
if names$(i) = str$(date.g(1))+" "+trim$(text$) then exit sub
next
select case
case word$(names$(ind),1)<>"" and text$ = ""
conf$ = "SUPPRIMER ";names$(ind);" ?"
confirm conf$; answer$
if answer$ = "yes" then
names$(ind) = ""
Name$(ind) = ""
call MajArray 'MAJ of array names$() etc...
#cal.who "reload"
selection = 0
#cal.who "selectindex ";selection
end if
case text$ <> "" and text$ <> word$(names$(id),2)
conf$ = "CREER ";date.g(1);" ";text$;" ?"
confirm conf$; answer$
if answer$ = "yes" then
index = index + 1
names$(index) = str$(date.g(1))+" "+text$
Name$(index) = text$
#cal.who "reload"
selection = index
#cal.who "selectindex ";selection
end if
end select
call CalendarRePrint "#cal.g1", PosX, PosY
call biorythm date.g(1), date.g(2)
end sub
sub Names Handle$ 'called by combobox
current = 0
#cal.who "selectionindex? i"
if i then
date.g(1) = val(word$(names$(i),1)) : current = i 'current = selected by combobox
selection = i
call CalendarRePrint "#cal.g1", PosX, PosY
call biorythm date.g(1), date.g(2)
end if
end sub
sub MajWho daten 'search 'daten' in database
if current = 0 then
#cal.who "selectindex ";0
for i = 1 to index 'date selected by founding in database ?
if val(word$(names$(i),1)) = daten then
#cal.who "selectindex ";i
selection = i
exit for
end if
next
end if
current = 0
end sub
sub MajArray 'mise à jour du tableau en cas d'effacement d'une des données...
for i = 1 to index
if val(word$(names$(i),1)) > 0 then ind = ind + 1
next
redim temp$(ind+20) :ind = 0
for i = 1 to index
if val(word$(names$(i),1)) > 0 then ind = ind + 1 :temp$(ind) = names$(i)
next
redim names$(ind+20) :redim Name$(ind+20)
index = ind
for i = 1 to index
names$(i) = temp$(i) :Name$(i) = word$(names$(i),2)
next
end sub
sub MonthYear Handle$
w = val(right$(Handle$,1))
handle.m$ = "#cal.month";w 'comboboxes
handle.y$ = "#cal.year";w
#handle.m$ "contents? MonthName$"
#handle.y$ "contents? Yr$"
#handle.m$ "selectionindex? mo"
date.g(w) = date$(right$(str$(100+mo),2);"/";word$(date$(date.g(w)),2,"/");"/";Yr$)
if date.g(w) = 0 then
aDay$ = right$(str$(100+mo),2);"/";word$(date$(date.g(w)),2,"/");"/";Yr$
firstDay = Date$(Left$(aDay$,3);1;Right$(aDay$,5))
date.g(w) = Date$(Left$(Date$(firstDay+31),3);1;Right$(Date$(firstDay+31),5))-1
end if
call CalendarRePrint Handle$, PosX, PosY
call biorythm date.g(1), date.g(2)
end sub
Sub calgButton Handle$, MouseX, MouseY
w = val(right$(Handle$,1))
aDay$ = date$(date.g(w))
Handle.g$ = "#cal.g";w
rcx = int((MouseX-6)/Xref)+1 ' check (grid) mouse position
rcy = int((MouseY-4)/Yref)+1
dom$ = Mid$(aDay$,4,2)
numD = date$(aDay$)
firstDay = Date$(Left$(aDay$,3);1;Right$(aDay$,5))
lastDay = Date$(Left$(Date$(firstDay+31),3);1;Right$(Date$(firstDay+31),5))-1
select case
case rcy < 3 and rcx = 1 and numD > date$("01/31/";YearLimitDown + 1) '"<<" last month (same day)
aDate$ = Date$(firstDay-1)
lastdom$ = Mid$(aDate$,4,2)
If Val(dom$) > Val(lastdom$) Then dom$ = lastdom$
aDay$ = Left$(aDate$,2);"/";dom$;Mid$(aDate$,6)
case rcy < 3 and rcx = 7 and numD < date$("12/01/";YearLimitDown + nYearLimitUp) '">>" next month (same day)
aDate$ = Date$(lastDay+1)
nxmo$ = Date$(Date$(aDate$)+31)
lastdom$ = Date$(Date$(Left$(nxmo$,3);1;Right$(nxmo$,5))-1)
lastdom$ = Mid$(lastdom$,4,2)
If Val(dom$) > Val(lastdom$) Then dom$ = lastdom$
aDay$ = Left$(aDate$,2);"/";dom$;Mid$(aDate$,6)
case rcy > 3 and rcy < 10
if rcy = 4 then i = rcx - dow(w) + 1 else i = 8 - dow(w) + ((rcy-5) * 7) + rcx
dat$ = word$(aDay$,1,"/");"/";right$(str$(100+i),2);"/";word$(aDay$,3,"/")
if date$(dat$) then
#Handle.g$ "Place ";(rcx(w)-1)*Xref+6;" ";(rcy(w)-1)*Yref+4 ' hide last specific date w/box around date
#Handle.g$ "box ";rcx(w)*Xref+6;" ";rcy(w)*Yref+4
#Handle.g$ "Place ";(rcx-1)*Xref+6;" ";(rcy-1)*Yref+4 ' show specific date w/box around date
#Handle.g$ "box ";rcx*Xref+6;" ";rcy*Yref+4
aDay$ = dat$
rcx(w) = rcx 'change only if date valid
rcy(w) = rcy
else
if firstDay > date$("01/31/";YearLimitDown + 1) and lastDay < date$("12/01/";YearLimitDown + nYearLimitUp) then
select case
case rcy = 4
dat$ = date$(firstDay - 1) 'change month (-1)
case rcy > 7
dat$ = date$(lastDay + 1) 'change month (+1)
end select
n = nDay(w,7*(rcy-4)+rcx)
aDay$ = word$(dat$,1,"/");"/";right$(str$(100+n),2);"/";word$(dat$,3,"/")
end if
end if
case rcy = 10 and w = 2
aDay$ = Date$("mm/dd/yyyy") ' reprint calendar for 'today'
end select
date.g(w) = date$(aDay$)
call CalendarRePrint Handle$, PosX, PosY
call biorythm date.g(1), date.g(2)
end sub
sub biorythm date.born, date.bio
pi = asn(1) * 2
Xd = 0 ' paramètres pour le traçage
Xf = Gwidth - Xd
NbJrEcran = 21 ' nombre de jour visualisés sur l'écran
JrEcrPix = Gwidth/(NbJrEcran + 1) ' nombre de pixels pour un jour
#cal.bio "cls; down; color lightgray"
for x = 1 to NbJrEcran + 1
#cal.bio "line ";x*JrEcrPix;" 20 ";x*JrEcrPix;" ";Gheight 'lignes verticales des jours
next
#cal.bio "line 0 ";10+Gheight/2;" ";Gwidth;" ";10+Gheight/2 'ligne horizontale centrale
'{ écart de date pour le 1er jour à gauche sur le diagramme...}
N = (date.bio - int(NbJrEcran/2)) - date.born
dN = 0
P = 0
CasPhys = 0
CasEmot = 0
CasCere = 0
PhEmCe = 0
for Xt = Xd to Xf
'{ amplitude du cycle }
Phys = sin(2*pi*(N+dN)/23)
Emot = sin(2*pi*(N+dN)/28)
Cere = sin(2*pi*(N+dN)/33)
'Affichage des Jours du mois et Jours de la semaine
if Xt > 0 and Jc < NbJrEcran and int(Xt mod JrEcrPix) = 0 then 'chaque jours
Jc = Jc + 1
DJc$ = date$(date.bio - int(NbJrEcran/2) + Jc)
DJc = date$(word$(DJc$,1,"/")+"/"+word$(DJc$,2,"/")+"/"+word$(DJc$,3,"/"))
Js$ = left$(JourSem$(DJc),1)
#cal.bio "color lightgray; place ";dN*JrEcrPix-4;" 16 ;|";Js$ '1ère lettre du jour de la semaine.
if Js$ = "D" then #cal.bio "color lightgray; line ";Xt;" 20 ";Xt;" ";Gheight 'si Dimanche : un trait vertical supplémentaire.
end if
'{ calcul valeurs du jour du Biorythme + infos + Commentaires Biorythme + Note }
if DJc = date.bio and J = 0 then
' #cal "font ";font$
#cal.bio "color darkred; line ";Xt;" 20 ";Xt;" ";Gheight 'MARQUE verticale centrale = jour référence.
CALL Commentaire Phys, Emot, Cere, 48+Gheight
JrPhys = (date.bio - date.born) mod 23
JrEmot = (date.bio - date.born) mod 28
JrCere = (date.bio - date.born) mod 33
' #cal.dbio date$(date.bio) 'format US
#cal.dbio mid$(date$(date.bio),4,3)+left$(date$(date.bio),3)+right$(date$(date.bio),4) 'date format Europe
#cal.valeurs "(B) Physique = ";JrPhys;" (V) Emotionnel = ";JrEmot;" (R) Cérébral = ";JrCere
J = 1
end if
'{ Y = Y central - valeur de Phys en integer x grossissement 85 : mise à l'échelle de la fenêtre}
YPhys = 10 + Gheight/2 - int(Phys*85)
YEmot = 10 + Gheight/2 - int(Emot*85)
YCere = 10 + Gheight/2 - int(Cere*85)
'{ traçage des courbes }
#cal.bio "color blue ;set ";Xt;" ";YPhys
#cal.bio "color green ;set ";Xt;" ";YEmot
#cal.bio "color red ;set ";Xt;" ";YCere
'{ Pixel suivant et delta jour }
P = P + 1
dN = P / JrEcrPix
next
call Date.Infos date.born, date.bio
#cal.bio "flush; discard"
end sub
sub Date.Infos Dborn, Dday 'Gadgets about date.born
if Dborn = 0 or Dday = 0 then exit sub
#cal.naiss "Né(e) le ";JourSem$(Dborn);" ";word$(date$(Dborn),2,"/");" ";NomMois$(Dborn);" ";right$(date$(Dborn),4)
#cal.age "Age : ";str$(Dday - Dborn);" jours soit : ";DiffDate$(Dborn,Dday)
y$ = str$(Year(Dday))
m$ = str$(Month(Dborn))
d$ = str$(Day(Dborn))
date.birth = date$(m$;"/";d$;"/";y$)
if date.birth < Dday then date.birth = date$(m$;"/";d$;"/";val(y$)+1) 'if the birthday is passed this year...
#cal.anniv "Anniversaire dans : ";DiffDate$(date.birth,Dday)
#cal.zodiac "Signe du Zodiac : ";Zodiac$(Dborn);" - ";SigneChinois$(Dborn)
end sub
Sub Commentaire Phys, Emot, Cere, Yc 'Interprétation du Biorythme...!
if (Phys<-0.18) then CasPhys = 0
if ((Phys>-0.18) and (Phys<0.18)) then CasPhys = 1
if (Phys>0.18) then CasPhys = 2
if (Emot<-0.18) then CasEmot = 0
if (Emot>-0.18) and (Emot<0.18) then CasEmot = 1
if (Emot>0.18) then CasEmot = 2
if (Cere<-0.18) then CasCere = 0
if (Cere>-0.18) and (Cere<0.18) then CasCere = 1
if (Cere>0.18) then CasCere = 2
Select case right$(str$(1000 + CasPhys * 100 + CasEmot * 10 + CasCere),3)
case "000" :C$ = "Vos trois cycles en période de récupération vous donnent un certain recul par rapport à tout ce qui vous entoure. Choisissez des activités reposantes."
case "001" :C$ = "Il n'y aurait que vous, vous seriez bien resté au chaud dans votre lit douillet toute la journée. Alors surtout n'essayez pas d'innover."
case "002" :C$ = "Vous posez sur les choses et sur les gens (y compris vous-même) un regard juste et lucide. Optez pour des activités demandant réflexion."
case "010" :C$ = "Vous ne vous sentez pas dans votre assiette. Evitez de prendre une décision qui engagerait votre avenir, vous pourriez vous en mordre les doigts."
case "011" :C$ = "Vous avez tendance à vous poser des tas de questions inutiles et à ne pas leur trouver de réponse, ce qui risque de retentir sur votre humeur."
case "012" :C$ = "Vous aurez tendance à fuir le brouhaha pour vous retirer dans votre tour d'ivoire et y réfléchir à loisir. Profitez-en pour faire des projets."
case "020" :C$ = "L'humeur est bonne et favorable aux rencontres, mais vous n'avez pas les pieds sur terre. Programmez ce jour-là des sorties, expos, cinéma."
case "021" :C$ = "Laissez-vous guider par votre humeur qui vous rend optimiste. Votre jugement risque de ne pas être très sûr, entourez-vous de bons conseils."
case "022" :C$ = "Aidé par votre flair et votre perspicacité, vous porterez un regard d'artiste sur le monde. Votre sensibilité et votre esprit favorisent la création."
case "100" :C$ = "Aujourd'hui il vaut mieux ne pas compter sur vous pour remuer ciel et terre. Lire un bon bouquin au coin du feu, c'est tout ce qui vous tente."
case "101" :C$ = "Vous vous demander si la vie vaut bien la peine d'être vécue. Ne cherchez surtout pas la réponse, livrez-vous plutôt à vos passe-temps préférés."
case "102" :C$ = "Vous risquez de vous lever du pied gauche et d'être mal en point. Mais votre sens du devoir prendra le dessus et vous fera oublier ce jour gris."
case "110" :C$ = "La moindre petite contrariété peut prendre à vos yeux des allures de catastrophe. Recherchez le calme et la solitude par dessus tout."
case "111" :C$ = "Cette combinaison ne se produit que 8 fois en 54 ans. Vous avez donc le temps de vous préparer et de vous en remettre, alors dorlotez-vous."
case "112" :C$ = "Votre humeur noire et vos observations aigres-douces (même justifiées) peuvent ne pas plaire à tout le monde, mettez de l'eau dans votre vin."
case "120" :C$ = "Heureusement que vos amis sont là pour vous entourer d'affection et vous prodiguer leurs conseils. Vous avez envie d'être dorloté."
case "121" :C$ = "Votre entourage va bénéficier de votre indulgence et de vos largesses. Prenez garde à ne pas vous laisser rouler, ne soyez pas trop poire. "
case "122" :C$ = "Vous avez l'esprit clair et une façon de réagir positive, mais n'en faites pas trop, physiquement vous risqueriez bien de ne pas suivre."
case "200" :C$ = "Aujourd'hui vous risquez de ne pas vous sentir très concerné par ce que vous faites. Alors contentez-vous de menus travaux."
case "201" :C$ = "Vous avez un peu de mal à rassembler vos idées et à vous faire comprendre. Gare aux étourderies, sourtout réfléchissez avant d'agir."
case "202" :C$ = "Vous ne manquerez ni de vivacité d'esprit, ni de vitalité et vous vous sentez de taille à surmonter les difficultés, profitez-en pour vous organiser."
case "210" :C$ = "Vous avez du mal à le cacher : un rien vous agace. Evitez de vous mettre en colère, cela risquerait bien de se retourner contre vous."
case "211" :C$ = "La forme est bonne mais le moral et les idées sont en roue libre. Contentez vous de tâches routinières, cela vaut beaucoup mieux."
case "212" :C$ = "Animé par l'envie d'agir et la volonté d'arriver à vos fins, vous avez quelques difficultés à supporter les contrariétés ou les contre-temps."
case "220" :C$ = "Vous voyez la vie en rose et comme la forme suit, vous vous montrez sous votre meilleur jour. N'hésitez pas à entreprendre."
case "221" :C$ = "Vos relations avec les autres sont assez chaleureuses. Laissez-vous aller à votre bonne humeur et évitez de prendre des décisions importantes."
case "222" :C$ = "Débordant d'énergie, vous vous sentez en pleine forme. Votre moral est au plus haut, votre esprit est alerte, bref la vie est vraiment belle."
end Select
#cal.com "Observation : "+C$
end sub
function SigneChinois$(dt) 'base on "Signes Chinois.txt"
d$ = date$(dt)
year$ = right$(d$,4)
if val(year$) < 1901 or val(year$) > 2019 then exit function
if fileExists(DefaultDir$, "Signes Chinois.txt") = 0 then exit function
open "Signes Chinois.txt" for input as #c
WHILE EOF(#c) = 0 and l < 3
LINE INPUT #c, ref$
if instr(ref$,year$) then
l = l + 1
l$(l) = ref$
end if
WEND
close #c
a = instr(l$(1),year$)
if dt < date$("02/"+mid$(l$(1),a+6,2)+"/"+year$) then l = 1 else l = 2
SigneChinois$ = "Signe Chinois : "+ word$(l$(l),6,";") + " - Élément : " + word$(l$(l),5,";")
end function
function Zodiac$(dt)
zod$ = "2101_Verseau 2002_Poissons 2103_Bélier 2104_Taureau 2005_Gémeaux 2206_Cancer "+_
"2207_Lion 2408_Vierge 2309_Balance 2410_Scorpion 2311_Sagitaire 2312_Capricorne"
d$ = date$(dt)
month = val(left$(d$,2))
dy = val(mid$(d$,4,2))
Zodiac$ = word$(zod$,month)
if dy < val(left$(Zodiac$,2)) then month = month - 1
if month = 0 then month = 12
Zodiac$ = mid$(word$(zod$,month),6)
end function
function DiffDate$(date1,date2) ' difference between date1 and date2 in Years, Months, Days
if date1 = 0 or date2 = 0 then exit function
if date1 > date2 then
dtemp = date1 'for the continuation, date1 MUST be < date2
date1 = date2
date2 = dtemp
end if
dyy = Year(date2) - Year(date1)
dmm = Month(date2) - Month(date1)
if dmm < 0 then dyy = dyy - 1 : dmm = dmm + 12
ddd = Day(date2) - Day(date1)
if ddd < 0 then
dmm = dmm - 1
ddd = ddd + GetDaysOfMonth(Month(date1), Year(date1))
if dmm < 0 then dyy = dyy - 1 : dmm = dmm + 12
end if
if dyy then Y$ = str$(dyy)+" An(s)"
if dmm then M$ = str$(dmm)+" Mois"
DiffDate$ = Y$;" ";M$;" ";str$(ddd);" Jour(s)"
end function
function GetDaysOfMonth(Month,Year) 'nbre de jours pour ce Mois 'Stefan Pendl
for GetDaysOfMonth = 31 to 28 step -1
if date$(Month; "/"; GetDaysOfMonth; "/"; Year) > 0 then exit for
next
end function
FUNCTION Day(days)
d$ = date$(days)
Day=val(mid$(d$,4,2))
END FUNCTION
FUNCTION Month(days)
d$ = date$(days)
Month = val(left$(d$,2))
END FUNCTION
FUNCTION Year(days)
d$ = date$(days)
Year = val(right$(d$,4))
END FUNCTION
FUNCTION JourSem$(Jour)
JourSem$ = word$(Jour$, Jour mod 7+1)
END FUNCTION
FUNCTION NomMois$(Jour)
NomMois$ = word$(Mois$, Month(Jour))
END FUNCTION
function fileExists(path$, filename$)
'DIM info$(10,10) doit déjà être déclarée
files path$, filename$, info$() ' path$ = DefaultDir$ en général...
fileExists = val(info$(0, 0)) 'non zéro si vrai
end function
[quit]
open "Gadget.ini" for output as #sv 'sauvegarde dernière date de naissance utilisée
#cal.who "selectionindex? id"
index = index + 1
if id = 0 then names$(index) = str$(date.g(1)) else names$(index) = str$(id)
for i = 1 to index
if names$(i) <> "" then #sv, names$(i)
next
close #sv
Close #cal
End
|
|
