It uses a full-screen editor gadget to interactively enter text in a font of the user's choosing.
The following features are included in this version:
F5 toggles the text cursor and mouse pointer on and off.
F8 toggles an alignment grid on and off.
F12 saves the screen image as a jpg file for use with a video editing program to overlay titles over video or display them full-screen.
ESC or CTL-Q exits the program.
There are several things it does not do.
It cannot draw borders around characters.
This version does not save text.
There is one global font, one global background color and one global text color.
To align rows and pages, press F8 to bring up the alignment grid and manually pad the text with space and line-feed characters. As I said, it's extremely simple.
All suggestions are welcome.
There is all kinds of room for embellishment. One big request: if you modify the code, PLEASE DOCUMENT YOUR CHANGES.
Code: Select all
;Simple Title.pb
;Created on 4/4/2017 by chris319
;UPDATED 4/8/2017
;ESC CTL-Q = QUIT PROGRAM
;F2 = CENTER ALL HORIZONTALLY
;F5 = HIDE CARET
;F8 = ALIGHNMENT GRID
;F12 = SAVE IMAGE
UseJPEGImageEncoder()
InitSprite(): InitKeyboard()
#PAGES = 100
Global page = 1, H_ALIGN = #ES_LEFT
Global Dim page$(#PAGES)
Global Dim pageFont(#PAGES)
Global gridFlag=#False
Global cursorFlag = #True
Global H_RES, V_RES
H_RES = GetSystemMetrics_(#SM_CXSCREEN)
V_RES = GetSystemMetrics_(#SM_CYSCREEN)
tmpImage = CreateImage(1, H_RES, V_RES)
If tmpImage = #Null
MessageRequester("Error","Unable to Create Image."): End
EndIf
Procedure DrawPage(pageNum)
FreeGadget(1)
EditorGadget(1,0,0,H_RES,V_RES,H_ALIGN)
SetActiveGadget(1):SetGadgetFont(1,FontID(1))
SetGadgetColor(1,#PB_Gadget_BackColor,#Blue)
SetGadgetColor(1,#PB_Gadget_FrontColor,#White)
SetGadgetText(1,page$(page))
StartDrawing(WindowOutput(1)); HIDE GADGET BORDER
Box(0,0,H_RES,2,#Blue):Box(0,0,2,V_RES,#Blue)
Box(0,V_RES-2,H_RES,2,#Blue):Box(H_RES-2,0,2,V_RES,#Blue)
StopDrawing()
EndProcedure
Procedure ShutDown()
FreeFont(1)
If ImageID(1) <> #Null: FreeImage(1):EndIf
CloseWindow(1)
End
EndProcedure
Procedure ScreenToImage()
DestroyCaret_(): ShowCursor_(#False)
Define srcDC.l, trgDC.l
Protected BMPHandle.l, dm.Devmode
srcDC = CreateDC_("DISPLAY", "", "", dm)
trgDC = CreateCompatibleDC_(srcDC)
BMPHandle = CreateCompatibleBitmap_(srcDC, H_RES, V_RES)
RedrawWindow_(#Null,#Null,#Null,#RDW_INVALIDATE)
SelectObject_( trgDC, BMPHandle)
BitBlt_( trgDC, 0, 0, H_RES, V_RES, srcDC, 0, 0, #SRCCOPY)
DeleteDC_( trgDC)
ReleaseDC_( BMPHandle, srcDC)
StartDrawing(ImageOutput(1))
DrawImage(BMPHandle, 0, 0)
StopDrawing()
DeleteDC_(trgDC)
ReleaseDC_(BMPHandle, srcDC)
filename$ = ".\" + "textpage" + ".jpg"
; SaveImage(1, filename$); SAVE AS BMP
SaveImage(1, filename$,#PB_ImagePlugin_JPEG)
If cursorFlag <> #False: ShowCursor_(#True):EndIf
EndProcedure
OpenWindow(1,0,0,H_RES,V_RES,"",#PB_Window_BorderLess)
AddKeyboardShortcut(1,#PB_Shortcut_Escape, #PB_Shortcut_Escape) ;"ESCAPE" KEY TO QUIT PROGRAM
AddKeyboardShortcut(1,#PB_Shortcut_F2, #PB_Shortcut_F2) ;F2 H ALIGN
AddKeyboardShortcut(1,#PB_Shortcut_F5, #PB_Shortcut_F5) ;F5 CURSOR ON/OFF
AddKeyboardShortcut(1,#PB_Shortcut_F8, #PB_Shortcut_F8) ;F8 GRID ON OFF
AddKeyboardShortcut(1,#PB_Shortcut_F12, #PB_Shortcut_F12) ;F12 SAVE IMAGE
AddKeyboardShortcut(1,#PB_Shortcut_Control|#PB_Shortcut_Q, #PB_Shortcut_Q) ;F8 GRID ON OFF
fontSize = 36: fontName$ = "arial"
result = FontRequester(FontName$, fontSize,#Null)
If result
fontName$ = SelectedFontName()
fontsize=SelectedFontSize()
fontStyle=SelectedFontStyle()
If fontStyle = #Null: fontStyle$ = "Regular"
ElseIf fontstyle & 768: fontStyle$ = "Bold Italic"
ElseIf fontStyle & #PB_Font_Bold: fontStyle$ = "Bold"
ElseIf fontStyle & #PB_Font_Italic: fontStyle$ = "Italic"
ElseIf fontStyle & #PB_Font_HighQuality: fontStyle$ = "High Quality"
ElseIf fontStyle & #PB_Font_StrikeOut: fontStyle$ = "Strikeout"
ElseIf fontstyle & #PB_Font_Underline: fontStyle$ = "Underline"
; ElseIf fontstyle & #PB_FontRequester_Effects: fontStyle$ = ""
EndIf
EndIf
result = LoadFont(1,fontName$,fontSize)
EditorGadget(1,0,0,H_RES,V_RES)
page$(1) = "This is a test message."
DrawPage(1)
Repeat
event = WaitWindowEvent(1)
If event = #PB_Event_Gadget And EventGadget() = 3
result = FontRequester(FontName$, fontSize,#Null)
If result
fontName$ = SelectedFontName():fontsize=SelectedFontSize()
EndIf
ElseIf event = #PB_Event_Menu ;KEYBOARD INPUT
menuItem = EventMenu()
Select menuItem
; Case #PB_Shortcut_F1 ;HELP
; Debug "ESC CTL-Q Exit program"
; Debug "F8 Grid"
; Debug "F12 Save image"
Case #PB_Shortcut_F2; H ALIGN
If H_ALIGN = #ES_LEFT: H_ALIGN = #ES_CENTER
ElseIf H_ALIGN = #ES_CENTER: H_ALIGN = #ES_RIGHT
ElseIf H_ALIGN = #ES_RIGHT: H_ALIGN = #ES_LEFT
EndIf
DrawPage(page)
Case #PB_Shortcut_F5; HIDE CARET
If cursorFlag <> #False
DestroyCaret_()
ShowCursor_(#False)
cursorFlag = #False
; CreateCaret_(GadgetID(1),10,10,10)
Else
cursorFlag = #True
ShowCursor_(#True)
EndIf
Case #PB_Shortcut_F8 ;GRID ON/OFF
page$(page) = GetGadgetText(1)
If gridFlag = #False
StartDrawing(WindowOutput(1))
For ct = 1 To 10
Box(0,ct * (V_RES / 10),H_RES,2,#White)
Next
For ct = 1 To 10
Box(ct * (H_RES / 10),0,2,V_RES,#White)
Next
Box(H_RES / 2,0,2,V_RES,#Green)
Box(0,V_RES / 2,H_RES,2,#Green)
StopDrawing()
gridFlag = #True
Else: gridFlag = #False
DrawPage(page)
EndIf
Case #PB_Shortcut_F12;SAVE IMAGE
ScreenToImage()
Case #PB_Shortcut_Escape: ShutDown()
Case #PB_Shortcut_Q: ShutDown()
EndSelect
EndIf
ForEver