SUB RepaintCanvas
'Redraw the history canvas...
Canvas.Draw(0,0,Buffer.BMP)
END SUB
FUNCTION BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
'Select a folder... with Windows API...
'declare variables to be used
DIM iNull As Integer
DIM lpIDList As Long
DIM lResult As Long
DIM sPath As String
DIM udtBI As BrowseInfo
'initialise variables
WITH udtBI
.hwndOwner = hwndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
END WITH
'Call the browse for folder API
lpIDList = SHBrowseForFolder(udtBI)
'get the resulting string path
IF lpIDList THEN
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
CALL CoTaskMemFree(lpIDList)
iNull = InStr(sPath, chr$(0))
IF iNull THEN sPath = Left$(sPath, iNull - 1)
END IF
'If cancel was pressed, sPath = ""
BrowseForFolder = sPath
END FUNCTION
FUNCTION CMessageBox(Message$ AS STRING, MessageType AS INTEGER, Buttons AS INTEGER) AS INTEGER
'First, pick header...
SELECT CASE MessageType
CASE bmMessage
CMBXImgTop.BMPHandle = CMBX_Message
CASE bmWarning
CMBXImgTop.BMPHandle = CMBX_Warning
CASE bmError
CMBXImgTop.BMPHandle = CMBX_Error
END SELECT
'Make the header look right...
CMBXImgTop.Line(0,0,0,25,&H000000)
CMBXImgTop.Line(1,0,1,25,&H000000)
CMBXImgTop.Line(399,0,399,25,&H000000)
CMBXImgTop.Line(398,0,398,25,&H000000)
'Then show the message...
CMBXLabel.Caption = Message$
'Lastly, finalise the buttons...
CMBXOKBTN.Visible = False
CMBXYesBTN.Visible = False
CMBXNoBTN.Visible = False
CMBXCancelBTN.Visible = False
SELECT CASE Buttons
CASE btOk
CMBXOKBTN.Left = INT((CMBXForm.Width - CMBXOKBTN.Width) / 2)
CMBXOKBTN.Top = CMBXForm.Height - (CMBXOKBTN.Height + 5)
CMBXOKBTN.Visible = True
CASE btOkCancel
CMBXOKBTN.Left = INT((CMBXForm.Width - (CMBXOKBTN.Width + 2)) / 2)
CMBXOKBTN.Top = CMBXForm.Height - (CMBXOKBTN.Height + 5)
CMBXOKBTN.Visible = True
CMBXCancelBtn.Visible = True
CMBXCancelBtn.Left = (0.5 * CMBXForm.Width) + 2
CMBXCancelBtn.Top = CMBXForm.Height - (CMBXCancelBTN.Height + 5)
CASE btYesNo
CMBXYesBtn.Left = INT((0.5 * CMBXForm.Width) - (CMBXYesBTN.Width + 2))
CMBXYesBtn.Top = CMBXForm.Height - (CMBXYesBTN.Height + 5)
CMBXYesBtn.Visible = True
CMBXNoBtn.Visible = True
CMBXNoBtn.Left = (0.5 * CMBXForm.Width) + 2
CMBXNoBtn.Top = CMBXForm.Height - (CMBXNoBTN.Height + 5)
CASE btYesNoCancel
CMBXYesBtn.Left = INT((CMBXForm.Width - (CMBXYesBtn.Width + (0.5 * CMBXNoBtn) + 5)) / 2)
CMBXYesBtn.Top = CMBXForm.Height - (CMBXYesBTN.Height + 5)
CMBXYesBtn.Visible = True
CMBXNoBtn.Left = INT((CMBXForm.Width - (0.5 * CMBXNoBtn.Width)) / 2)
CMBXNoBtn.Top = CMBXForm.Height - (CMBXNoBTN.Height + 5)
CMBXCancelBtn.Left = INT((0.5 * CMBXForm.Width) + (0.5 * CMBXNoBtn.Width) + 5)
CMBXCancelBtn.Top = CMBXForm.Height - (CMBXCancelBTN.Height + 5)
CMBXCancelBtn.Visible = True
END SELECT
'Display the form...
CMBXForm.Center
CMBXForm.Show
CMBXForm.Repaint
'Wait for response...
DO
DoEvents
LOOP UNTIL CMBXForm.Visible = False
'Return the modal result of the button pressed...
CMessageBox = CMBXReturnVal
END FUNCTION
SUB CMBXBtnClick(Sender AS QButton)
'Return the tag of the sender.
'The tag is already set to the modal result of the button.
CMBXReturnVal = Sender.Tag
CMBXForm.Visible = False
END SUB
SUB StartMoveCMBXForm(Button%,X%,Y%,Shift%)
'Tag and get ready to move the form!
IF Button% = 0 THEN
FormMoving = True
MouseLastX = X%
MouseLastY = Y%
END IF
END SUB
SUB MoveCMBXForm(X%, Y%, Shift%)
'Do the actuall move of the custom form...
IF Moving = True THEN
EXIT SUB
END IF
Moving = True
IF FormMoving = True THEN
Dummy = -(MouseLastX - X%)
Dummy2 = -(MouseLastY - Y%)
CMBXForm.Top = CMBXForm.Top + Dummy2
CMBXForm.Left = CMBXForm.Left + Dummy
END IF
Moving = False
END SUB
SUB StopMoveCMBXForm(Button%, X%, Y%, Shift%)
'Time to stop (ie. release mouse button)
FormMoving = False
END SUB
SUB DrawFormBorder(Sender AS QForm)
'Select the form header to use...
SELECT CASE Sender.Hint
CASE "1"
TopImg.BMPHandle = BFTop
CASE "2"
TopImg.BMPHandle = BETop
CASE "3"
TopImg.BMPHandle = IFTop
CASE "4"
TopImg.BMPHandle = SFTop
CASE "5"
TopImg.BMPHandle = OPTop
CASE "6"
TopImg.BMPHandle = ABTop
END SELECT
'Draw the header...
Sender.Draw(0,0,TopImg.BMP)
'Draw a black border on the form...
Sender.Line(0,0,0,Sender.Height-1,&H000000)
Sender.Line(1,0,1,Sender.Height-1,&H000000)
Sender.Line(0,Sender.Height-1,Sender.Width-1,Sender.Height-1,&H000000)
Sender.Line(0,Sender.Height-2,Sender.Width-1,Sender.Height-2,&H000000)
Sender.Line(Sender.Width-1,Sender.Height-1,Sender.Width-1,0,&H000000)
Sender.Line(Sender.Width-2,Sender.Height-1,Sender.Width-2,0,&H000000)
END SUB
SUB ExitProgram
'Exit the program, save options, etc...
IF Command$(1) = "" THEN
'Save as default file...
IF FileExists(BaseDir$ + "default.cfw") THEN
SaveFile(BaseDir$ + "default.cfw")
ELSE
Files.Open(BaseDir$ + "default.cfw",fmCreate)
Files.Close
SaveFile(BaseDir$ + "default.cfw")
END IF
ELSE
SaveFile(Command$(1))
END IF
IF TrayIcon = True THEN
'Remove tray icon...
Shell_NotifyIcon(NIM_DELETE, NI)
END IF
UnRegisterHotKey (Form.Handle, 0)
Application.Terminate
END SUB
SUB ShowOptions
'Set the options, then show the form...
CMsgColLbl.Font.Color = Options.CommandMsgColour
RMsgColLbl.Font.Color = Options.ReturnedMsgColour
BGColLbl.Font.Color = Options.CLIBackColour
FGColLbl.Font.Color = Options.CLIForeColour
'Populate the font box...
FOR Dummy = 0 TO TheFont.FontCount-1
FontCombo.AddItems(TheFont.FontName(Dummy))
IF TheFont.FontName(Dummy) = RTRIM$(Options.Font) THEN
Dummy2 = Dummy
END IF
NEXT Dummy
FontCombo.ItemIndex = Dummy2
'More options...
FontSizeLabel.Caption = "Font size = "+STR$(Options.FontSize)+" pts"
FontSizeTrack.Position = Options.FontSize
FontPrevLabel.Font.Name = RTRIM$(Options.Font)
FontPrevLabel.Font.Size = Options.FontSize
PicFileBox.Text = RTRIM$(Options.BackGroundImage)
SELECT CASE Options.HowToShow
CASE sTile
SHRB1.Checked = True
CASE sStretch
SHRB2.Checked = True
CASE sCenter
SHRB3.Checked = True
END SELECT
BackColLbl.Font.Color = Options.BackGroundColour
DropPixLbl.Caption = "Drop "+STR$(Options.DropPercentScreen)+" pixels:"
DropSpeedLbl.Caption = "Drop speed: "+STR$(Options.DropPixelsPerIteration)
DropPixTrack.Min = 50
DropPixTrack.Max = Screen.Height
DropPixTrack.Position = Options.DropPercentScreen
DropSpeedTrack.Min = 1
DropSpeedTrack.Max = Options.DropPercentScreen
DropSpeedTrack.Position = Options.DropPixelsPerIteration
CTRLCheck.Checked = Options.KeyModCTRL
ALTCheck.Checked = Options.KeyModALT
SHIFTCheck.Checked = Options.KeyModSHIFT
HotKeyBox.Text = Options.Key
AutoFillBox.Checked = Options.AutoFillIn
ShTrayIcon.Checked = Options.ShowTrayIcon
SwapEnterSpace.Checked = Options.SwapEnterForSpace
ShowOnStart.Checked = Options.ShowOnStartup
ConfirmExitCheck.Checked = Options.ConfirmExit
ConfirmShutdownCheck.Checked = Options.ConfirmShutdown
'Done, show the form...
OptionsForm.Show
OptionsForm.Repaint
END SUB
SUB AcceptOptions
'Save all the options... Check errors first...
IF FileExists(PicFileBox.Text) THEN
'All is fine and dandy.
Options.BackGroundImage = PicFileBox.Text
ELSE
'Oh dear!
CMessageBox("Well, well, well. It seems that the filename in the picture file box points to a non-existant file! Please change this, so we can get on with setting all the options.",bmError,btOk)
EXIT SUB
END IF
IF (SHIFTCheck.Checked = True) AND (CTRLCheck.Checked = False) AND (ALTCheck.Checked = False) THEN
IF CMessageBox("This may just be a small error, but you can not, unfortunately, just use SHIFT plus another key as the hotkey. Just imagine it: your typing away happily in your word processor, and you start a sentence, 'It was a marvelous day...' If the key is I, then you wouldn't get to the 't'. So: click 'YES' to select the CTRL key as well, or click 'NO' to select the ALT key.",bmError,btYesNo) = mrYes THEN
CTRLCheck.Checked = True
EXIT SUB
ELSE
ALTCheck.Checked = True
EXIT SUB
END IF
END IF
IF (SHIFTCheck.Checked = False) AND (CTRLCheck.Checked = True) AND (ALTCheck.Checked = False) THEN
CMessageBox("As much as it may be nice to only use one special key and another key to make up the hotkey, I can't let you do this. Well, maybe I can. Yes, you can, but please be aware that this may cause conflicts with other programs. Don't use hotkeys like CTRL+C, CTRL+V, or other such hotkeys. You may proceed, however.",bmError,btOk)
END IF
IF (SHIFTCheck.Checked = False) AND (CTRLCheck.Checked = False) AND (ALTCheck.Checked = True) THEN
CMessageBox("As much as it may be nice to only use one special key and another key to make up the hotkey, I can't let you do this. Well, maybe I can. Yes, you can, but please be aware that this may cause conflicts with other programs. Don't use hotkeys like CTRL+C, CTRL+V, or other such hotkeys. You may proceed, however.",bmError,btOk)
END IF
IF HotKeyBox.Text = "" THEN
CMessageBox("Hey! What are you trying to do? You need to have a key to go with the special keys to make the hotkey work! Please enter a key!",bmError,btOk)
EXIT SUB
END IF
'Check to see if hotkey has changed...
Dummy = False
Dummy2 = False
Dummy3 = False
Dummy4 = False
IF (CTRLCheck.Checked = Options.KeyModCTRL) THEN Dummy = True
IF (ALTCheck.Checked = Options.KeyModALT) THEN Dummy2 = True
IF (SHIFTCheck.Checked = Options.KeyModSHIFT) THEN Dummy3 = True
IF (HotKeyBox.Text = Options.Key) THEN Dummy4 = True
IF (Dummy = False) XOR (Dummy2 = False) XOR (Dummy3 = False) XOR (Dummy4 = False) THEN
CMessageBox("You have changed the hotkey. To make it take effect, please close this program and restart it. However, make sure you remember the hotkey, otherwise you won't be able to bring down the console!!",bmError,btOk)
END IF
'Tray icons...
IF (TrayIcon = True) AND (ShTrayIcon.Checked = False) THEN
'Remove tray icon...
Shell_NotifyIcon(NIM_DELETE, NI)
TrayIcon = False
END IF
IF (TrayIcon = False) AND (ShTrayIcon.Checked = True) THEN
'Add tray icon...
Shell_NotifyIcon(NIM_ADD, NI)
TrayIcon = True
END IF
Options.Font = FontCombo.Item(FontCombo.ItemIndex)
Options.FontSize = FontSizeTrack.Position
IF SHRB1.Checked = True THEN Options.HowToShow = sTile
IF SHRB2.Checked = True THEN Options.HowToShow = sStretch
IF SHRB3.Checked = True THEN Options.HowToShow = sCenter
Options.DropPercentScreen = DropPixTrack.Position
Options.DropPixelsPerIteration = DropSpeedTrack.Position
Options.KeyModCTRL = CTRLCheck.Checked
Options.KeyModALT = ALTCheck.Checked
Options.KeyModSHIFT = SHIFTCheck.Checked
Options.Key = HotKeyBox.Text
Options.AutoFillIn = AutoFillBox.Checked
Options.ShowTrayIcon = ShTrayIcon.Checked
Options.SwapEnterForSpace = SwapEnterSpace.Checked
Options.ShowOnStartup = ShowOnStart.Checked
Options.ConfirmExit = ConfirmExitCheck.Checked
Options.ConfirmShutdown = ConfirmShutdownCheck.Checked
Buffer.Font.Name = RTRIM$(Options.Font)
Buffer.Font.Size = Options.FontSize
CLI.Font.Name = RTRIM$(Options.Font)
CLI.Font.Size = Options.FontSize
CLI.Color = Options.CLIBackColour
CLI.Font.Color = Options.CLIForeColour
Image.Handle = NViewLibLoad(RTRIM$(Options.BackGroundImage),0)
Image.Tag = 0
Form.Height = Options.DropPercentScreen
'Reclaim some memory.
UNLOADLIBRARY "NVIEWLIB"
UNLOADLIBRARY "COMDLG32"
'Done! Hide the form...
OptionsForm.Visible = False
AnimateDown
AddHistory("Options successfully changed.",hReturn)
END SUB
SUB CancelOptions
OptionsForm.Visible = False
AnimateDown
END SUB
SUB UpdateTracks(Sender AS QTrackBar)
'Update the trackbar data on the options form...
SELECT CASE Sender.Hint
CASE "1"
'Font size...
FontSizeLabel.Caption = "Font size = "+STR$(FontSizeTrack.Position)+" pts"
ChangePrevFont
FontPrevLabel.Alignment = 2
FontPrevLabel.Layout = 1
CASE "2"
DropPixLbl.Caption = "Drop "+STR$(DropPixTrack.Position)+" pixels:"
DropSpeedTrack.Max = DropPixTrack.Position
DropSpeedLbl.Caption = "Drop speed: "+STR$(DropSpeedTrack.Position)
FontPrevLabel.Alignment = 2
FontPrevLabel.Layout = 1
CASE "3"
DropSpeedLbl.Caption = "Drop speed: "+STR$(DropSpeedTrack.Position)
FontPrevLabel.Alignment = 2
FontPrevLabel.Layout = 1
END SELECT
END SUB
SUB ChangePrevFont
'Update the font preview...
FontPrevLabel.Font.Name = FontCombo.Item(FontCombo.ItemIndex)
FontPrevLabel.Font.Size = FontSizeTrack.Position
END SUB
SUB ChooseSomething(Sender AS QButton)
'A 'Choose' button was selected on the options form.
'So choose something!!
DIM RetVal AS LONG
CC.lStructSize = SIZEOF(CC)
CC.hWndOwner = OptionsForm.Handle
'CC.Flags = CC_RGBINIT + CC_FULLOPEN
CC.Flags = CC_RGBINIT
SELECT CASE Sender.Tag
CASE 1
'Colour...
CC.rgbResult = Options.CommandMsgColour
RetVal = ChooseColorDlg(CC)
IF RetVal <> 0 THEN
Options.CommandMsgColour = CC.rgbResult
CMsgColLbl.Font.Color = CC.rgbResult
END IF
CASE 2
CC.rgbResult = Options.ReturnedMsgColour
RetVal = ChooseColorDlg(CC)
IF RetVal <> 0 THEN
Options.ReturnedMsgColour = CC.rgbResult
RMsgColLbl.Font.Color = CC.rgbResult
END IF
CASE 3
CC.rgbResult = Options.CLIBackColour
RetVal = ChooseColorDlg(CC)
IF RetVal <> 0 THEN
Options.CLIBackColour = CC.rgbResult
BGColLbl.Font.Color = CC.rgbResult
END IF
CASE 4
CC.rgbResult = Options.CLIForeColour
RetVal = ChooseColorDlg(CC)
IF RetVal <> 0 THEN
Options.CLIForeColour = CC.rgbResult
FGColLbl.Font.Color = CC.rgbResult
END IF
CASE 5
OpenDlg.Filter = "Picture files (*.bmp,*.gif,*.jpg,*.pcx)|*.bmp;*.gif;*.jp*;*.pcx|All files (*.*)|*.*"
OpenDlg.FilterIndex = 1
OpenDlg.Caption = "Choose your cool picture..."
IF OpenDlg.Execute THEN
PicFileBox.Text = OpenDlg.FileName
END IF
CASE 6
CC.rgbResult = Options.BackGroundColour
RetVal = ChooseColorDlg(CC)
IF RetVal <> 0 THEN
Options.BackGroundColour = CC.rgbResult
BackColLbl.Font.Color = CC.rgbResult
END IF
END SELECT
END SUB
SUB PopulateCPanelList(List AS INTEGER)
DIM PopDum AS INTEGER
IF List = 1 THEN
'Do bind form...
AppletComboBox.Clear
FOR PopDum = 1 TO CPTot
AppletComboBox.AddItems(RTRIM$(CPanels(PopDum).Name))
AppletComboBox.ItemIndex = 0
NEXT PopDum
END IF
IF List = 2 THEN
AppletChCombo.Clear
FOR PopDum = 1 TO CPTot
AppletChCombo.AddItems(RTRIM$(CPanels(PopDum).Name))
NEXT PopDum
END IF
END SUB
SUB HideForm
'Hide the form after 200 milliseconds...
HideTimer.Enabled = False
IF Options.ShowOnStartup = True THEN
'Ok, show the Console...
AnimateDown
ELSE
'Hide the console...
Form.Visible = False
END IF
END SUB
SUB SplitString(Stringy$ AS STRING)
DIM SSDummy AS INTEGER
'Chop up the supplied string. Results returned in Commands$ array...
'Break up the segments based on spaces...
'Clear the array...
FOR SSDummy = 1 TO 20
Commands$(SSDummy) = ""
NEXT SSDummy
'Break it!
PNoParams = 1
FOR SSDummy = 1 TO LEN(Stringy$)
'Read a character
PCharDummy$ = MID$(Stringy$,SSDummy,1)
'Is it a quotation mark?
IF PCharDummy$ = CHR$(34) THEN
IF PQuoteOpen = True THEN
PQuoteOpen = False
ELSE
PQuoteOpen = True
END IF
PDoneSomething = True
END IF
'Is it a space?
IF (PCharDummy$ = CHR$(32)) AND (PQuoteOpen = False) THEN
PNoParams = PNoParams + 1
PDoneSomeThing = True
END IF
'Can we add it or what?
IF PDoneSomeThing = False THEN
Commands$(PNoParams) = Commands$(PNoParams) + PCharDummy$
END IF
PDoneSomeThing = False
NEXT SSDummy
END SUB
SUB ShowAbout
AboutForm.Show
END SUB
SUB CloseAbout
AboutForm.Visible = False
AnimateDown
END SUB
SUB TrayExit
'Confirm, then exit. We are quiting from the system tray.
IF CMessageBox("Hey! Are you sure you want to quit this program?",bmWarning,btYesNo) = mrYes THEN
'Exit...
ExitProgram
END IF
END SUB
SUB TrayShow
IF ConsoleState = cUp THEN
LastWindow = 0
SetForeGroundWindow(Form.Handle)
AnimateDown
ELSE
AnimateUp
END IF
END SUB
FUNCTION Commarise$(InputNum AS INTEGER) AS STRING
'Add some commas at every third place. Fun!
'Ok, begin by ripping the number apart.
CMRSString$ = STR$(InputNum)
FOR CMRSDummy = 1 TO 50
CMRSArray$(CMRSDummy) = ""
NEXT CMRSDummy
FOR CMRSDummy = 1 TO LEN(CMRSString$)
CMRSArray$(CMRSDummy) = MID$(CMRSString$,CMRSDummy,1)
NEXT CMRSDummy
'Then, reconstruct the final string.
CMRSDummy3 = 0
CMRSFinalString$ = ""
FOR CMRSDummy = LEN(CMRSString$) TO 1 STEP -1
IF CMRSDummy3 = 3 THEN
CMRSFinalString$ = CMRSArray$(CMRSDummy) + "," + CMRSFinalString$
CMRSDummy3 = 0
ELSE
CMRSFinalString$ = CMRSArray$(CMRSDummy) + CMRSFinalString$
END IF
CMRSDummy3 = CMRSDummy3 + 1
NEXT CMRSDummy
Commarise$ = CMRSFinalString$
END FUNCTION
FUNCTION CmStr$(Inputst$ AS STRING) AS STRING
'Ok, begin by ripping the number apart.
FOR CMRSDummy = 1 TO 50
CMRSArray$(CMRSDummy) = " "
NEXT CMRSDummy
FOR CMRSDummy = 1 TO LEN(Inputst$)
CMRSArray$(CMRSDummy) = MID$(Inputst$,CMRSDummy,1)
NEXT CMRSDummy
'Then, reconstruct the final string.
CMRSDummy3 = 0
CMRSFinalString$ = " "
CMRSFinalString$ = ""
FOR CMRSDummy = LEN(Inputst$) TO 1 STEP -1
IF CMRSDummy3 = 3 THEN
CMRSFinalString$ = CMRSArray$(CMRSDummy) + "," + CMRSFinalString$
CMRSDummy3 = 0
ELSE
CMRSFinalString$ = CMRSArray$(CMRSDummy) + CMRSFinalString$
END IF
CMRSDummy3 = CMRSDummy3 + 1
NEXT CMRSDummy
CmStr$ = CMRSFinalString$
END FUNCTION
SUB StartMoveForm(Button%,X%,Y%,Shift%,Sender AS QForm)
'Should we be left clicking (and holding down), simply start
'moving the form...
'Just tag the location of the mouse cursor for the moment, after
'checking if it's in the drag area...
IF (Button% = 0) AND (Y% < 26) THEN
FormMoving = True
MouseLastX = X%
MouseLastY = Y%
END IF
END SUB
SUB MoveForm(X%, Y%, Shift%,Sender AS QForm)
'Actually move the form, based on where the mouse is
'in relation to where it was when you started moving
'the form. Simple... really...
'Just a tag so that we don't try and move as we
'are moving... a disasterous situation... I think?
IF Moving = True THEN
EXIT SUB
END IF
Moving = True
IF FormMoving = True THEN
Dummy = -(MouseLastX - X%)
Dummy2 = -(MouseLastY - Y%)
'Move the form...
Sender.Top = Sender.Top + Dummy2
Sender.Left = Sender.Left + Dummy
END IF
Moving = False
END SUB
SUB StopMoveForm(Button%, X%, Y%, Shift%,Sender AS QForm)
'Time to stop (ie. release mouse button)
FormMoving = False
END SUB
SUB CheckRightClickOnCanvas(Button%, X%, Y%, Shift%)
IF Button% = 1 THEN
ProcCmd2
END IF
END SUB