04-09-2025, 03:00 AM
Okay, this one is nice but it requires we make our background a hardware image as well as the form. We just switch the display order so the software (text) is always on top. We don't need a special cursor routine with this method, but we do need to move the text along with the form when changing its position (drag) on the screen.
Pete
Code: (Select All)
$Color:32
_DisplayOrder _Hardware , _Software ' Reverse the display order so our text always ends up on top.
_PaletteColor 0, 0 ' Makes the software background transparent.
Dim As _Bit FormOpen, HoverClose, sdw, tbr
Dim As Long t1, t2, t3, t4, img, TBar, TBarRed, imgbkgd
Dim As Integer FormType, ShdwTran, h, i, iw, ih
Dim As Integer FormL, FormT, FormW, FormH, yfld, xfld, fldlen, ytag, xtag
w = _Width: h = _Height
FormType = 0: FormOpen = -1
GoSub Form_Type
t1 = _NewImage(w * _FontWidth, h * _FontHeight, 32)
_Dest t1
Cls , _RGB32(255, 255, 255)
For a = 1 To h ' Draw colorful random characters to the screen.
Locate a, 1
For i = 1 To w
j = Int(Rnd * 7) + 1
k = Int(Rnd * 25) + 1
Select Case j
Case 1: Color Red, _RGB32(255, 255, 255)
Case 2: Color Green, _RGB32(255, 255, 255)
Case 3: Color Blue, _RGB32(255, 255, 255)
Case 4: Color Orange, _RGB32(255, 255, 255)
Case 5: Color Yellow, _RGB32(255, 255, 255)
Case 6: Color Gray, _RGB32(255, 255, 255)
Case 7: Color Black, _RGB32(255, 255, 255)
End Select
Print Chr$(k + 96);
Next
Next
imgbkgd = _CopyImage(t1, 33)
_FreeImage t1: t1 = 0
_Dest 0
title$ = "My Form" ' Start form here...
FormW = 31: FormH = 6 ' For dimensions.
GoSub Make_Form
FormT = 9 ' Top of form (not including any title bar) at row 9.
FormL = 27 ' Left of form at row 27.
Color 15, 0 ' White on black text color.
Locate yfld + (FormT - 1), xfld + (FormL - 1): Print Space$(fldlen + 1); ' Input field.
Locate yfld + (FormT - 1), xfld + (FormL - 1)
Color 15, 0
If FormOpen Then GoSub Show_Text
Do
_Limit 60
_PutImage (0, 0), imgbkgd
If FormOpen Then
_PutImage ((FormL - 1) * fw, (FormT - 1 + tbr) * fh), img
If drag = 0 And tbr Then ' Only check for hover on x close when form is stationary.
If my = FormT + tbr And mx >= FormL + FormW - 2 And mx <= FormL + FormW Then
_PutImage ((FormL - 1) * fw, (FormT - 2) * fh), TBarRed
If Not HoverClose Then HoverClose = Not HoverClose
Else
If HoverClose Then HoverClose = Not HoverClose
End If
End If
End If
While _MouseInput: Wend
mx = _MouseX
my = _MouseY
lb = _MouseButton(1)
b$ = InKey$
If FormOpen Then
If tbr Then
If lb Then ' Mouse actions on Form.
If HoverClose Then
FormOpen = Not FormOpen ' Left click on 'X' hover closed the form.
GoSub Close_Form
End If
If my = FormT - 1 And drag = 0 Then ' Mouse cursor at tile bar level.
If mx >= FormL And mx <= FormL + FormW - 3 Then ' Mouse cursor within title bar.
drag = mx - FormL
End If
End If
Else
If drag Then ' Drag event completed.
drag = 0
End If
End If
If drag Then ' Mouse drag to move our form.
If mx <> oldmx Or my <> oldmy Then
m1 = my - FormT - tbr: m2 = mx - (FormL + drag) ' Drag direction.
If FormT + tbr + m1 < 1 Or FormT - 1 + FormH - sdw + m1 > _Height Then m1 = 0 ' Remember sdw is -1 when a shadow is present.
If FormL + m2 < 1 Or FormL - 1 + FormW + m2 - sdw * 2 > _Width Then m2 = 0 ' + 2 Allows for right side shadow.
If m1 + m2 Then
_PutImage (0, 0), imgbkgd
Cls 2
FormT = FormT + m1: FormL = FormL + m2 ' A change in either m1 or m2 will cause the text field to be re-positioned to the new form coordinates.
_PutImage ((FormL - 1) * fw, (FormT - 1 + tbr) * fh), img
Locate yfld + (FormT - 1), xfld + (FormL - 1): Print text$; ' Move input text.
End If
End If
End If
End If
If Len(b$) Then ' Keyboard when form is open.
Select Case b$
Case Chr$(0) + "R" ' Insert key.
CurApr` = Not CurApr`
Case Chr$(9) ' Form toggle.
FormOpen = Not FormOpen
If FormOpen Then
GoSub Show_Text
Else
GoSub Close_Form
End If
Case Chr$(27)
FormOpen = Not FormOpen: GoSub Close_Form ' Closes the form.
Case Chr$(8) ' Backspace
If Len(text$) Then
text$ = Mid$(text$, 1, Len(text$) - 1)
ccp% = ccp% - 1
GoSub Show_Text
End If
Case " " To "z" ' Allowed text characters.
If Len(text$) < fldlen Then
text$ = text$ + b$
ccp% = ccp% + 1
GoSub Show_Text
End If
Case Chr$(0) + "H" ' Arrow up.
If FormT + tbr > 1 Then ' Set top boundary with or without title bar.
m1 = -1: m2 = 0: GoSub FormMove
End If
Case Chr$(0) + "P" ' Arrow down.
If FormT - 1 + FormH - sdw < _Height Then ' Set bottom boundary with or without shadow.
m1 = 1: m2 = 0: GoSub FormMove
End If
Case Chr$(0) + "K" ' Arrow left.
If FormL > 1 Then ' Set left boundary.
m1 = 0: m2 = -1: GoSub FormMove
End If
Case Chr$(0) + "M" ' Arrow right.
If FormL - 1 + FormW - sdw * 2 < _Width Then ' Set right boundary with or without shadow.
m1 = 0: m2 = 1: GoSub FormMove
End If
Case Chr$(0) + Chr$(59) ' F1
If FormType <> 0 Then FormType = 0: GoSub Form_Type: GoSub Make_Form
Case Chr$(0) + Chr$(60) ' F2
If FormType <> 1 Then FormType = 1: GoSub Form_Type: GoSub Make_Form
Case Chr$(0) + Chr$(61) ' F3
If FormType <> 2 Then FormType = 2: GoSub Form_Type: GoSub Make_Form
Case Chr$(0) + Chr$(62) ' F4
If FormType <> 3 Then FormType = 3: GoSub Form_Type: GoSub Make_Form
End Select
End If
Else
Select Case b$ ' Keys in use when a form is not present.
Case Chr$(9) ' Form toggle.
FormOpen = Not FormOpen
If FormOpen Then
GoSub Show_Text
Else
GoSub Close_Form
End If
Case Chr$(27): System
End Select
End If
oldmy = my: oldmx = mx ' Tracks prior mouse position.
_Display ' Show screen changes here.
Loop
Form_Type:
Select Case FormType
Case 0: tbr = -1: sdw = -1 ' Title bar and shadow.
Case 1: tbr = -1: sdw = 0 ' Title bar and no shadow.
Case 2: tbr = 0: sdw = -1 ' No title bar and shadow.
Case 3: tbr = 0: sdw = 0 ' No title bar and no shadow.
End Select
Return
Make_Form:
ShdwTran = 90 ' Shadow transparency (0 - 255) 0 = Transparent.
fw = _FontWidth: fh = _FontHeight
iw = FormW * fw ' Image width.
ih = FormH * fh ' Image height.
ytag = 4 ' Text field tag row.
xtag = 3 ' Text field tag column.
yfld = ytag ' Text input field row. Same as the tag.
xfld = 9 ' Text field column.
fldlen = 20 ' Text input field length.
t1 = _NewImage(fldlen * fw + fw, fh, 32)
If tbr = -1 And sdw = -1 Then
t2 = _NewImage(iw + 2 * fw, ih + fh, 32) ' Form with title bar and shadow.
ElseIf tbr And sdw = 0 Then
t2 = _NewImage(iw, ih + fh, 32) ' Form and title bar.
ElseIf tbr = 0 And sdw Then ' Form and shadow.
t2 = _NewImage(iw + 2 * fw, ih + fh, 32)
Else
t2 = _NewImage(iw, ih, 32) ' Form only.
End If
_Dest t2
Color _RGB32(90, 90, 90) ' Form color.
For h = 1 To FormH ' Makes a solid form without input fields.
Locate h, 1
For i = 1 To FormW
Print Chr$(219);
Next
Next
Color White, _RGB(90, 90, 90) ' Add text to the form and outline the input box.
If Len(title$) Then Locate 2 + (1 - 1), FormW \ 2 - Len(title$) \ 2 + 1: Print title$;
Locate ytag + (1 - 1), xtag: Print "Text:"
Line ((fw + (1 - 1)) * (xfld - 1) - 3, (fh + (1 - 1)) * (yfld - 1) - 3)-((fw + (1 - 1)) * (xfld + fldlen) + 2, (fh + (1 - 1)) * yfld + 2), _RGB32(255, 255, 255), B ' Outline around input field.
If sdw Then Line ((1 + FormW - 1) * fw, (1 + 1 - 1) * fw)-((1 + FormW + 1) * fw, (1 + FormH) * fh), _RGBA32(0, 0, 0, ShdwTran), BF ' Shadow right side.
If sdw Then Line (2 * fw, (1 + FormH - 1) * fh)-(FormW * fw - 1, 1 + (1 + FormH) * fh), _RGBA32(0, 0, 0, ShdwTran), BF ' Shadow bottom.
Color White, Black ' White on black text.
Locate yfld, xfld: Print Space$(fldlen + 1);
Locate yfld, xfld: Print text$;
If tbr Then
GoSub Title_Bar: img = _CopyImage(t4, 33): _FreeImage t4: t4 = 0 ' Free screen t4 and zero the handle.
Else
img = _CopyImage(t2, 33)
End If
_FreeImage t2: t2 = 0 ' Free screen t2 and zero the handle.
_Dest 0 ' Back to Screen 0.
Return
Title_Bar:
t3 = _NewImage(iw, fh, 32) ' Creates a dragable title bar on this screen.
_Dest t3
For j = 1 To 2
Cls , _RGB32(0, 0, 255) ' Title bar background is solid blue.
For i = fh - 2 To 0 Step -1 ' Use this loop to create a progressive lightening of the blue color in each line color statement...
Line (0, 0)-(iw, i + 1), _RGBA32(255, 255, 255, 0 + i * 14), B
Next
If j = 1 Then ' The first loop creates a title bar with a red box around the 'X' close symbol to be displayed on mouse hove.
xcolor& = White: xcolorbg& = DarkRed ' White 'X' symbol on dark red square.
Line (iw - fw * 2 + 0, 1)-(iw - fw * 2 + fw * 2, fh - 1), xcolorbg&, BF ' Adds a red box for our 'X' symbol.
Else
xcolor& = Black ' Black 'X' symbol on title bar background.
End If
Line (iw - fw * 2 + 0 + 4, 0 + 4)-(iw - fw * 2 + 0 + fw * 2 - 4, 0 + fh - 4), xcolor& ' These two diagonal lines make out 'X' symbol.
Line (iw - fw * 2 + 0 + 4, 0 + fh - 4)-(iw - fw * 2 + 0 + fw * 2 - 4, 0 + 4), xcolor&
If j = 1 Then ' Time to copy the image of the title bar with the red box around the 'X' symbol.
If TBarRed Then _FreeImage TBarRed: TBarRed = 0
TBarRed = _CopyImage(t3, 33)
Else ' Copy the image of the title bar without the red box. This is now the image that remains on screen t3 to be copied in then next routine.
TBar = _CopyImage(t3, 33)
End If
Next
If tbr = -1 And sdw = -1 Then ' Screen for combining the title bar and form images. This first condition set the screen size to accommodate a shadow effect.
t4 = _NewImage(iw + 2 * fw, ih + 2 * fh, 32) ' Form with title bar and shadow.
ElseIf tbr And sdw = 0 Then
t4 = _NewImage(iw, ih + fh + 2 * fh, 32) ' Form and title bar with no shadow screen.
End If
_Dest t4
_PutImage (0, 0), t3 ' Places the image that remains on screen t3 to the top of screen t4.
_PutImage (0, fh), t2
_FreeImage TBar: TBar = 0 ' Free the title bar image because it was combined with the form, but we will keep the title bar with red 'x' box in memory for hover events.
_FreeImage t3: t3 = 0 ' Free screen t3 and zero the handle.
Return ' Note: We will get back to screen 0 destination and free t4 back in the calling routine.
FormMove:
Cls 2
FormT = FormT + m1: FormL = FormL + m2 ' Change form cordernates.
Locate yfld + (FormT - 1), xfld + (FormL - 1): Print Space$(fldlen + 1); ' Move input slot.
Locate yfld + (FormT - 1), xfld + (FormL - 1): Print text$; ' Move input text.
Locate FormT - 1 + yfld, FormL - 1 + xfld + ccp% ' Reposition cursor.
Return
Show_Text:
tmp$ = Space$(fldlen)
Mid$(tmp$, 1) = text$
Locate FormT - 1 + yfld, FormL - 1 + xfld, 0: Print tmp$;
Locate FormT - 1 + yfld, FormL - 1 + xfld + ccp%, 1
Return
Close_Form:
Cls 2
text$ = ""
ccp% = 0
Locate , , 0
ReturnPete