This program will not display text that has many upper cases in the name. I think my cut off was about 5 or 6.

The text has to have both upper case and lower case letters in the name.

I had a listing from some phone books I created off the web some years ago and there was mixed case names in those.

Code:

'namefindproper.bas 'program to display name where capitalization in the name might be found #COMPILE EXE #DIM ALL #BREAK ON GLOBAL slist() AS STRING GLOBAL ifound AS LONG GLOBAL ihighbound AS LONG FUNCTION PBMAIN () AS LONG DIM sstring AS STRING DIM snewstring AS STRING DIM sfilename1 AS STRING DIM i AS LONG LOCAL stemp AS STRING LOCAL stemp2 AS STRING LOCAL stemp3 AS STRING ihighbound=2000 REDIM slist(1 TO ihighbound) AS STRING sfilename1=TRIM$(COMMAND$) IF NOT ISFILE(sfilename1) THEN STDOUT "the "+sfilename1+"file does not exist":EXIT FUNCTION ' STDOUT "processing filename "+sfilename1 OPEN sfilename1 FOR BINARY AS 1 GET$ #1, LOF(1), sstring CLOSE 1 sstring=" "+sstring+" " REPLACE $CR WITH $SPC IN sstring REPLACE $LF WITH $SPC IN sstring stemp2="()*=-$#@!~{}[]:;<>?/|\.,&^_+="+$DQ stemp3=STRING$(LEN(stemp2),$SPC) REPLACE ANY stemp2 WITH stemp3 IN sstring WHILE INSTR(sstring,$SPC+$SPC) REPLACE $SPC+$SPC WITH $SPC IN sstring WEND FOR I=1 TO LEN(SSTRING) IF MID$(SSTRING,i,1)=$SPC THEN IF LEN(stemp)=0& THEN ITERATE IF LEN(stemp)>2& THEN checkit(stemp) ' do not process any strings with lengths of 2 or less stemp="" ITERATE END IF stemp+=MID$(SSTRING,i,1) NEXT i FOR i=1 TO UBOUND(slist()) IF LEN(slist(i))=0& THEN IF i>1& THEN REDIM PRESERVE slist( 1 TO i-1) AS STRING ELSE REDIM PRESERVE slist( 1 TO 1) AS STRING END IF EXIT FOR END IF NEXT i ARRAY SORT slist() FOR i=1 TO UBOUND(slist()) IF LEN(slist(i)) THEN IF INSTR(slist(i),"'") THEN STDOUT slist(i) END IF NEXT i FOR i=1 TO UBOUND(slist()) IF LEN(slist(i)) THEN IF INSTR(slist(i),"'")=0& THEN STDOUT slist(i) END IF NEXT i ' waitkey$ END FUNCTION FUNCTION checkit(BYREF stemp AS STRING)AS LONG LOCAL i AS LONG LOCAL iuppercasealphacount AS LONG LOCAL ilowercasealphacount AS LONG LOCAL K AS LONG LOCAL stemp1 AS STRING stemp=TRIM$(stemp) IF LEN(STEMP)<3& THEN EXIT FUNCTION WHILE INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ",UCASE$(LEFT$(stemp,1)))=0& stemp=TRIM$(RIGHT$(stemp,LEN(stemp)-1)) IF LEN(STEMP)<3& THEN EXIT FUNCTION WEND IF UCASE$(stemp)="WWW" THEN EXIT FUNCTION IF UCASE$(stemp)="INC" THEN EXIT FUNCTION IF UCASE$(stemp)="LLC" THEN EXIT FUNCTION IF UCASE$(stemp)="COM" THEN EXIT FUNCTION IF UCASE$(RIGHT$(stemp,2))=$SQ+"S" THEN stemp=TRIM$(LEFT$(stemp,LEN(stemp)-2)) IF LEN(stemp)<3& THEN EXIT FUNCTION ' do not process any strings with lengths of 2 or less 'IF stemp="PrPt" THEN EXIT FUNCTION 'IF stemp="ByBl" THEN EXIT FUNCTION 'IF stemp="BelRvr" THEN EXIT FUNCTION 'IF stemp="ByVst" THEN EXIT FUNCTION 'IF stemp="GIMd" THEN EXIT FUNCTION 'IF stemp="GlMd" THEN EXIT FUNCTION 'IF stemp="GrndIsle" THEN EXIT FUNCTION 'IF stemp="ByVst" THEN EXIT FUNCTION stemp1=REMOVE$(stemp, ANY "0123456789 ") IF LEN(stemp1)=0& THEN EXIT FUNCTION FOR I=1 TO LEN(STEMP) IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ",MID$(STEMP,I,1)) THEN INCR iuppercasealphacount IF INSTR("abcdefghijklmnopqrstuvwxyz",MID$(STEMP,I,1)) THEN INCR ilowercasealphacount NEXT I IF ilowercasealphacount=0& THEN EXIT FUNCTION IF iuppercasealphacount<2& THEN EXIT FUNCTION addtoslist(stemp) END FUNCTION FUNCTION addtoslist(BYREF stemp AS STRING) AS LONG LOCAL i AS LONG FOR i=1 TO UBOUND(slist()) IF slist(i)=stemp THEN EXIT FUNCTION IF slist(i)="" THEN IF i=ihighbound THEN ihighbound+=2000 REDIM PRESERVE slist( 1 TO ihighbound) AS STRING END IF slist(i)=stemp:EXIT FUNCTION END IF NEXT i END FUNCTION

