CONST Title = "URLpad"
CONST Version = "1.5 SE"
$APPTYPE GUI
$OPTIMIZE ON
$TYPECHECK ON
$ESCAPECHARS OFF
$INCLUDE "RAPIDQ.INC"
CONST NULL = CHR$(0)
CONST TAB = CHR$(9)
CONST LF = CHR$(10)
CONST CR = CHR$(13)
CONST QUOTE = CHR$(34)
CONST MB_OK = &H0
CONST MB_YESNOCANCEL = &H3
CONST MB_YESNO = &H4
CONST MB_ICONEXCLAMATION = &H30
CONST MB_ICONASTERISK = &H40
CONST MB_DEFBUTTON2 = &H100
CONST SC_MINIMIZE = &HF020
CONST SC_RESTORE = &HF120
CONST SW_SHOWNORMAL = &H1
CONST VK_BACK = &H8
CONST VK_TAB = &H9
CONST VK_RETURN = &HD
CONST VK_SHIFT = &H10
CONST VK_ESCAPE = &H1B
CONST VK_SPACE = &H20
CONST VK_HOME = &H24
CONST VK_LEFT = &H25
CONST VK_UP = &H26
CONST VK_DOWN = &H28
CONST VK_INSERT = &H2D
CONST VK_V = &H56
CONST VK_F3 = &H72
CONST WM_ACTIVATE = &H6
CONST WM_QUERYENDSESSION = &H11
CONST WM_KEYDOWN = &H100
CONST WM_KEYUP = &H101
CONST WM_SYSCOMMAND = &H112
CONST WM_MENUSELECT = &H11F
CONST WM_DROPFILES = &H233
CONST WM_USER = &H400
CONST WM_USERMINIMIZE = WM_USER + &H202
CONST FOF_SILENT = &H4
CONST FOF_RENAMEONCOLLISION = &H8
CONST FOF_NOCONFIRMATION = &H10
CONST FOF_ALLOWUNDO = &H40
CONST FO_MOVE = &H1
CONST FO_DELETE = &H3
CONST FO_RENAME = &H4
CONST CSIDL_DESKTOP = &H0
CONST CSIDL_RECENT = &H8
CONST SHARD_PATH = &H2
CONST SHCNE_ALLEVENTS = &H7FFFFFFF
CONST SHCNF_IDLIST = &H0
CONST PSD_MARGINS = &H2
CONST PSD_DISABLEPRINTER = &H20
CONST PSD_RETURNDEFAULT = &H400
CONST CF_SCREENFONTS = &H1
CONST CF_INITTOLOGFONTSTRUCT = &H40
CONST CF_EFFECTS = &H100
CONST SCREEN_FONTTYPE = &H2000
CONST FW_NORMAL = 400
CONST FW_BOLD = 700
CONST OUT_DEFAULT_PRECIS = 0
CONST CLIP_DEFAULT_PRECIS = 0
CONST DEFAULT_QUALITY = 0
CONST DEFAULT_PITCH = 0
CONST FF_DONTCARE = 0
CONST GWL_WNDPROC = (-4)
CONST GWL_HWNDPARENT = (-8)
CONST fileHILFE = "LiesMich.txt"
CONST fileHELP = "ReadMe.txt"
CONST fileEXE = "URLpad.exe"
CONST fileCFG = "URLpad.cfg"
CONST fileINI = "URLpad.ini"
CONST fileLNG = "URLpad.lng"
CONST fileLNK = "URLpad.lnk"
CONST fileVBS = "URLpad.vbs"
CONST LightBlue = &HAA0000
CONST FontName = "Courier New"
CONST FontSize = 10
CONST FontHeight = -13
TYPE SHFILEOPSTRUCT
hWnd AS LONG
wFunc AS LONG
pFrom AS LONG
pTo AS LONG
fFlags AS INTEGER
fAborted AS LONG
hNameMaps AS LONG
sProgress AS LONG
END TYPE
TYPE ITEMIDLIST
mkid AS LONG
END TYPE
TYPE PSD
lStructSize AS LONG
hWndOwner AS LONG
hDevMode AS LONG
hDevNames AS LONG
Flags AS LONG
ptPaperSizeX AS LONG
ptPaperSizeY AS LONG
rtMinMarginLeft AS LONG
rtMinMarginTop AS LONG
rtMinMarginRight AS LONG
rtMinMarginBottom AS LONG
rtMarginLeft AS LONG
rtMarginTop AS LONG
rtMarginRight AS LONG
rtMarginBottom AS LONG
hInstance AS LONG
lCustData AS LONG
lpfnPageSetupHook AS LONG
lpfnPagePaintHook AS LONG
lpPageSetupTemplate AS LONG
hPageSetupTemplate AS LONG
END TYPE
TYPE LOGFONT
lfHeight AS LONG
lfWidth AS LONG
lfEscapement AS LONG
lfOrientation AS LONG
lfWeight AS LONG
lfItalic AS BYTE
lfUnderline AS BYTE
lfStrikeOut AS BYTE
lfCharSet AS BYTE
lfOutPrecision AS BYTE
lfClipPrecision AS BYTE
lfQuality AS BYTE
lfPitchAndFamily AS BYTE
lfFaceName AS STRING * 32
END TYPE
TYPE CHOOSEFONT
lStructSize AS LONG
hwndOwner AS LONG
hDC AS LONG
lpLogFont AS LONG
iPointSize AS LONG
flags AS LONG
rgbColors AS LONG
lCustData AS LONG
lpfnHook AS LONG
lpTemplateName AS LONG
hInstance AS LONG
lpszStyle AS LONG
nFontType AS WORD
MISSING_ALIGNMENT AS WORD
nSizeMin AS LONG
nSizeMax AS LONG
END TYPE
DECLARE SUB DragFinishAPI LIB "shell32" ALIAS "DragFinish" (BYVAL hDrop AS LONG)
DECLARE SUB DragAcceptFilesAPI LIB "shell32" ALIAS "DragAcceptFiles" (BYVAL hWnd AS LONG, BYVAL fAccept AS LONG)
DECLARE FUNCTION DragQueryFileAPI LIB "shell32" ALIAS "DragQueryFileA" (BYVAL hDrop AS LONG, BYVAL iFile AS LONG, BYVAL lpszFile AS LONG, BYVAL cch AS LONG) AS LONG
DECLARE FUNCTION ShellExecuteAPI LIB "shell32" ALIAS "ShellExecuteA" (BYVAL hWnd AS LONG, BYVAL lpOperation AS STRING, BYVAL lpFile AS STRING, BYVAL lpParameters AS STRING, BYVAL lpDirectory AS STRING, BYVAL nShowCmd AS LONG) AS LONG
DECLARE FUNCTION SHFileOperationAPI LIB "shell32" ALIAS "SHFileOperationA" (lpFileOp AS SHFILEOPSTRUCT) AS LONG
DECLARE FUNCTION SHGetSpecialFolderLocationAPI LIB "shell32" ALIAS "SHGetSpecialFolderLocation" (BYVAL hwndOwner AS LONG, BYVAL nFolder AS LONG, BYVAL pidl AS LONG) AS LONG
DECLARE FUNCTION SHGetPathFromIDListAPI LIB "shell32" ALIAS "SHGetPathFromIDListA" (BYVAL pidl AS LONG, BYVAL pszPath AS LONG) AS LONG
DECLARE FUNCTION SHAddToRecentDocsAPI LIB "shell32" ALIAS "SHAddToRecentDocs" (BYVAL dwflags AS LONG, BYVAL dwdata AS STRING) AS LONG
DECLARE FUNCTION SHChangeNotifyAPI LIB "shell32" ALIAS "SHChangeNotify" (BYVAL wEventID AS LONG, BYVAL uFlags AS LONG, BYVAL dwItem1 AS LONG, BYVAL dwItem2 AS LONG) AS LONG
DECLARE FUNCTION GetFullPathNameAPI LIB "kernel32" ALIAS "GetFullPathNameA" (BYVAL lpFileName AS STRING, BYVAL nBufferLength AS LONG, BYVAL lpBuffer AS LONG, BYVAL lpFilePart AS STRING) AS LONG
DECLARE FUNCTION ChooseFontAPI LIB "comdlg32" ALIAS "ChooseFontA" (lpcf AS CHOOSEFONT) AS LONG
DECLARE FUNCTION PageSetupDlgAPI LIB "comdlg32" ALIAS "PageSetupDlgA" (lppsd AS PSD) AS LONG
DECLARE FUNCTION SetFocusAPI LIB "user32" ALIAS "SetFocus" (BYVAL hWnd AS LONG) AS LONG
DECLARE FUNCTION SetForegroundWindowAPI LIB "user32" ALIAS "SetForegroundWindow" (BYVAL hWnd AS LONG) AS LONG
DECLARE FUNCTION SetWindowLongAPI LIB "user32" ALIAS "SetWindowLongA" (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG, BYVAL dwNewLong AS LONG) AS LONG
DECLARE FUNCTION GetWindowLongAPI LIB "user32" ALIAS "GetWindowLongA" (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG) AS LONG
DECLARE FUNCTION GetKeyStateAPI LIB "user32" ALIAS "GetKeyState" (BYVAL nVirtKey AS LONG) AS INTEGER
DECLARE FUNCTION MessageBoxAPI LIB "user32" ALIAS "MessageBoxA" (BYVAL hWnd AS LONG, BYVAL lpText AS STRING, BYVAL lpCaption AS STRING, BYVAL uType AS LONG) AS LONG
DECLARE FUNCTION ShowWindowAPI LIB "user32" ALIAS "ShowWindow" (hWnd AS LONG, nCmdShow AS LONG) AS LONG
DECLARE FUNCTION IsIconicAPI LIB "user32" ALIAS "IsIconic" (BYVAL hwnd AS LONG) AS LONG
DECLARE SUB PostQuitMessageAPI LIB "user32" ALIAS "PostQuitMessage" (BYVAL nExitCode AS LONG)
DIM Intro AS QFORM
DIM MainForm AS QFORM
DIM MainMenu AS QMAINMENU
DIM MainPanel AS QPANEL, SubPanel AS QPANEL
DIM RichEdit AS QRICHEDIT
DIM StatusBar AS QSTATUSBAR
DIM File AS QMENUITEM
DIM New AS QMENUITEM, OPEN AS QMENUITEM, Save AS QMENUITEM, SaveAs AS QMENUITEM
DIM OpenURL AS QMENUITEM
DIM Break1 AS QMENUITEM
DIM ReOpen AS QMENUITEM, ReOpen1 AS QMENUITEM, ReOpen2 AS QMENUITEM, ReOpen3 AS QMENUITEM
DIM Break2 AS QMENUITEM
DIM PageSetup AS QMENUITEM, PagePrint AS QMENUITEM
DIM Break3 AS QMENUITEM
DIM ExitEditor AS QMENUITEM
DIM Edit AS QMENUITEM
DIM Undo AS QMENUITEM
DIM Cut AS QMENUITEM, Copy AS QMENUITEM, Paste AS QMENUITEM, Delete AS QMENUITEM
DIM Break5 AS QMENUITEM
DIM Find AS QMENUITEM, FindNext AS QMENUITEM, FindPrevious AS QMENUITEM
DIM Break6 AS QMENUITEM
DIM SelectAll AS QMENUITEM, DateTime AS QMENUITEM
DIM Options AS QMENUITEM
DIM Wrap AS QMENUITEM, FontDlg AS QMENUITEM, Font2Dlg AS QMENUITEM
DIM Break7 AS QMENUITEM
DIM Panel AS QMENUITEM
DIM Info AS QMENUITEM
DIM Help AS QMENUITEM
DIM Break8 AS QMENUITEM
DIM About AS QMENUITEM
DIM SearchField AS QEDIT
DIM SearchButton AS QBUTTON
DIM OpenLabel AS QLABEL, OpenBox AS QCOMBOBOX
DIM SaveButton AS QBUTTON
DIM SearchBox AS QCHECKBOX, MarkBox AS QCHECKBOX, DeleteBox AS QCHECKBOX
DIM AboutLabel1 AS QLABEL, AboutLabel2 AS QLABEL, AboutLabel3 AS QLABEL
DIM AboutWWW AS QLABEL, AboutMail AS QLABEL
DIM Font AS QFONT
Font.Name = FontName
Font.Size = FontSize
DIM Font2 AS QFONT
Font2.Name = FontName
Font2.COLOR = clBlue
Font2.Size = FontSize
DIM Font3 AS QFONT
Font3.COLOR = LightBlue
DIM Font4 AS QFONT
Font4.COLOR = LightBlue
Font4.AddStyles(fsUnderline)
DIM prt AS PSD
prt.lStructSize = SIZEOF(prt)
prt.hWndOwner = Application.Handle
prt.Flags = PSD_RETURNDEFAULT
prt.hDevNames = 0
prt.hDevMode = 0
DIM lf1 AS LOGFONT
lf1.lfFaceName = Font.Name & NULL
lf1.lfHeight = FontHeight
lf1.lfWidth = 0
lf1.lfEscapement = 0
lf1.lfOrientation = 0
lf1.lfWeight = FW_NORMAL
lf1.lfItalic = 0
lf1.lfUnderline = 0
lf1.lfStrikeOut = 0
lf1.lfCharSet = DEFAULT_CHARSET
lf1.lfOutPrecision = OUT_DEFAULT_PRECIS
lf1.lfClipPrecision = CLIP_DEFAULT_PRECIS
lf1.lfQuality = DEFAULT_QUALITY
lf1.lfPitchAndFamily = DEFAULT_PITCH AND FF_DONTCARE
DIM cf1 AS CHOOSEFONT
cf1.iPointSize = 10 * Font.Size
cf1.rgbColors = Font.COLOR
cf1.Flags = CF_SCREENFONTS OR CF_EFFECTS OR CF_INITTOLOGFONTSTRUCT
cf1.hwndOwner = Application.Handle
cf1.lStructSize = SIZEOF(cf1)
cf1.lpLogFont = lf1
cf1.nFontType = SCREEN_FONTTYPE
DIM lf2 AS LOGFONT
lf2.lfFaceName = Font2.Name & NULL
lf2.lfHeight = FontHeight
lf2.lfWidth = 0
lf2.lfEscapement = 0
lf2.lfOrientation = 0
lf2.lfWeight = FW_NORMAL
lf2.lfItalic = 0
lf2.lfUnderline = 0
lf2.lfStrikeOut = 0
lf2.lfCharSet = DEFAULT_CHARSET
lf2.lfOutPrecision = OUT_DEFAULT_PRECIS
lf2.lfClipPrecision = CLIP_DEFAULT_PRECIS
lf2.lfQuality = DEFAULT_QUALITY
lf2.lfPitchAndFamily = DEFAULT_PITCH AND FF_DONTCARE
DIM cf2 AS CHOOSEFONT
cf2.iPointSize = 10 * Font2.Size
cf2.rgbColors = Font2.COLOR
cf2.Flags = CF_SCREENFONTS OR CF_EFFECTS OR CF_INITTOLOGFONTSTRUCT
cf2.hwndOwner = Application.Handle
cf2.lStructSize = SIZEOF(cf2)
cf2.lpLogFont = lf2
cf2.nFontType = SCREEN_FONTTYPE
DIM defList AS QSTRINGLIST
DIM appList AS QSTRINGLIST
DIM FileName AS STRING
FileName = ""
DIM FileType AS STRING
FileType = ".txt"
DIM CountFiles AS BYTE
CountFiles = 0
DIM LastPos AS STRING
LastPos = ""
DIM DownPos AS INTEGER
DownPos = -1
DIM appDef AS INTEGER
appDef = 0
DIM Language AS STRING
Language = "E"
DIM Mode AS INTEGER
Mode = 0
DIM Over AS INTEGER
Over = False
DIM LengthURL AS INTEGER
LengthURL = 0
DIM WorkDir AS STRING
WorkDir = CURDIR$
DIM Separators AS STRING
Separators = "( )"
DIM Delimiter AS STRING
Delimiter = "'"
DIM TagString AS STRING
TagString = "www." & Delimiter & "http://" & Delimiter & "https://" & Delimiter & "mailto:"
DIM msg01 AS STRING
msg01 = "Text Files (*.txt)|*.txt|All Files (*.*)|*.*"
DIM msg02 AS STRING
msg02 = "Save changes?"
DIM msg03 AS STRING
msg03 = "Save changes to"
DIM msg04 AS STRING
msg04 = "exists. Overwrite?"
DIM msg05 AS STRING
msg05 = "not found."
DIM msg06 AS STRING
msg06 = "Cannot open file."
DIM msg07 AS STRING
msg07 = "Cannot open file because its size exceeds 64 KByte."
DIM msg08 AS STRING
msg08 = "page(s) sent to"
DIM msg09 AS STRING
msg09 = "Bytes saved"
DIM msg10 AS STRING
msg10 = "Bytes loaded"
DIM msg11 AS STRING
msg11 = "Insert"
DIM msg12 AS STRING
msg12 = "Overwrite"
DIM DefaultWndProc AS LONG
DefaultWndProc = GetWindowLongAPI(MainForm.Handle, GWL_WNDPROC)
DIM AlternateWndProc AS LONG
AlternateWndProc = 0
SUB HideShowPanel
DIM n AS INTEGER
n = Panel.Checked
IF n THEN
SearchField.Top = 6
SearchField.Left = 5
SearchField.Width = 100
SearchButton.Top = 6
SearchButton.Left = SearchField.Width + 10
SearchButton.Height = SearchField.Height
SearchButton.Enabled = (SearchField.Text <> "")
SaveButton.Top = 6
SaveButton.Left = MainForm.ClientWidth - SaveButton.Width - 5
SaveButton.Height = SearchButton.Height
OpenLabel.Top = 10
OpenLabel.Left = (SearchField.Width + SearchButton.Width + SaveButton.Left - OpenLabel.Width - OpenBox.Width) SHR 1
OpenBox.Top = 6
OpenBox.Left = OpenLabel.Left + OpenLabel.Width + 5
SearchBox.Top = 32
SearchBox.Width = MainForm.TextWidth(SearchBox.CAPTION) + 20
SearchBox.Left = 5
DeleteBox.Top = 32
DeleteBox.Width = MainForm.TextWidth(DeleteBox.CAPTION) + 20
DeleteBox.Left = MainForm.ClientWidth - DeleteBox.Width - 5
MarkBox.Top = 32
MarkBox.Width = MainForm.TextWidth(MarkBox.CAPTION) + 20
MarkBox.Left = (SearchBox.Width + DeleteBox.Left - MarkBox.Width + 5) SHR 1
END IF
SearchBox.Visible = n
SearchField.Visible = n
SearchButton.Visible = n
SaveButton.Visible = n
DeleteBox.Visible = n
MarkBox.Visible = n
OpenLabel.Visible = n
OpenBox.Visible = n
END SUB
SUB HideShowAbout
DIM n AS INTEGER
n = About.Checked
IF n THEN
AboutLabel1.Top = 19
AboutLabel1.Left = (MainForm.Width - AboutLabel1.Width) SHR 1
AboutLabel2.Top = 29
AboutLabel2.Left = 20
AboutLabel3.Top = 9
AboutLabel3.Left = 20
AboutMail.Top = 9
AboutMail.Left = MainForm.Width - AboutMail.Width - 28
AboutWWW.Top = 29
AboutWWW.Left = MainForm.Width - AboutWWW.Width - 28
END IF
AboutLabel1.Visible = n
AboutLabel2.Visible = n
AboutLabel3.Visible = n
AboutMail.Visible = n
AboutWWW.Visible = n
END SUB
SUB ForceRefresh (flag AS INTEGER)
IF MainForm.Width < 600 THEN
MainForm.Width = 600
flag = 1
END IF
IF MainForm.Height < 200 THEN
MainForm.Height = 200
flag = 1
END IF
SubPanel.Height = IIF(Panel.Checked OR About.Checked, 54, 1)
HideShowPanel
HideShowAbout
IF flag <> 0 THEN RichEdit.Width = RichEdit.Width - 1
END SUB
SUB FormResize
ForceRefresh(0)
END SUB
SUB MoveFileToBasket
DIM shOP AS SHFILEOPSTRUCT
DIM s AS STRING, t AS STRING
s = FileName & NULL & NULL
t = NULL & NULL
WITH shOP
.hwnd = Application.Handle
.wFunc = FO_DELETE
.fFlags = FOF_NOCONFIRMATION OR FOF_ALLOWUNDO
.pFrom = VARPTR(s)
.pTo = VARPTR(t)
END WITH
SHFileOperationAPI(shOP)
END SUB
SUB SetOpenList
DIM str AS STRING
str = "&1. " & FileName
IF CountFiles = 0 OR ReOpen1.CAPTION = str THEN
ReOpen.Enabled = True
ReOpen1.CAPTION = str
IF CountFiles = 0 THEN
ReOpen.Insert(0, ReOpen1)
CountFiles = 1
END IF
ELSE
str = "&2. " & FileName
IF CountFiles = 1 OR ReOpen2.CAPTION = str THEN
ReOpen2.CAPTION = str
IF CountFiles = 1 THEN
ReOpen.Insert(1, ReOpen2)
CountFiles = 2
END IF
ELSE
str = "&3. " & FileName
IF CountFiles = 2 OR ReOpen3.CAPTION = str THEN
ReOpen3.CAPTION = str
IF CountFiles = 2 THEN
ReOpen.Insert(2, ReOpen3)
CountFiles = 3
END IF
ELSE
ReOpen1.CAPTION = "&1. " & RIGHT$(ReOpen2.CAPTION, LEN(ReOpen2.CAPTION) - 4)
ReOpen2.CAPTION = "&2. " & RIGHT$(ReOpen3.CAPTION, LEN(ReOpen3.CAPTION) - 4)
ReOpen3.CAPTION = "&3. " & FileName
END IF
END IF
END IF
END SUB
SUB SaveFile
IF FILEEXISTS(Filename) AND DeleteBox.Checked THEN MoveFileToBasket
RichEdit.SaveToFile(FileName)
SetOpenList
StatusBar.Panel(2).CAPTION = " " & STR$(LEN(RichEdit.Text)) & " " & msg09
RichEdit.Modified = False
END SUB
FUNCTION RichEditSave AS INTEGER
DIM SaveDialog AS QSAVEDIALOG
DIM str AS STRING
DIM n AS INTEGER
SaveDialog.Filter = msg01
n = TALLY(FileName, "\")
IF 0 < n THEN
SaveDialog.FileName = FIELD$(FileName, "\", n + 1)
SaveDialog.InitialDir = LEFT$(FileName, RINSTR(FileName, "\") - 1)
ELSE
SaveDialog.InitialDir = CURDIR$
END IF
result = SaveDialog.EXECUTE
IF result THEN
str = SaveDialog.FileName
IF RINSTR(str, ".") <= RINSTR(str, "\") THEN str = str & FileType
IF FILEEXISTS(str) THEN result = (mrYes = MessageBoxAPI(Application.Handle, str & " " & msg04, Application.Title, MB_YESNO OR MB_ICONEXCLAMATION OR MB_DEFBUTTON2))
IF result THEN
FileName = str
Application.Title = Title & " - " & FIELD$(FileName, "\", TALLY(FileName, "\") + 1)
MainForm.CAPTION = FileName & " - " & Title & " " & Version
SaveFile
END IF
END IF
END SUB
SUB SaveAsClick
RichEditSave
END SUB
SUB SaveClick
IF FileName = "" THEN
SaveAsClick
ELSE
SaveFile
END IF
END SUB
SUB SaveButtonClick
SaveClick
SetFocusAPI(SaveButton.Handle)
END SUB
FUNCTION DisplayMessage (str AS STRING) AS LONG
result = MessageBoxAPI(Application.Handle, str, Application.Title, MB_OK OR MB_ICONASTERISK)
END FUNCTION
FUNCTION RichEditConfirmation AS INTEGER
DIM rc AS LONG
result = True
IF RichEdit.Modified THEN
rc = MessageBoxAPI(Application.Handle, IIF(FileName = "", msg02, msg03 & " " & FileName & "?"), Application.Title, MB_YESNOCANCEL OR MB_ICONEXCLAMATION)
IF rc = mrYes THEN
IF FileName = "" THEN
result = RichEditSave
ELSE
SaveClick
END IF
ELSE
result = (rc <> mrCancel)
END IF
END IF
END FUNCTION
FUNCTION GetFront (str AS STRING) AS INTEGER
DIM i AS INTEGER, j AS INTEGER
DIM s AS STRING
s = Separators & TAB
result = RINSTR(str, RIGHT$(s, 1))
j = LEN(s) - 1
WHILE j
i = RINSTR(str, MID$(s, j, 1))
IF result = 0 OR (i <> 0 AND (result < i OR result = 0)) THEN result = i
j = j - 1
WEND
END FUNCTION
FUNCTION GetRear (p AS INTEGER, str AS STRING) AS INTEGER
DIM i AS INTEGER, j AS INTEGER
DIM s AS STRING
s = Separators & TAB
result = INSTR(p, str, RIGHT$(s, 1))
j = LEN(s) - 1
WHILE j
i = INSTR(p, str, MID$(s, j, 1))
IF result = 0 OR (i <> 0 AND (i < result OR result = 0)) THEN result = i
j = j - 1
WEND
END FUNCTION
FUNCTION GetHiLen (p AS INTEGER, str AS STRING) AS INTEGER
DIM n AS INTEGER
result = INSTR(p, str, LF)
n = result - 1
IF MID$(str, n, 1) = CR THEN
result = n
n = result - 1
END IF
IF 0 < result THEN str = LEFT$(str, n)
result = GetRear(p, str)
IF result = 0 THEN result = LEN(str) + 1
END FUNCTION
SUB HiLight (i AS INTEGER, j AS INTEGER)
DIM str AS STRING, s AS STRING
DIM k AS INTEGER, l AS INTEGER, m AS INTEGER, n AS INTEGER
DIM f AS INTEGER, tmp AS INTEGER
IF MarkBox.Checked THEN
WITH RichEdit
tmp = .SelStart
str = LCASE$(.Text)
n = TALLY(TagString, Delimiter) + 1
WHILE n
s = FIELD$(TagString, Delimiter, n)
k = LEN(s)
m = INSTR(i, str, s) - 1
WHILE 0 <= m AND m < j
l = GetHiLen(m + 1, str) - m - 1
IF 0 < m THEN
f = INSTR(Separators & TAB & LF & CR, MID$(str, m, 1))
ELSE
f = 1
END IF
IF f <> 0 THEN
IF k < l THEN
.SelStart = m
.SelLength = l
.SelAttributes = Font2
END IF
END IF
m = INSTR(l + m, str, s) - 1
WEND
n = n - 1
WEND
.SelLength = 0
.SelStart = tmp
END WITH
END IF
IF i = 0 THEN FormResize
END SUB
SUB ExitClick
MainForm.CLOSE
END SUB
SUB NewClick
IF RichEditConfirmation THEN
RichEdit.Clear
RichEdit.Modified = False
StatusBar.Panel(0).CAPTION = "1 : 1"
StatusBar.Panel(2).CAPTION = ""
FileName = ""
Application.Title = Title
MainForm.CAPTION = Title & " " & Version
END IF
END SUB
FUNCTION LoadFile (str AS STRING) AS INTEGER
DIM pFile AS QFILESTREAM
DIM n AS INTEGER
DIM s AS STRING
result = False
IF str = "" THEN
s = IIF(Language = "E", fileHELP, FileHILFE)
IF FILEEXISTS(s) THEN
RichEdit.LoadFromFile(s)
HiLight(0, LEN(RichEdit.Text))
RichEdit.Modified = False
END IF
ELSEIF FILEEXISTS(str) THEN
n = -1
IF pFile.OPEN(str, fmOpenRead) THEN
n = pFile.Size
IF n < 65536 THEN s = pFile.ReadStr(n)
pFile.CLOSE
END IF
IF n < 0 THEN
DisplayMessage(msg06)
ELSEIF n < 65536 THEN
FileName = str
MainForm.CAPTION = FileName & " - " & Title & " " & Version
RichEdit.SelectAll
RichEdit.SelAttributes = Font
RichEdit.Text = LEFT$(s, n)
n = LEN(RichEdit.Text)
StatusBar.Panel(2).CAPTION = " " & STR$(n) & " " & msg10
HiLight(0, n)
RichEdit.Modified = False
SetOpenList
SendMessage(RichEdit.Handle, WM_KEYUP, VK_HOME, 0)
IF 1 < RichEdit.LineCount THEN
SendMessage(RichEdit.Handle, WM_KEYDOWN, VK_DOWN, 0)
SendMessage(RichEdit.Handle, WM_KEYDOWN, VK_UP, 0)
SendMessage(RichEdit.Handle, WM_KEYUP, VK_UP, 0)
END IF
result = True
ELSE
DisplayMessage(msg07)
END IF
ELSE
DisplayMessage(msg06)
END IF
SetFocusAPI(RichEdit.Handle)
END SUB
SUB OpenClick
DIM OpenDialog AS QOPENDIALOG
IF RichEditConfirmation THEN
IF 0 < TALLY(FileName, "\") THEN
OpenDialog.InitialDir = LEFT$(FileName, RINSTR(FileName, "\") - 1)
ELSE
OpenDialog.InitialDir = CURDIR$
END IF
OpenDialog.Filter = msg01
IF OpenDialog.EXECUTE THEN LoadFile(OpenDialog.FileName)
END IF
END SUB
SUB Reopen1Click
IF RichEditConfirmation THEN LoadFile(RIGHT$(ReOpen1.CAPTION, LEN(ReOpen1.CAPTION) - 4))
END SUB
SUB Reopen2Click
IF RichEditConfirmation THEN LoadFile(RIGHT$(ReOpen2.CAPTION, LEN(ReOpen2.CAPTION) - 4))
END SUB
SUB Reopen3Click
IF RichEditConfirmation THEN LoadFile(RIGHT$(ReOpen3.CAPTION, LEN(ReOpen3.CAPTION) - 4))
END SUB
SUB MarkInsertion (n AS INTEGER)
DIM i AS INTEGER, j AS INTEGER
DIM str AS STRING
IF RichEdit.Modified THEN
StatusBar.Panel(2).CAPTION = ""
WITH RichEdit
i = LEN(.Text)
FOR j = .SelStart + 1 TO i
str = MID$(.Text, j, 1)
IF 0 < INSTR(Separators & TAB & LF & CR, str) THEN EXIT FOR
NEXT j
i = .SelStart
IF n = -1 THEN
ClipBoard.OPEN
n = LEN(ClipBoard.Text)
ClipBoard.CLOSE
IF i < n THEN n = 0
END IF
i = i - n
IF 0 < i THEN
str = MID$(.Text, i, 1)
IF str = TAB OR str = LF OR str = CR THEN
i = i - 1
IF 0 < i THEN
str = MID$(.Text, i, 1)
IF str = TAB OR str = LF OR str = CR THEN i = i - 1
END IF
END IF
END IF
n = i
WHILE 0 < i
str = MID$(.Text, i, 1)
IF str = TAB OR str = LF OR str = CR THEN EXIT WHILE
IF i <> n THEN
IF 0 < INSTR(Separators, str) THEN EXIT WHILE
END IF
i = i - 1
WEND
n = .SelStart
.SelStart = i
.SelLength = j - i
.SelAttributes = Font
.SelLength = 0
.SelStart = n
END WITH
HiLight(i, j)
END IF
END SUB
SUB DeleteClick
IF 0 < RichEdit.SelLength THEN
RichEdit.SelText = ""
MarkInsertion(0)
END IF
END SUB
SUB CopyClick
WITH ClipBoard
.OPEN
.Text = RichEdit.SelText
.CLOSE
END WITH
END SUB
SUB CutClick
CopyClick
DeleteClick
END SUB
SUB PasteClick
RichEdit.PasteFromClipBoard
MarkInsertion(-1)
StatusBar.Panel(0).CAPTION = STR$(RichEdit.WhereY + 1) & " : " & STR$(RichEdit.WhereX + 1)
END SUB
SUB SelectAllClick
RichEdit.SelectAll
StatusBar.Panel(0).CAPTION = "1 : 1"
SetFocusAPI(RichEdit.Handle)
END SUB
SUB DateTimeClick
DIM str AS STRING
str = DATE$
str = FIELD$(str, "-", 3) & "-" & FIELD$(str, "-", 1) & "-" & FIELD$(str, "-", 2) & " " & LEFT$(TIME$, 5)
RichEdit.SelText = str
MarkInsertion(LEN(str))
StatusBar.Panel(0).CAPTION = STR$(RichEdit.WhereY + 1) & " : " & STR$(RichEdit.WhereX + 1)
END SUB
SUB WriteConfig
DIM pFile AS QFILESTREAM
IF RIGHT$(WorkDir, 1) <> "\" THEN WorkDir = WorkDir & "\"
IF pFile.OPEN(WorkDir & fileCFG, fmCreate) THEN
WITH pFile
.WriteLine("Top:" & STR$(MainForm.Top))
.WriteLine("Left:" & STR$(MainForm.Left))
.WriteLine("Width:" & STR$(MainForm.Width))
.WriteLine("Height:" & STR$(MainForm.Height))
.WriteLine("Font.Size:" & STR$(Font.Size))
.WriteLine("Font.Color:" & STRF$(Font.COLOR, ffGeneral, 11, 0))
.WriteLine("Font.Name:" & Font.Name)
.WriteLine("Font.Height:" & STR$(lf1.lfHeight))
.WriteLine("Font.Weight:" & STR$(lf1.lfWeight))
.WriteLine("Font.Styles:" & STR$(IIF(lf1.lfItalic = 0, 0, 1) + IIF(lf1.lfUnderline = 0, 0, 2) + IIF(lf1.lfStrikeOut = 0, 0, 4)))
.WriteLine("URL.Size:" & STR$(Font2.Size))
.WriteLine("URL.Color:" & STRF$(Font2.COLOR, ffGeneral, 11, 0))
.WriteLine("URL.Name:" & Font2.Name)
.WriteLine("URL.Height:" & STR$(lf2.lfHeight))
.WriteLine("URL.Weight:" & STR$(lf2.lfWeight))
.WriteLine("URL.Styles:" & STR$(IIF(lf2.lfItalic = 0, 0, 1) + IIF(lf2.lfUnderline = 0, 0, 2) + IIF(lf2.lfStrikeOut = 0, 0, 4)))
.WriteLine("Tray.Minimize:*")
.WriteLine("Tray.Close:*")
.WriteLine("WordWrap:" & STR$(Wrap.Checked))
.WriteLine("Show.Panel:" & STR$(Panel.Checked))
.WriteLine("Show.Info:" & STR$(About.Checked))
.WriteLine("UseRecycleBin:" & STR$(DeleteBox.Checked))
.WriteLine("ColorizeURLs:" & STR$(MarkBox.Checked))
.WriteLine("SearchSensitive:" & STR$(SearchBox.Checked))
.WriteLine("Language:" & Language)
.CLOSE
END WITH
END IF
END SUB
SUB MarkOnClick
DIM f AS INTEGER
WITH RichEdit
f = .Modified
.SelectAll
.SelAttributes = Font
HiLight(0, LEN(.Text))
.SelLength = 0
.Modified = f
IF 0 < LEN(.Text) THEN
SetFocusAPI(.Handle)
.SelStart = 0
.SelLength = 1
IF 0 < .SelLength OR 0 < .WhereY THEN
SendMessage(.Handle, WM_KEYDOWN, VK_LEFT, 0)
SendMessage(.Handle, WM_KEYUP, VK_LEFT, 0)
END IF
SetFocusAPI(MarkBox.Handle)
StatusBar.Panel(0).CAPTION = "1 : 1"
END IF
END WITH
END SUB
SUB FormWndProc (hWnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG)
DIM i AS LONG, n AS LONG, l AS LONG
DIM str AS STRING
SELECT CASE uMsg
CASE WM_DROPFILES
n = DragQueryFileAPI(wParam, &HFFFFFFFF, VARPTR(str), 0) - 1
FOR i = 0 TO n
l = DragQueryFileAPI(wParam, i, 0, 0)
str = SPACE$(l + 1)
DragQueryFileAPI(wParam, i, VARPTR(str), l + 1)
SetForegroundWindowAPI(Application.Handle)
IF RichEditConfirmation THEN
IF LoadFile(LEFT$(str, l)) THEN
RichEdit.SelStart = 0
RichEdit.SelLength = 0
END IF
END IF
NEXT
DragFinishAPI(wParam)
CASE WM_MENUSELECT
n = (wParam SHR 16 = &HFFFF AND lParam = 0)
i = (RichEdit.SelLength <> 0 OR n)
Cut.Enabled = i
Copy.Enabled = i
Delete.Enabled = i
ClipBoard.OPEN
Paste.Enabled = (ClipBoard.Text <> "" OR n)
ClipBoard.CLOSE
CASE WM_ACTIVATE
SetFocusAPI(RichEdit.Handle)
IF LengthURL <> 0 THEN
RichEdit.SelLength = LengthURL
LengthURL = 0
END IF
CASE WM_SYSCOMMAND
IF wParam = SC_MINIMIZE THEN PostMessage(MainForm.Handle, WM_USERMINIMIZE, 0, 0)
CASE WM_USERMINIMIZE
IF GetWindowLongAPI(MainForm.Handle, GWL_WNDPROC) <> DefaultWndProc THEN
AlternateWndProc = GetWindowLongAPI(MainForm.Handle, GWL_WNDPROC)
SetWindowLongAPI(MainForm.Handle, GWL_WNDPROC, DefaultWndProc)
PostMessage(MainForm.Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0)
END IF
CASE WM_QUERYENDSESSION
IF IsIconicAPI(Application.Handle) THEN SendMessage(MainForm.Handle, WM_SYSCOMMAND, SC_RESTORE, 0)
IF RichEditConfirmation THEN
WriteConfig
PostQuitMessageAPI(0)
END IF
END SELECT
END SUB
SUB FormOnPaint
IF AlternateWndProc <> 0 THEN SetWindowLongAPI(MainForm.Handle, GWL_WNDPROC, AlternateWndProc)
END SUB
SUB FormClose (Action AS INTEGER)
IF IsIconicAPI(Application.Handle) THEN
SendMessage(MainForm.Handle, WM_SYSCOMMAND, SC_RESTORE, 0)
MainForm.WndProc = FormWndProc
END IF
IF RichEditConfirmation = False THEN
Action = caNone
ELSE
WriteConfig
Application.Terminate
END IF
END SUB
SUB HelpClick
ShellExecuteAPI(Application.Handle, "Open", IIF(Language = "E", fileHELP, fileHILFE), "", WorkDir, 1)
END SUB
SUB InfoClick
About.Checked = IIF(About.Checked, False, True)
IF About.Checked THEN Panel.Checked = False
ForceRefresh(1)
SetFocusAPI(RichEdit.Handle)
END SUB
SUB URLOpen (str AS STRING)
DIM i AS INTEGER, j AS INTEGER
DIM s AS STRING
i = defList.ItemCount
WHILE 0 < i
i = i - 1
s = defList.Item(i)
j = LEN(s) - INSTR(s, Delimiter)
IF RIGHT$(s, j) = LCASE$(LEFT$(str, j)) THEN
j = VAL(FIELD$(s, Delimiter, 1))
IF (0 < j) AND (j <= appList.ItemCount) THEN
s = appList.Item(j - 1)
i = IIF(LEFT$(s, 1) = Delimiter, -2, -1)
END IF
END IF
WEND
j = IIF(i = -1, 0, (LCASE$(LEFT$(str, 7)) = "mailto:"))
IF i <> -2 THEN
i = OpenBox.ItemIndex
IF (i < 0) OR (j <> 0) THEN
ShellExecuteAPI(Application.Handle, "Open", str, "", CURDIR$, 1)
i = 0
ELSE
j = 0
WHILE 0 <= i
s = appList.Item(j)
IF INSTR(s, Delimiter) <> 1 THEN i = i - 1
j = j + 1
WEND
END IF
END IF
IF i < 0 THEN
i = INSTR(s, Delimiter)
j = LEN(s) - i
s = MID$(s, i + 1, j)
IF j = 0 THEN
ShellExecuteAPI(Application.Handle, "Open", str, "", CURDIR$, 1)
ELSEIF FILEEXISTS(s) THEN
ShellExecuteAPI(Application.Handle, "Open", s, str, CURDIR$, 1)
ELSE
DisplayMessage(s & " " & msg05)
END IF
END IF
END SUB
SUB RichOpen (str AS STRING)
DIM i AS INTEGER, j AS INTEGER, n AS INTEGER
DIM x AS INTEGER, y AS INTEGER
DIM s AS STRING, t AS STRING
LengthURL = 0
j = RichEdit.SelLength
n = RichEdit.SelStart
x = RichEdit.WhereX
y = RichEdit.WhereY
StatusBar.Panel(0).CAPTION = STR$(y + 1) & " : " & STR$(x + 1)
IF str = LastPos THEN
IF 0 < j THEN
str = RichEdit.Line(y)
IF RichEdit.WordWrap THEN
s = Separators & TAB & LF & CR
i = y
WHILE 0 < i
IF INSTR(s, MID$(RichEdit.Text, n - x, 1)) THEN
i = 0
ELSE
i = i - 1
t = RichEdit.Line(i)
str = t & str
x = x + LEN(t)
END IF
WEND
n = n - x
i = RichEdit.LineCount - 1
WHILE y < i
IF INSTR(s, MID$(RichEdit.Text, n + LEN(str) + 1, 1)) THEN
y = i
ELSE
y = y + 1
str = str & RichEdit.Line(y)
END IF
WEND
ELSE
n = n - x
END IF
str = str & TAB
str = LEFT$(str, GetHiLen(j + x, str) - 1)
i = GetFront(str)
str = MID$(str, i + 1, LEN(str) - i)
y = LEN(str)
j = TALLY(TagString, Delimiter) + 1
WHILE j
s = FIELD$(TagString, Delimiter, j)
x = LEN(s)
IF LCASE$(LEFT$(str, x)) = s THEN
IF x < y THEN EXIT WHILE
END IF
j = j - 1
WEND
IF j THEN
RichEdit.SelStart = n + i
RichEdit.SelLength = y
StatusBar.Panel(0).CAPTION = STR$(RichEdit.WhereY + 1) & " : " & STR$(RichEdit.WhereX + 1)
URLOpen(str)
LengthURL = y
LastPos = ""
END IF
ELSE
LastPos = str
END IF
ELSE
LastPos = str
END IF
END SUB
SUB MouseUp (Button AS SHORT, X AS SHORT, Y AS SHORT, Shift AS SHORT)
IF LengthURL <> 0 THEN
RichEdit.SelLength = LengthURL
LengthURL = 0
END IF
StatusBar.Panel(0).CAPTION = STR$(RichEdit.WhereY + 1) & " : " & STR$(RichEdit.WhereX + 1)
END SUB
SUB MouseOpen (Button AS SHORT, X AS SHORT, Y AS SHORT, Shift AS SHORT)
IF Button = 0 THEN RichOpen(STR$(X) & ":" & STR$(Y))
END SUB
SUB MenuOpen
DIM i AS INTEGER, n AS INTEGER
WITH RichEdit
i = .SelStart
n = .SelLength
.SelLength = IIF(0 < INSTR(Separators & TAB & LF & CR, MID$(TAB & .Line(.WhereY), .WhereX + 1, 1)), 1, -1)
LastPos = "0:0"
RichOpen(LastPos)
IF LastPos <> "" THEN
.SelStart = i
.SelLength = n
END IF
END WITH
END SUB
SUB MouseOver (X AS SHORT, Y AS SHORT, Shift AS SHORT)
IF Over THEN
AboutMail.Font = Font3
AboutWWW.Font = Font3
Over = False
END IF
END SUB
SUB OverReset (X AS SHORT, Y AS SHORT, Shift AS SHORT)
IF Over THEN
AboutMail.Font = Font3
AboutWWW.Font = Font3
Over = False
END IF
END SUB
SUB OverWWW (X AS SHORT, Y AS SHORT, Shift AS SHORT)
AboutMail.Font = Font3
AboutWWW.Font = Font4
Over = True
END SUB
SUB OpenWWW
URLOpen(AboutWWW.CAPTION)
END SUB
SUB OverMail (X AS SHORT, Y AS SHORT, Shift AS SHORT)
AboutWWW.Font = Font3
AboutMail.Font = Font4
Over = True
END SUB
SUB OpenMail
URLOpen("mailto:" & AboutMail.CAPTION)
END SUB
SUB SearchChange
DIM f AS INTEGER
f = (SearchField.Text <> "")
FindNext.Enabled = f
FindPrevious.Enabled = f
SearchButton.Enabled = f
END SUB
SUB Search (flag AS INTEGER)
DIM s AS STRING, t AS STRING
DIM n AS INTEGER
WITH RichEdit
IF SearchBox.Checked THEN
s = SearchField.Text
t = .Text
ELSE
s = LCASE$(SearchField.Text)
t = LCASE$(.Text)
END IF
n = .SelLength
IF flag THEN
n = INSTR(IIF(0 < n, 2, 1) + .SelStart, t, s) - 1
ELSE
n = RINSTR(LEFT$(t, IIF(0 < n, n - 1, 0) + .SelStart), s) - 1
END IF
IF 0 <= n THEN
.SelStart = n
.SelLength = LEN(s)
SendMessage(.Handle, WM_KEYDOWN, VK_LEFT, 0)
SendMessage(.Handle, WM_KEYUP, VK_LEFT, 0)
.SelLength = LEN(s)
ELSE
DisplayMessage(QUOTE & SearchField.Text & QUOTE & " " & msg05)
END IF
END WITH
END SUB
SUB SearchClick
Search((GetKeyStateAPI(VK_SHIFT) AND &H8000) = 0)
SetFocusAPI(SearchButton.Handle)
END SUB
SUB SearchKey (Key AS BYTE)
SELECT CASE Key
CASE VK_ESCAPE
SetFocusAPI(RichEdit.Handle)
CASE VK_RETURN
IF 0 < LEN(SearchField.Text) THEN SearchClick
END SELECT
END SUB
SUB SearchNext
Search(True)
SetFocusAPI(RichEdit.Handle)
END SUB
SUB SearchPrev
Search(False)
SetFocusAPI(RichEdit.Handle)
END SUB
SUB RichKeyDown (Key AS WORD, Shift AS INTEGER)
IF Key = VK_INSERT AND Shift = 0 THEN
Mode = IIF(Mode, False, True)
StatusBar.Panel(1).CAPTION = IIF(Mode = 0, msg11, msg12)
ELSEIF MarkBox.Checked THEN
IF (Key = VK_INSERT AND Shift = ShiftDown) OR (Key = VK_V AND Shift = CtrlDown) THEN
WITH ClipBoard
.OPEN
.Text = .Text
.CLOSE
END WITH
IF 0 < RichEdit.SelLength THEN RichEdit.SelText = ""
MarkInsertion(-1)
ELSE
IF DownPos < 0 THEN DownPos = RichEdit.SelStart
END IF
END IF
StatusBar.Panel(0).CAPTION = STR$(RichEdit.WhereY + 1) & " : " & STR$(RichEdit.WhereX + 1)
END SUB
SUB RichKeyUp (Key AS WORD, Shift AS INTEGER)
DIM f AS INTEGER
IF MarkBox.Checked THEN
IF (Key = VK_INSERT AND Shift = ShiftDown) OR (Key = VK_V AND Shift = CtrlDown) THEN
f = -1
ELSE
f = 0
IF 0 <= DownPos THEN
IF DownPos < RichEdit.SelStart THEN f = RichEdit.SelStart - DownPos
DownPos = -1
END IF
END IF
IF (VK_INSERT < Key AND Key <> VK_F3 AND Shift <> CtrlDown) OR (f = -1) OR Key = VK_BACK OR Key = VK_TAB OR (Key = VK_RETURN AND Shift <> AltDown) OR Key = VK_SPACE THEN
IF RichEdit.SelLength = 0 THEN MarkInsertion(f)
END IF
ELSEIF RichEdit.Modified THEN
StatusBar.Panel(2).CAPTION = ""
END IF
StatusBar.Panel(0).CAPTION = STR$(RichEdit.WhereY + 1) & " : " & STR$(RichEdit.WhereX + 1)
END SUB
SUB ToggleWrap
Wrap.Checked = IIF(Wrap.Checked, False, True)
RichEdit.WordWrap = Wrap.Checked
StatusBar.Panel(0).CAPTION = "1 : 1"
END SUB
SUB FocusEdit (Key AS BYTE)
IF Key = VK_ESCAPE THEN SetFocusAPI(RichEdit.Handle)
END SUB
SUB PanelClick
Panel.Checked = IIF(Panel.Checked, False, True)
IF Panel.Checked THEN About.Checked = False
ForceRefresh(1)
SetFocusAPI(IIF(Panel.Checked, SearchField.Handle, RichEdit.Handle))
END SUB
SUB FindClick
Panel.Checked = True
About.Checked = False
ForceRefresh(1)
SetFocusAPI(SearchField.Handle)
END SUB
SUB PageSetupClick
DIM f AS INTEGER
f = IIF(prt.hDevMode = 0 OR prt.hDevNames = 0, 0, 1)
IF f = 0 THEN f = PageSetupDlgAPI(prt)
IF f <> 0 THEN
prt.Flags = PSD_MARGINS OR PSD_DISABLEPRINTER
PageSetupDlgAPI(prt)
END IF
END SUB
SUB PagePrintClick
DIM r AS STRING, s AS STRING, t AS STRING
DIM x AS INTEGER, y AS INTEGER, xx AS INTEGER, yy AS INTEGER
DIM i AS INTEGER, j AS INTEGER, n AS INTEGER, m AS INTEGER, o AS INTEGER
DIM f AS INTEGER
f = IIF(prt.hDevMode = 0 OR prt.hDevNames = 0, 0, 1)
IF f = 0 THEN f = PageSetupDlgAPI(prt)
IF f <> 0 THEN
WITH Printer
.Copies = 1
.Font = Font
.Orientation = IIF(prt.ptPaperSizeX < prt.ptPaperSizeY, 0, 1)
m = 0
n = 1
o = .TextHeight("Xy")
x = .PageWidth * prt.rtMarginLeft / prt.ptPaperSizeX
y = .PageHeight * prt.rtMarginTop / prt.ptPaperSizeY
xx = .PageWidth - (Printer.PageWidth * prt.rtMarginRight / prt.ptPaperSizeX) - x
yy = .PageHeight - (Printer.PageHeight * prt.rtMarginBottom / prt.ptPaperSizeY) - y
.BeginDoc
FOR i = 1 TO RichEdit.LineCount
s = RichEdit.Line(i - 1)
t = ""
FOR j = 1 TO LEN(s)
r = MID$(s, j, 1)
IF r = TAB THEN r = SPACE$(6 - (LEN(t) MOD 6))
IF xx < .TextWidth(t + r) THEN
IF yy < m + o THEN
.NewPage
n = n + 1
m = 0
END IF
IF t <> "" THEN .TextOut(x, y + m, t, 0, -1)
m = m + o
t = r
ELSE
t = t + r
END IF
NEXT
IF yy < m + o THEN
.NewPage
n = n + 1
m = 0
END IF
IF t <> "" THEN .TextOut(x, y + m, t, 0, -1)
m = m + o
t = ""
NEXT
.EndDoc
MessageBoxAPI(Application.Handle, STR$(n) & " " & msg08 & " " & .Printers(.PrinterIndex), Application.Title, MB_OK OR MB_ICONASTERISK)
END WITH
END IF
END SUB
SUB FontDlgClick
DIM f AS INTEGER
IF ChooseFontAPI(cf1) <> 0 THEN
WITH Font
.DelStyles(fsBold, fsItalic, fsUnderline, fsStrikeOut)
.Name = LEFT$(lf1.lfFaceName, INSTR(lf1.lfFaceName, NULL) - 1)
.Size = cf1.iPointSize / 10
.COLOR = cf1.rgbColors
IF lf1.lfWeight = FW_BOLD THEN .AddStyles(fsBold)
IF lf1.lfItalic <> 0 THEN .AddStyles(fsItalic)
IF lf1.lfUnderline <> 0 THEN .AddStyles(fsUnderline)
IF lf1.lfStrikeOut <> 0 THEN .AddStyles(fsStrikeOut)
END WITH
WITH RichEdit
f = .Modified
.Font = Font
.SelectAll
.SelAttributes = Font
HiLight(0, LEN(.Text))
.Modified = f
END WITH
END IF
END SUB
SUB Font2DlgClick
DIM f AS INTEGER
IF ChooseFontAPI(cf2) <> 0 THEN
WITH Font2
.DelStyles(fsBold, fsItalic, fsUnderline, fsStrikeOut)
.Name = LEFT$(lf2.lfFaceName, INSTR(lf2.lfFaceName, NULL) - 1)
.Size = cf2.iPointSize / 10
.COLOR = cf2.rgbColors
IF lf2.lfWeight = FW_BOLD THEN .AddStyles(fsBold)
IF lf2.lfItalic <> 0 THEN .AddStyles(fsItalic)
IF lf2.lfUnderline <> 0 THEN .AddStyles(fsUnderline)
IF lf2.lfStrikeOut <> 0 THEN .AddStyles(fsStrikeOut)
END WITH
f = RichEdit.Modified
HiLight(0, LEN(RichEdit.Text))
RichEdit.Modified = f
END IF
END SUB
SUB ReadConfig
DIM pfile AS QFILESTREAM
DIM str AS STRING, s AS STRING, t AS STRING
DIM i AS INTEGER, n AS INTEGER
IF FILEEXISTS(fileINI) THEN
IF pfile.OPEN(fileINI, fmOpenRead) THEN
FOR n = 1 TO pFile.LineCount
str = pfile.ReadLine
IF str <> "" THEN
i = INSTR(str, "=")
IF 1 < i THEN
s = LCASE$(LEFT$(str, i - 1))
t = MID$(str, i + 1, LEN(str) - i)
SELECT CASE s
CASE "delimiter"
Delimiter = t
CASE "separators"
Separators = t
CASE "tags"
TagString = LCASE$(t)
CASE "application"
appList.AddItems(t)
CASE "default"
IF 0 < INSTR(t, Delimiter) THEN
s = FIELD$(t, Delimiter, 1)
IF INSTR(s, "-") + INSTR(s, "+") = 0 THEN defList.AddItems(LCASE$(t))
ELSEIF INSTR(t, "-") + INSTR(t, "+") = 0 THEN
appDef = VAL(t)
END IF
END SELECT
END IF
END IF
NEXT
pfile.CLOSE
OpenBox.Clear
FOR n = 1 TO appList.ItemCount
str = appList.Item(n - 1)
i = INSTR(str, Delimiter) - 1
IF i < 0 THEN
i = LEN(str)
ELSEIF i = 0 THEN
i = -1
END IF
IF 0 <= i THEN
OpenBox.AddItems(LEFT$(str, i))
IF n = appDef THEN OpenBox.ItemIndex = OpenBox.ItemCount - 1
END IF
NEXT
END IF
END IF
OpenBox.Enabled = (appList.ItemCount <> 0)
END SUB
SUB ReadParams
DIM str AS STRING
DIM i AS INTEGER, n AS INTEGER
FOR i = 1 TO COMMANDCOUNT
IF COMMAND$(i)[1] <> "/" THEN
FileName = COMMAND$(i)
IF FileName <> "" THEN
str = SPACE$(260)
n = GetFullPathNameAPI(FileName, LEN(str), VARPTR(str), "")
IF 0 < n THEN
FileName = LEFT$(str, n)
LoadFile(FileName)
END IF
END IF
ELSE
DisplayMessage("Bad parameter: " & COMMAND$(i))
END IF
NEXT
END SUB
FUNCTION GetSpecialFolder (csidl AS LONG) AS STRING
DIM idl AS ITEMIDLIST
DIM str AS STRING
result = ""
IF SHGetSpecialFolderLocationAPI(Application.Handle, csidl, idl) = 0 THEN
str = SPACE$(260)
IF SHGetPathFromIDListAPI(idl.mkid, VARPTR(str)) <> 0 THEN result = LEFT$(str, INSTR(str, NULL) - 1) & "\"
END IF
END FUNCTION
SUB CreateShortcut (csidl AS LONG, name AS STRING, path AS STRING)
DIM idl AS ITEMIDLIST
DIM pFile AS QFILESTREAM
DIM SHFileOp AS SHFILEOPSTRUCT
DIM p AS STRING, s AS STRING, t AS STRING, str AS STRING
DIM n AS SINGLE
p = WorkDir & IIF(RIGHT$(WorkDir, 1) = "\", "", "\")
s = GetSpecialFolder(CSIDL_RECENT)
t = GetSpecialFolder(csidl)
IF (s <> "") AND (t <> "") THEN
IF SHAddToRecentDocsAPI(SHARD_PATH, p & path) THEN
s = s & fileEXE & ".lnk"
n = TIMER
WHILE ABS(TIMER - n) < 10.0
IF FILEEXISTS(s) THEN
IF ABS(TIMER - n) < 9.0 THEN n = TIMER - 9.0
END IF
WEND
s = s & NULL & NULL
str = t & NULL & NULL
WITH SHFileOp
.wFunc = FO_MOVE
.pFrom = VARPTR(s)
.pTo = VARPTR(str)
.fFlags = FOF_SILENT
END WITH
IF SHFileOperationAPI(SHFileOp) = 0 THEN
s = t & fileEXE & ".lnk"
n = TIMER
WHILE ABS(TIMER - n) < 10.0
IF FILEEXISTS(s) THEN
IF ABS(TIMER - n) < 9.0 THEN n = TIMER - 9.0
END IF
WEND
s = s & NULL & NULL
t = t & name & ".lnk" & NULL & NULL
WITH SHFileOp
.wFunc = FO_RENAME
.pFrom = VARPTR(s)
.pTo = VARPTR(t)
.fFlags = FOF_SILENT OR FOF_RENAMEONCOLLISION
END WITH
IF SHFileOperationAPI(SHFileOp) = 0 THEN
IF SHGetSpecialFolderLocationAPI(Application.Handle, csidl, idl) = 0 THEN SHChangeNotifyAPI(SHCNE_ALLEVENTS, SHCNF_IDLIST, idl, 0)
END IF
ELSE
s = p & fileVBS
IF pFile.OPEN(s, fmCreate) THEN
WITH pFile
.WriteLine("Set WshShell = WScript.CreateObject(" & QUOTE & "WScript.Shell" & QUOTE & ")")
.WriteLine("sDesktop = WshShell.SpecialFolders(" & QUOTE & "Desktop" & QUOTE & ")")
.WriteLine("Set oShell = WshShell.CreateShortcut(sDesktop & " & QUOTE & "\" & fileLNK & QUOTE & ")")
.WriteLine("oShell.TargetPath = " & QUOTE & p & fileEXE & QUOTE)
.WriteLine("oShell.WorkingDirectory = " & QUOTE & WorkDir & QUOTE)
.WriteLine("oShell.Description = " & QUOTE & name & QUOTE)
.WriteLine("oShell.Save")
.CLOSE
END WITH
SHELL "cscript " & QUOTE & s & QUOTE & " //T:5"
KILL s
END IF
END IF
END IF
END IF
END SUB
SUB ButtonEnglishClick
Intro.CLOSE
END SUB
SUB ButtonGermanClick
Intro.CLOSE
Language = "D"
END SUB
SUB ShowIntro (str AS STRING)
DIM ButtonEnglish AS QBUTTON, ButtonGerman AS QBUTTON
DIM CheckBoxLink AS QCHECKBOX
DIM IntroCaption AS QLABEL
DIM IntroPanel AS QPANEL
DIM n AS INTEGER
WITH Intro
.CAPTION = Title & " " & Version
.BorderStyle = bsNone
.Height = 160
.Width = 300
.Center
END WITH
WITH IntroPanel
.PARENT = Intro
.Left = 2
.Top = 2
.Width = Intro.Width - 4
.Height = Intro.Height - 4
END WITH
WITH IntroCaption
.PARENT = IntroPanel
.CAPTION = "Welcome!" & CR & CR & "Please choose your language:"
.Left = 30
.Top = 20
.Width = 200
.Height = 50
END WITH
WITH ButtonEnglish
.PARENT = IntroPanel
.CAPTION = "English"
.Left = 30
.Top = 80
.Width = 96
.OnClick = ButtonEnglishClick
END WITH
WITH ButtonGerman
.PARENT = IntroPanel
.CAPTION = str
.Left = 170
.Top = 80
.Width = 96
.OnClick = ButtonGermanClick
END WITH
WITH CheckBoxLink
.PARENT = IntroPanel
.CAPTION = "Create Desktop Shortcut"
.Left = 30
.Top = 122
.Width = 230
.Checked = True
END WITH
SetWindowLongAPI(Intro.Handle, GWL_HWNDPARENT, 0)
SetWindowLongAPI(Application.Handle, GWL_HWNDPARENT, Intro.Handle)
Intro.SHOWMODAL
IF CheckBoxLink.Checked THEN CreateShortcut(CSIDL_DESKTOP, Title, fileEXE)
END SUB
SUB LoadLanguage
DIM nameList AS QSTRINGLIST
DIM n AS INTEGER
IF FILEEXISTS(fileLNG) THEN
WITH nameList
.LoadFromFile(fileLNG)
n = .ItemCount
IF 1 < n THEN File.CAPTION = .Item(1)
IF 2 < n THEN New.CAPTION = .Item(2)
IF 3 < n THEN OPEN.CAPTION = .Item(3)
IF 4 < n THEN Save.CAPTION = .Item(4)
IF 5 < n THEN SaveAs.CAPTION = .Item(5)
IF 6 < n THEN ReOpen.CAPTION = .Item(6)
IF 7 < n THEN PageSetup.CAPTION = .Item(7)
IF 8 < n THEN PagePrint.CAPTION = .Item(8)
IF 11 < n THEN ExitEditor.CAPTION = .Item(11)
IF 12 < n THEN Edit.CAPTION = .Item(12)
IF 13 < n THEN Cut.CAPTION = .Item(13)
IF 14 < n THEN Copy.CAPTION = .Item(14)
IF 15 < n THEN Paste.CAPTION = .Item(15)
IF 16 < n THEN Delete.CAPTION = .Item(16)
IF 17 < n THEN Find.CAPTION = .Item(17)
IF 18 < n THEN FindNext.CAPTION = .Item(18)
IF 19 < n THEN FindPrevious.CAPTION = .Item(19)
IF 20 < n THEN SelectAll.CAPTION = .Item(20)
IF 21 < n THEN DateTime.CAPTION = .Item(21)
IF 22 < n THEN Options.CAPTION = .Item(22)
IF 23 < n THEN Wrap.CAPTION = .Item(23)
IF 24 < n THEN FontDlg.CAPTION = .Item(24)
IF 25 < n THEN Font2Dlg.CAPTION = .Item(25)
IF 26 < n THEN Panel.CAPTION = .Item(26)
IF 27 < n THEN Info.CAPTION = .Item(27)
IF 28 < n THEN Help.CAPTION = .Item(28)
IF 29 < n THEN About.CAPTION = .Item(29)
IF 32 < n THEN SearchButton.CAPTION = .Item(32)
IF 33 < n THEN SaveButton.CAPTION = .Item(33)
IF 34 < n THEN OpenLabel.CAPTION = .Item(34)
IF 35 < n THEN DeleteBox.CAPTION = .Item(35)
IF 36 < n THEN MarkBox.CAPTION = .Item(36)
IF 37 < n THEN SearchBox.CAPTION = .Item(37)
IF 38 < n THEN FileType = .Item(38)
IF 39 < n THEN msg01 = .Item(39)
IF 40 < n THEN msg02 = .Item(40)
IF 41 < n THEN msg03 = .Item(41)
IF 42 < n THEN msg04 = .Item(42)
IF 43 < n THEN msg05 = .Item(43)
IF 44 < n THEN msg06 = .Item(44)
IF 45 < n THEN msg07 = .Item(45)
IF 46 < n THEN msg08 = .Item(46)
IF 47 < n THEN msg09 = .Item(47)
IF 48 < n THEN msg10 = .Item(48)
IF 49 < n THEN msg11 = .Item(49)
IF 50 < n THEN msg12 = .Item(50)
END WITH
END IF
END SUB
SUB InitApp
DIM pFile AS QFILESTREAM
DIM vList AS QSTRINGLIST
DIM n(4) AS INTEGER, i AS INTEGER
DIM str AS STRING
IF FILEEXISTS(fileCFG) THEN
WITH vList
.LoadFromFile(fileCFG)
i = .ItemCount
IF i = 1 THEN
str = .Item(0)
.Clear
FOR i = 1 TO TALLY(str, ",") + 1
.AddItems(FIELD$(str, ",", i))
NEXT
ELSE
WHILE 0 < i
i = i - 1
str = .Item(i)
.Item(i) = RIGHT$(str, LEN(str) - INSTR(str, ":"))
WEND
END IF
n(0) = VAL(.Item(0))
n(1) = VAL(.Item(1))
n(2) = VAL(.Item(2))
n(3) = VAL(.Item(3))
IF 0 <= n(0) AND 0 <= n(1) AND (n(1) + n(2)) <= Screen.Width AND (n(0) + n(3)) <= Screen.Height THEN
MainForm.Top = n(0)
MainForm.Left = n(1)
MainForm.Width = n(2)
MainForm.Height = n(3)
ELSE
MainForm.Center
END IF
IF 9 < .ItemCount THEN
Font.Size = VAL(.Item(4))
cf1.iPointSize = Font.Size * 10
IF 21 < .ItemCount THEN
Font.COLOR = VAL(.Item(5))
cf1.rgbColors = Font.COLOR
Font.Name = .Item(6)
lf1.lfFaceName = Font.Name & NULL
lf1.lfHeight = VAL(.Item(7))
lf1.lfWeight = VAL(.Item(8))
IF lf1.lfWeight = FW_BOLD THEN Font.AddStyles(fsBold)
i = VAL(.Item(9))
IF i AND 1 THEN
lf1.lfItalic = 1
Font.AddStyles(fsItalic)
END IF
IF i AND 2 THEN
lf1.lfUnderline = 1
Font.AddStyles(fsUnderline)
END IF
IF i AND 4 THEN
lf1.lfStrikeOut = 1
Font.AddStyles(fsStrikeOut)
END IF
Font2.Size = VAL(.Item(10))
cf2.iPointSize = Font2.Size * 10
Font2.COLOR = VAL(.Item(11))
cf2.rgbColors = Font2.COLOR
Font2.Name = .Item(12)
lf2.lfFaceName = Font2.Name & NULL
lf2.lfHeight = VAL(.Item(13))
lf2.lfWeight = VAL(.Item(14))
IF lf2.lfWeight = FW_BOLD THEN Font2.AddStyles(fsBold)
i = VAL(.Item(15))
IF i AND 1 THEN
lf2.lfItalic = 1
Font2.AddStyles(fsItalic)
END IF
IF i AND 2 THEN
lf2.lfUnderline = 1
Font2.AddStyles(fsUnderline)
END IF
IF i AND 4 THEN
lf2.lfStrikeOut = 1
Font2.AddStyles(fsStrikeOut)
END IF
Wrap.Checked = VAL(.Item(18))
i = 15
ELSE
Font2.Size = VAL(.Item(4))
cf2.iPointSize = Font2.Size * 10
Wrap.Checked = VAL(.Item(5))
i = 2
END IF
RichEdit.WordWrap = Wrap.Checked
ELSE
i = 0
END IF
Panel.Checked = VAL(.Item(4 + i))
About.Checked = VAL(.Item(5 + i))
DeleteBox.Checked = VAL(.Item(6 + i))
MarkBox.Checked = VAL(.Item(7 + i))
IF (11 + IIF(i = 15, 13, 0)) < .ItemCount THEN
SearchBox.Checked = VAL(.Item(8 + i))
i = i + 1
END IF
Language = .Item(8 + i)
END WITH
RichEdit.Font = Font
ELSE
IF FILEEXISTS(fileLNG) THEN
IF pFile.OPEN(fileLNG, fmOpenRead) THEN
str = pFile.ReadLine
pFile.CLOSE
ShowIntro(str)
END IF
END IF
RichEdit.Font = Font
RichEdit.SelectAll
RichEdit.SelAttributes = Font
LoadFile("")
WriteConfig
MainForm.Center
END IF
IF Language <> "E" THEN LoadLanguage
StatusBar.Panel(0).CAPTION = "1 : 1"
StatusBar.Panel(1).CAPTION = msg11
END SUB
New.CAPTION = "&New"
New.ShortCut = "CTRL+N"
New.OnClick = NewClick
OPEN.CAPTION = "&Open..."
OPEN.ShortCut = "CTRL+O"
OPEN.OnClick = OpenClick
Save.CAPTION = "&Save"
Save.ShortCut = "CTRL+S"
Save.OnClick = SaveClick
SaveAs.CAPTION = "Save &As..."
SaveAs.OnClick = SaveAsClick
OpenURL.CAPTION = ""
OpenURL.ShortCut = "ALT+ENTER"
OpenURL.Visible = False
OpenURL.OnClick = MenuOpen
Break1.CAPTION ="-"
ReOpen.CAPTION = "&Revert"
ReOpen.Enabled = False
ReOpen1.CAPTION = ""
ReOpen1.OnClick = Reopen1Click
ReOpen2.CAPTION = ""
ReOpen2.OnClick = Reopen2Click
ReOpen3.CAPTION = ""
ReOpen3.OnClick = Reopen3Click
Break2.CAPTION = "-"
PageSetup.CAPTION = "Page Se&tup..."
PageSetup.OnClick = PageSetupClick
PagePrint.CAPTION = "&Print"
PagePrint.ShortCut = "CTRL+P"
PagePrint.OnClick = PagePrintClick
Break3.CAPTION = "-"
ExitEditor.CAPTION = "E&xit"
ExitEditor.ShortCut = "ALT+F4"
ExitEditor.OnClick = ExitClick
File.CAPTION = "&File"
File.AddItems New, OPEN, Save, SaveAs, OpenURL, Break1, ReOpen, Break2, PageSetup, PagePrint, Break3, ExitEditor
Undo.CAPTION = ""
Undo.ShortCut = "CTRL+Z"
Undo.Visible = False
Cut.CAPTION = "Cu&t"
Cut.ShortCut = "CTRL+X"
Cut.OnClick = CutClick
Copy.CAPTION = "&Copy"
Copy.ShortCut = "CTRL+C"
Copy.OnClick = CopyClick
Paste.CAPTION = "&Paste"
Paste.ShortCut = "CTRL+V"
Paste.OnClick = PasteClick
Delete.CAPTION = "&Delete"
Delete.OnClick = DeleteClick
Break5.CAPTION = "-"
Find.CAPTION = "&Find..."
Find.ShortCut = "CTRL+F"
Find.OnClick = FindClick
FindNext.CAPTION = "Find &Next"
FindNext.ShortCut = "F3"
FindNext.Enabled = False
FindNext.OnClick = SearchNext
FindPrevious.CAPTION = "Find Pre&vious"
FindPrevious.ShortCut = "SHIFT+F3"
FindPrevious.Enabled = False
FindPrevious.OnClick = SearchPrev
Break6.CAPTION = "-"
SelectAll.CAPTION = "Select &All"
SelectAll.ShortCut = "CTRL+A"
SelectAll.OnClick = SelectAllClick
DateTime.CAPTION = "&Insert Date/Time"
DateTime.ShortCut = "F5"
DateTime.OnClick = DateTimeClick
Edit.CAPTION = "&Edit"
Edit.AddItems Undo, Cut, Copy, Paste, Delete, Break5, Find, FindNext, FindPrevious, Break6, SelectAll, DateTime
Wrap.CAPTION = "&Word Wrap"
Wrap.ShortCut = "CTRL+W"
Wrap.OnClick = ToggleWrap
FontDlg.CAPTION = "&Font..."
FontDlg.OnClick = FontDlgClick
Font2Dlg.CAPTION = "&URL Font..."
Font2Dlg.OnClick = Font2DlgClick
Break7.CAPTION = "-"
Panel.CAPTION = "&Settings..."
Panel.ShortCut = "F2"
Panel.OnClick = PanelClick
Options.CAPTION = "&Options"
Options.AddItems Wrap, FontDlg, Font2Dlg, Break7, Panel
Help.CAPTION = "&Help"
Help.ShortCut = "F1"
Help.OnClick = HelpClick
Break8.CAPTION = "-"
About.CAPTION = "&About"
About.OnClick = InfoClick
Info.CAPTION = "&?"
Info.AddItems Help, Break8, About
MainMenu.PARENT = MainForm
MainMenu.AddItems File, Edit, Options, Info
WITH MainPanel
.PARENT = MainForm
.Align = alClient
.BevelOuter = bvNone
.BevelWidth = 0
END WITH
WITH StatusBar
.PARENT = MainForm
.AddPanels "", "", ""
.Panel(0).Width = 100
.Panel(0).Alignment = taCenter
.Panel(1).Width = 120
.Panel(1).Alignment = taCenter
END WITH
WITH RichEdit
.PARENT = MainPanel
.Align = alClient
.ScrollBars = ssBoth
.PlainText = True
.WantTabs = True
.HideSelection = False
.OnKeyUp = RichKeyUp
.OnKeyDown = RichKeyDown
.OnMouseMove = MouseOver
.OnMouseDown = MouseOpen
.OnMouseUp = MouseUp
END WITH
WITH SubPanel
.PARENT = MainPanel
.Align = alBottom
.BevelOuter = bvNone
.BevelWidth = 0
.Height = 1
.OnMouseMove = OverReset
END WITH
SearchField.PARENT = SubPanel
SearchField.OnChange = SearchChange
SearchField.OnKeyPress = SearchKey
SearchButton.PARENT = SubPanel
SearchButton.CAPTION = "Search"
SearchButton.OnClick = SearchClick
SearchButton.OnKeyPress = FocusEdit
OpenLabel.PARENT = SubPanel
OpenLabel.CAPTION = "Open URLs with"
OpenBox.PARENT = SubPanel
OpenBox.Style = csDropDownList
SaveButton.PARENT = SubPanel
SaveButton.CAPTION = "Save"
SaveButton.OnClick = SaveButtonClick
SaveButton.OnKeyPress = FocusEdit
SearchBox.PARENT = SubPanel
SearchBox.CAPTION = "Match Case"
MarkBox.PARENT = SubPanel
MarkBox.CAPTION = "Colour Links"
MarkBox.Checked = True
MarkBox.OnClick = MarkOnClick
DeleteBox.PARENT = SubPanel
DeleteBox.CAPTION = "Backup to Recycle Bin"
AboutLabel1.PARENT = SubPanel
AboutLabel1.CAPTION = Title & " " & Version
AboutLabel2.PARENT = SubPanel
AboutLabel2.CAPTION = "(C) 2002/2003 Martin Wehner"
AboutLabel3.PARENT = SubPanel
AboutLabel3.CAPTION = "FREEWARE"
WITH AboutWWW
.PARENT = SubPanel
.CAPTION = "http://mitglied.lycos.de/maweso/"
.Height = 20
.Font = Font3
.OnMouseMove = OverWWW
.OnClick = OpenWWW
END WITH
WITH AboutMail
.PARENT = SubPanel
.CAPTION = "martin.wehner@firemail.de"
.Height = 20
.Font = Font3
.OnMouseMove = OverMail
.OnClick = OpenMail
END WITH
Application.Title = Title
MainForm.CAPTION = Title & " " & Version
MainForm.Height = 400
MainForm.Width = 600
MainForm.Top = (Screen.Height - MainForm.Height) SHR 1
MainForm.Left = (Screen.Width - MainForm.Width) SHR 1
InitApp
MainForm.OnClose = FormClose
MainForm.OnResize = FormResize
MainForm.WndProc = FormWndProc
MainForm.OnPaint = FormOnPaint
ReadConfig
ReadParams
DragAcceptFilesAPI(MainForm.Handle, 1)
SetWindowLongAPI(MainForm.Handle, GWL_HWNDPARENT, 0)
SetWindowLongAPI(Application.Handle, GWL_HWNDPARENT, MainForm.Handle)
MainForm.SHOWMODAL
|
|
搜索
论坛
Home
回顶部
g.yi.org Hits:0 Last modified:2013-06-19 07:59:18
