Here You go it uses my (not done) text input function.
for anyone who know winapi:
i'm using popup menus and trackpopupmenu because i can't get info from a regular menu and the setmenu function so i did it this way.
and i use open/save file boxes from api and message boxes.
the one image is attached.
ignore the drawsliders function i havn't done anything with it yet
remstart
-------------------------------------------------------------------
program name:
-------------------------------------------------------------------
written by: Caleb Stewart
date:
-------------------------------------------------------------------
comments:
-------------------------------------------------------------------
remend
Sync on
Sync rate 100
WinX=(640/2)/2+25
WinY=(480/2)/2+25
Set window on
Set window position WinX,WinY
#include "TextFunctions.dba"
Load dll "User32.dll",1
Make Memblock 1,32
dim Line$(100)
Dim CurrentFile$(0)
Load image "Main.bmp",1
ink rgb(0,0,0),0
Main = MakeMenu(1)
AppendMenuItem(Main,1,"Ink Color")
AppendMenuItem(Main,2,"Font")
AppendMenuItem(Main,3,"Highlight")
Edit = MakeMenu(1)
AppendMenuItem(Edit,4,"Cut")
AppendMenuItem(Edit,5,"Copy")
AppendMenuItem(Edit,6,"Paste")
AppendMenu(Main,Edit,"Edit")
File = MakeMenu(1)
EditB = makemenu(1)
Help = MakeMenu(1)
AppendMenuItem(File,7,"New")
AppendMenuItem(File,8,"Open")
AppendMenuItem(File,9,"Save")
AppendMenuItem(File,10,"Save as...")
AppendMenuITem(File,11,"Quit")
AppendMenuItem(Editb,12,"Cut")
AppendMenuItem(EditB,13,"Copy")
AppendMenuItem(EditB,14,"Paste")
AppendMenuItem(EditB,15,"Ink Color")
AppendMenuItem(Help,16,"Notepad Help")
AppendMenuItem(Help,17,"About Notepad")
Window = Call dll(1,"GetActiveWindow")
Do
paste image 1,0,0
For X=0 to 100
if line$(X)>""
text 10,X*15+20,Line$(X)
endif
next x
if mouseclick()=1 and mouseY()>20 then Repeat: sync : until Mouseclick()=0 : Line=Textinput(Line)
If mouseclick()=2
Selected = ShowMenu(Main,Window,Mousex(),MouseY())
endif
If mouseY()<20
if MouseX()>0 and MouseX()<45
DrawBox(6,0,45,15,0)
if mouseclick()=1
DrawBox(6,0,45,15,1)
FS = showmenu(File,Window,3,18)
Select FS
Case 7
Alert("New?","Are You Sure?")
endcase
case 8
Path$=GetFileName("Open","Open Text file","Text Files(.TXT)","*.txt")
if path$>""
Load array path$,Line$(100)
CurrentFile$(0)=Path$
endif
endcase
Case 9
If CurrentFile$(0)>""
Delete file CurrentFile$(0)
Save array Currentfile$(0),Line$(100)
else
SaveAs("Save Text File")
endif
endcase
Case 10
SaveAs("Save Text File As...")
endcase
Case 11
Aselect=Alert("End","Are you sure you want to end?")
if aselect=1
end
endif
endcase
endselect
endif
repeat : sync : until mouseclick()=0
else
DrawBox(0,0,0,0,0)
endif
if MOuseX()>45 and MOuseX()<90
DrawBox(45,0,90,15,0)
if mouseclick()
drawbox(45,0,90,15,1)
ES = ShowMenu(EditB,Window,46,18)
endif
repeat : sync : until mouseclick()=0
endif
If mouseX()>90 and MOuseX()<135
drawbox(90,0,135,15,0)
if mouseclick()
HS = ShowMenu(Help,Window,92,18)
repeat : sync : until Mouseclick()=0
endif
endif
endif
GetWndXY(Window)
Sync
Cls
Loop
function drawBox(X1,Y1,X2,Y2,kind)
if kind=0
ink rgb(255,255,255),0
Line X1,Y1,X2,Y1
line X1,Y1,X1,Y2
ink rgb(0,0,0),0
line X2,Y1,X2,Y2
line X1,Y2,X2,Y2
endif
if kind=1
ink rgb(0,0,0),0
Line X1,Y1,X2,Y1
line X1,Y1,X1,Y2
ink rgb(255,255,255),0
line X2,Y1,X2,Y2
line X1,Y2,X2,Y2
endif
ink rgb(0,0,0),0
endfunction
Function SaveAs(Title$)
Path$=GetFileName("Save",Title$,"Text Files(.TXT)","*.txt")
if path$>""
if file exist(path$)
Aselect=Alert("Error","File Already Exists. Overwrite?")
if aselect=1
delete file Path$
Save array Path$,Line$(100)
CurrentFile$(0)=path$
endif
else
Save array path$,Line$(100)
CurrentFile$(0)=path$
endif
endif
endfunction
Function DrawSliders()
ink rgb(255,255,255),0
box 0,0,15,457
ink rgb(192,192,192),0
For Y=0 to 457 step 2
For X=0 to 15 step 2
dot x,y
next x
next y
for Y=1 to 457 step 2
for x=1 to 15 step 2
dot x,y
next X
next y
box 0,0,15,15
box 0,442,15,457
ink rgb(255,255,255),0
line 0,0,15,0
line 0,0,0,15
ink rgb(0,0,0),0
line 15,0,15,15
line 0,15,15,15
ink rgb(128,128,128),0
line 14,1,14,14
line 1,14,14,14
break
endfunction
Function Textinput(Lnum)
Rem where the starting text ends
endoftext=Len(Text$)
Rem Add the cursor indicator (_)
Text$=line$(Lnum)+"_"
Repeat
paste image 1,0,0
Rem Get the pressed key
Add$ = Inkey$()
rem if there is a key pressed and Backspace(14) enter(return) and tab(15) arn't pressed
if add$>"" and keystate(14)=0 and returnkey()=0 and keystate(15)=0 and left=0
Rem check if the the timer is greater then ten
if Addtimer>10
rem if the text is larger then 640 add a line
if Text width(Text$+Add$)>640
ShiftLinesDown(Lnum)
Rem take of the _
Line$(Lnum)=Left$(Text$,Len(Text$)-1)
Rem Set text to one line infront of the line number + _
Text$="_"
Rem add one to line number
Lnum=Lnum+1
endif
rem take off the "_"
Text$=Left$(text$,Len(Text$)-1)
Rem add the new character and add the _ back in
Text$=Text$+Add$+"_"
Rem set timer back to 0
addtimer=0
endif
endif
Rem If Tab is pressed
If Keystate(15)=1
if Text width(Text$+" ")>640
ShiftLinesDown(Lnum)
Rem take of the _
Line$(Lnum)=Left$(Text$,Len(Text$)-1)
Rem Set text to one line infront of the line number + _
Text$="_"
Rem add one to line number
Lnum=Lnum+1
endif
Rem Switch so you can't hold down tab
if Tab=0
if left=0
Rem Take of the _
Text$=Left$(Text$,Len(Text$)-1)
Rem add 5 spaces and the _
Text$=Text$+" _"
Rem Turn the switch on
tab=1
else
Text$="_ "+Right$(Text$,Len(Text$)-1)
tab=1
endif
endif
else
Rem If tab isn't pressed turn switch off
tab=0
endif
Rem If backspacce is pressed
If keystate(14)=1
Rem if timer is greater then 10
if backtimer>10
if left=0
Rem the line isn't 0
if Lnum>0
Rem Take of the _ and one other character
Text$=Left$(text$,Len(Text$)-2)
rem add the _ back on
Text$=Text$+"_"
Rem set timer to 0
backtimer=0
else
Rem If line is 0 and the cursor is not on the text passed to the function
if Len(Text$)-1>endoftext
Rem Same as above
Text$=Left$(text$,Len(Text$)-2)
Text$=Text$+"_"
backtimer=0
endif
endif
endif
Rem if your at the last one go up a line
If Len(text$)=1 and Lnum>0
if left=0
ShiftlinesUP(Lnum)
Rem Set the line number -1 of what it was
Lnum=Lnum-1
Rem Set text$ to the line array text plus the _
Text$=Line$(Lnum)+"_"
endif
endif
If left=1
Rem If the _ is on the left side
if Left$(Text$,1)="_"
Rem if your on a line greater the 0
if Lnum>0
Rem shift lines up
Shiftlinesup(lnum)
Rem subtract from the line number
lnum=lnum-1
Rem Set timer to 0
BackTimer=0
endif
endif
endif
endif
endif
rem if enter is pressed and timer is greater then 15
IF returnkey()=1 and returntimer>15
if left=0
ShiftLinesDown(Lnum)
Rem take of the _
Line$(Lnum)=Left$(Text$,Len(Text$)-1)
Rem Set text to one line infront of the line number + _
Text$="_"
Rem add one to line number
Lnum=Lnum+1
Rem set timer to 0
ReturnTimer=0
else
Rem Subract one from the line number
rem so that when it shifts down
rem it shifts the current line also
Line$(Lnum)=""
lnum=lnum-1
Rem Shift lines down
Shiftlinesdown(Lnum)
Rem Set the line one ahead of what
rem it was before(-1 was already
rem added so we need to add +2)
Lnum=Lnum+2
Rem set timer to 0
Returntimer=0
endif
endif
Rem Upkey/downkey line movments
If upkey() and movecounter>20 and Lnum>0
if left=0
Line$(lnum)=left$(Text$,Len(Text$)-1)
else
line$(Lnum)=Right$(Text$,Len(Text$)-1)
endif
Lnum=Lnum-1
if Line$(Lnum)="" then Left=0
Text$ = Line$(Lnum)+"_"
movecounter=0
endif
If downkey() and movecounter>20 and Lnum<100
Line$(lnum)=left$(Text$,Len(Text$)-1)
Lnum=Lnum+1
Text$ = Line$(Lnum)+"_"
movecounter=0
endif
If Leftkey() and left=0
Rem set left on
Left=1
Rem Put the _ at the biginning
Text$="_"+left$(Text$,Len(Text$)-1)
endif
if rightkey() and left=1
Rem Set Left off
Left=0
rem Put the _ at the end
Text$=Right$(Text$,Len(Text$)-1)+"_"
endif
rem sift through all the line exept the line number
rem and if it is equal to anything print it at the
rem appropriate place
for X=0 to 100
if line$(X)>"" and X!Lnum
text 10,X*15+20,Line$(X)
endif
next x
Rem Just to make sure the _ is always at the right spot
If Left=1
if right$(Text$,1)="_"
Text$=Left$(Text$,Len(Text$)-1)
Text$="_"+Text$
endif
else
if Left$(Text$,1)="_"
Text$=Right$(Text$,Len(Text$)-1)+"_"
endif
endif
rem Print the line numbers text.
Text 10,Lnum*15+20,Text$
Rem Add to all the timers
BackTimer = BackTimer+1
AddTimer = AddTimer + 1
Returntimer = Returntimer + 1
movecounter = movecounter + 1
TabCounter = TabCounter + 1
sync
cls
Rem repeat until Mouseclick and mouse y is above or below the current line
until Mouseclick() and MouseY()>(Lnum+1)*20 or Mouseclick() and mouseY()<lnum*20
Repeat : sync : until Mouseclick()=0
Rem set the line number array to the text$ minus the _
if left=0
Rem if left then take one from the right
Line$(Lnum) = Left$(Text$,Len(Text$)-1)
else
Rem if right then take one from the left
Line$(Lnum = Right$(Text$,Len(Text$)-1)
endif
Rem Set left to 0
Left=0
Rem exit function with the line number for if the user wants
rem to start at the same line next time
endfunction Lnum
Function ShiftLinesDown(Line)
For X=99 to line+1 step -1
line$(X+1)=Line$(X)
next x
endfunction
Function ShiftLinesUp(Line)
if line>0
For X=line to 99
Line$(X)=Line$(X+1)
next x
Line$(99)=""
endif
endfunction
Function MakeMenu(Pop)
If pop=1
Menu=Call dll(1,"CreatePopupMenu")
else
Menu=Call dll(1,"CreateMenu")
endif
endfunction menu
Function AppendMenuItem(Menu,ID,Txt$)
MF_String=0
MF_Popup=16
Call dll 1,"AppendMenuA",Menu,MF_String | MF_Popup,ID,Txt$
endfunction
Function AppendMenu(menu,AMenu,Txt$)
MF_String=0
MF_Popup=16
Call Dll 1,"AppendMenuA",menu,MF_String | MF_Popup,Amenu,Txt$
endfunction
function getwndxy(window)
rem get the pointer to the memblock
ptr=get memblock ptr(1)
rem call the dll and send the information to the memblock
call dll 1,"GetWindowRect",window,ptr
endfunction
Function SetMenu(Menu,Window)
MF_String=0
MF_Popup=16
Call dll 1,"SetMenu",Window,Menu
endfunction
Function ShowMenu(Popup,Window,X,Y)
rem select with left button
TPM_LEFTBUTTON = 0
rem return the selected item
TPM_RETURNCMD = 256
Selected = Call dll(1,"TrackPopupMenu",Popup,TPM_RETURNCMD | TPM_LEFTBUTTON,X+memblock dword(1,0)+4,Y+memblock dword(1,4)+23,0,Window,NULL)
endfunction selected
function getFileName(mode$,FileBoxTitle$,ShownFileFilter$,RealFileFilter$)
FileBoxTitle$ = FileBoxTitle$+"^"
FileFilter$ = ShownFileFilter$+"^"+RealFileFilter$+"^^"
rem Load the DLLs
user32=findFreeDllSlot()
load dll "user32.dll",user32
kernel32=findFreeDllSlot()
load dll "kernel32.dll",kernel32
comdlg32=findFreeDllSlot()
load dll "comdlg32.dll",comdlg32
rem Offset Table OPENFILENAME Struct
lStructSize = 0
hwndOwner = 4
hInstance = 8
lpstrFilter = 12
lpstrCustomFilter = 16
nMaxCustFilter = 20
nFilterIndex = 24
lpstrFile = 28
nMaxFile = 32
lpstrFileTitle = 36
nMaxFileTitle = 40
lpstrInitialDir = 44
lpstrTitle = 48
Flags = 52
nFileOffset = 56
nFileExtension = 58
lpstrDefExt = 60
lCustData = 64
lpfnHook = 68
lpTemplateName = 72
StructEnd = 76
rem OPENFILENAME Flag Table
OFN_ALLOWMULTISELECT = 512:rem 0x00000200
OFN_CREATEPROMPT = 8192:rem 0x00002000
OFN_ENABLEHOOK = 32:rem 0x00000020
OFN_ENABLETEMPLATE = 64:rem 0x00000040
OFN_ENABLETEMPLATEHANDLE = 128:rem 0x00000080
OFN_EXPLORER = 524288:rem 0x00080000
OFN_EXTENSIONDIFFERENT = 1024:rem 0x00000400
OFN_FILEMUSTEXIST = 4096:rem 0x00001000
OFN_HIDEREADONLY = 4:rem 0x00000004
OFN_LONGNAMES = 2097152:rem 0x00200000
OFN_NOCHANGEDIR = 8:rem 0x00000008
OFN_NODEREFERENCELINKS = 1048576:rem 0x00100000
OFN_NOLONGNAMES = 262144:rem 0x00040000
OFN_NONETWORKBUTTON = 131072:rem 0x00020000
OFN_NOREADONLYRETURN = 32768:rem 0x00008000
OFN_NOTESTFILECREATE = 65536:rem 0x00010000
OFN_NOVALIDATE = 256:rem 0x00000100
OFN_OVERWRITEPROMPT = 2:rem 0x00000002
OFN_PATHMUSTEXIST = 2048:rem 0x00000800
OFN_READONLY = 1:rem 0x00000001
OFN_SHAREAWARE = 16384:rem 0x00004000
OFN_SHOWHELP = 16:rem 0x00000010
rem FileBox Info
if Mode$="Open"
FileBoxFlags = OFN_EXPLORER + OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST + OFN_LONGNAMES + OFN_HIDEREADONLY + OFN_NONETWORKBUTTON + OFN_ALLOWMULTISELECT
endif
if Mode$="Save"
FileBoxFlags = OFN_EXPLORER + OFN_LONGNAMES + OFN_HIDEREADONLY + OFN_NONETWORKBUTTON + OFN_OVERWRITEPROMPT + OFN_ALLOWMULTISELECT
endif
PathBufferSize = 256
hWnd = call dll(user32,"GetActiveWindow")
hMod = call dll(kernel32,"GetModuleHandleA",0)
rem Create necessary memblocks
OFN_MB = findFreeMemblockSlot()
make memblock OFN_MB,StructEnd
PathBuffer_MB = findFreeMemblockSlot()
make memblock PathBuffer_MB,PathBufferSize
FileFilter_MB = findFreeMemblockSlot()
make memblock FileFilter_MB,len(FileFilter$)
FileBoxTitle_MB = findFreeMemblockSlot()
make memblock FileBoxTitle_MB,len(FileBoxTitle$)
rem Get the memblocks pointers
OFN = get memblock ptr(OFN_MB)
PathBuffer = get memblock ptr(PathBuffer_MB)
FileFilter = get memblock ptr(FileFilter_MB)
FileBoxTitle = get memblock ptr(FileBoxTitle_MB)
rem write Strings to Memblock
writeStringToMemblock(FileFilter_MB,FileFilter$)
writeStringToMemblock(FileBoxTitle_MB,FileBoxTitle$)
rem Write to OPENFILENAME Struct
write memblock dword OFN_MB,lStructSize,StructEnd
write memblock dword OFN_MB,hWndOwner,hWnd
write memblock dword OFN_MB,hInstance,hMod
write memblock dword OFN_MB,lpstrFilter,FileFilter
write memblock dword OFN_MB,lpstrFile,PathBuffer
write memblock dword OFN_MB,nMaxFile,PathBufferSize
write memblock dword OFN_MB,Flags,FileBoxFlags
write memblock dword OFN_MB,lpstrTitle,FileBoxTitle
rem Open the FileBox
if mode$="save"
call dll comdlg32,"GetSaveFileNameA",OFN
else
call dll comdlg32,"GetOpenFileNameA",OFN
endif
result$ = readStringFromMemblock(PathBuffer_MB)
rem Delete the memblocks
delete memblock OFN_MB
delete memblock PathBuffer_MB
delete memblock FileFilter_MB
delete memblock FileBoxTitle_MB
rem Delete the DLL from the memory
delete dll user32
delete dll kernel32
delete dll comdlg32
endfunction result$
rem Write a character string to the specified memblock
function writeStringToMemblock(numMemblock,text$)
for pos=1 to len(text$)
b=asc(mid$(text$,pos))
if b=asc("^") then b=0
write memblock byte numMemblock,pos-1,b
next pos
endfunction
rem Read a character string from the specified memblock
function readStringFromMemblock(numMemblock)
pos=0:text$=""
do
b=memblock byte(numMemblock,pos)
if b=0 then exit
text$=text$+chr$(b)
inc pos
loop
endfunction text$
rem Return the number of the first unused memblock
function findFreeMemblockSlot()
found=0:numMemblock=1
repeat
if memblock exist(numMemblock)=0 then exitfunction numMemblock
inc numMemblock
until numMemblock=256
endfunction 0
rem Return the first free DLL slot
function findFreeDllSlot()
found=0:numDLL=1
repeat
if dll exist(numDLL)=0 then exitfunction numDLL
inc numDLL
until numDLL=256
endfunction 0
function PickColors()
dllnum2=1
dllnum1=2
mem1=1
mem2=2
make memblock mem1,4*16
for n = 1 to 16
write memblock dword mem1,(n-1)*4,rgb(255,255,255)
next n
rem get window handle to declare owner window of dialog
hwndOwner=call dll(dllnum2,"GetActiveWindow")
rem get pointer to the custom color (array) memblock
lpCustColors=get memblock ptr(mem1)
rem create CHOOSECOLOR Structure
make memblock mem2,36
rem variables for the data positions of the CHOOSECOLOR structure
pos_lStructureSize=0
pos_hwndOwner=4
pos_hInstance=8
pos_rgbResult=12
pos_lpCustColors=16
pos_Flags=20
pos_lCustData=24
pos_lpfnHook=28
pos_lpTemplateName=32
rem pointer to the CHOOSECOLOR Structure and get structure size
lpCHOOSECOLOR=get memblock ptr(mem2)
lStructureSize=get memblock size(mem2)
write memblock dword mem2,pos_lpCustColors,lpCustColors
write memblock dword mem2,pos_hwndOwner,hwndOwner
write memblock dword mem2,pos_Flags,1+2+256
write memblock dword mem2,pos_lStructureSize,lStructureSize
rem call ChooseColor Function
bool=call dll(dllnum1,"ChooseColorA",lpCHOOSECOLOR)
if bool = 1
color_pick=memblock dword(mem2,pos_rgbResult)
red=rgbb(color_pick)
green=rgbg(color_pick)
blue=rgbr(color_pick)
color_pick=rgb(red,green,blue)
last_color=color_pick
else
color_pick=last_color
endif
rem finished with memblock mem2
delete memblock mem2
delete memblock mem1
endfunction color_Pick
Function Alert(Title$,Message$)
Selected = Call dll(1,"MessageBoxA",Call dll(1,"GetActiveWindow"),Message$,Title$,4)
If selected=6 then exitfunction 1
endfunction 0
New Site! Check it out \/