I agree with the author completely about Rules 2, 4,6 and 10. We frequently see problems posted here where applying one of these rules would have rapidly identified the cause of the failure.

Rule 1 is obviously more contentious, but as a

https://medium.com/better-programmin...g-43ae1764f73d]]>

and I'm supposing they'd appreciate a reliable header file... unless of course they don't...

Is there a cross-reference for translating the PB DECLARE statements into what they would need?

I'd appreciate any pointers to useful (and correct) info!

Thanks,

-John

]]>

The test code below shows that GetAsyncKeyState is True for one additional scroll after releasing the Ctrl key, whereas GetKeyState is False immediately. (Since I use Time$, Scroll more than a second apart to see results)

Code:

'Compilable Example: #Compile Exe #Dim All %Unicode = 1 #Include "Win32API.inc" Global hDlg As Dword Function PBMain() As Long Dialog Default Font "Tahoma", 36,1 Dialog New Pixels, 0, "PowerBASIC",,,300,50, %WS_OverlappedWindow To hDlg Dialog Show Modal hDlg Call DlgProc End Function CallBack Function DlgProc() As Long Select Case Cb.Msg Case %WM_MouseWheel ' If GetAsyncKeyState(%VK_Control) Then 'after key release, 1st time is True but False after that If GetKeyState(%VK_Control) Then Select Case Hi(Integer,Cb.WParam) Case < 0 : Dialog Set Text hDlg, Time$ Case > 0 : Dialog Set Text hdlg, Time$ End Select End If End Select End Function

But, in the larger app, both GetKeyState and GetAsyncKeyState are True for one additional scroll after releasing the Ctrl key, so there's something more to this that my simple example does not clarify.]]>

I have seen the usage of macros being used, I w'd like to have some example codes of Macro

their mechanisms do look cool. All help appreciated

]]>

Code:

// figure distance between 2 lat/lon points function distance(lat1, lon1, lat2, lon2, unit) { if ((lat1 == lat2) && (lon1 == lon2)) { return 0; } else { var radlat1 = Math.PI * lat1/180; var radlat2 = Math.PI * lat2/180; var theta = lon1-lon2; var radtheta = Math.PI * theta/180; var dist = Math.sin(radlat1) * Math.sin(radlat2) + Math.cos(radlat1) * Math.cos(radlat2) * Math.cos(radtheta); if (dist > 1) { dist = 1; } dist = Math.acos(dist); dist = dist * 180/Math.PI; dist = dist * 60 * 1.1515; // 'M' - miles is default if (unit=="K") { dist = dist * 1.609344 } if (unit=="N") { dist = dist * 0.8684 } if (unit=="F") { dist = dist * 5280 } return dist; } }

I'm trying to convert to PB, but it doesn't work.

I have:

Code:

pi = 3.141592653589793 ' returns distance in rounded off feet Function distance(lat1 As Double, lon1 As Double, lat2 As Double, lon2 As Double) As Long Local radlat1 As Double Local radlat2 As Double Local theta As Double Local radtheta As Double Local dist As Double If ((lat1 = lat2) And (lon1 = lon2)) Then Function = 0 Exit Function Else radlat1 = pi * lat1/180 radlat2 = pi * lat2/180 theta = lon1-lon2 radtheta = pi * theta/180 dist = Sin(radlat1) * Sin(radlat2) + Cos(radlat1) * Cos(radlat2) * Cos(radtheta) If (dist > 1) Then dist = 1 End If dist = arccos(dist) dist = dist * 180/pi dist = dist * 60 * 1.1515 Function=dist*5280 ' return in feet End If End Function Function arccos(v As Double) As Double Function = pi / 2 - Atn(v / Sqr(1 - v * v)) End Function

what am I doing wrong?

For context, you can do an online test here]]>

Code:

#STACK 10000000

i changed the stack to 100 Mb, and the program runs 25 million iterations without crashing, 10x more

What is going on? Is there a way to clear the stack from inside the program to prevent this?]]>