Updated code for 5.20+ in 6th post below
Restored from previous forum. Originally posted by fweil.
Just for fun, I was wondering something to place banners in big characters
in my source code for large programs. It is something I use to do for a long
time, to have nice listings.
So I did this one to key in a string and generate the large banner in an output file named banner.txt.
Feel free to play with the code and embed it as it is not perfect.
;************************************************
Dim Bannerchars(255, 100, 100)
; This callback is called automatically by Windows when an event occurs.
; We use it to update the size of the statusbar when the user size the window.
; This is useful only when solid mode sizing is used.
Procedure SizeCallback(WindowID, Message, wParam, lParam)
If Message = #WM_SIZE | #PB_EventRepaint
UpdateStatusBar(0)
ProcedureReturn -1 ; Tell the PureBasic internal event handler than the Size event is processed by the user callback
EndIf
EndProcedure
;
; Main program
;
FontName.s = "Verdana"
FontSize = 8
MatrixYSize = FontSize
MatrixXSize = FontSize + 8
WindowXSize.l=800
WindowYSize.l=600
WindowExternalYSize.l=WindowYSize+48
InitKeyboard()
If OpenWindow(0, 0, 0, WindowXSize, WindowExternalYSize, #PB_Window_SystemMenu + #PB_Window_SizeGadget, "Graphics")
UseWindow(0)
ActivateWindow()
WindowID=WindowID()
SetWindowCallback(@SizeCallback())
StartDrawing(WindowOutput())
DrawingMode(0)
Result = CreateStatusBar(0, WindowID)
AddStatusBarField(WindowXSize)
StatusBarText(0, 0, "Running ..." + Str(Result), 8 | 1)
FrontColor(0, 0, 0)
Box(0, 0, WindowXSize, WindowYSize)
BackColor(0, 0, 0)
FrontColor(180, 180, 255)
FontID.l = LoadFont(0, FontName, FontSize)
DrawingFont(FontID())
MatrixXSize = TextLength("M") + 2
For i=0 To 15
For j=0 To 15
Locate(0, 0)
label$=Chr(16*i+j)
If 16*i+j 0
b$=b$+("*")
Else
b$=b$+(" ")
EndIf
Next
Next
WriteStringN(b$)
Next
CloseFile(0)
Else
PrintN("Could not create output file ...")
EndIf
CloseConsole()
End
;************************************************
Francois Weil
14, rue Douer
F64100 Bayonne
Edit a banner
-
BackupUser
- PureBasic Guru
- Posts: 16777133
- Joined: Tue Apr 22, 2003 7:42 pm
Restored from previous forum. Originally posted by TronDoc.
I get a directX error when I try your program:
"The PUREBASIC5477502.EXE file is linked to missing
export DINPUT.DLL:DirectInputCreateEX."
I don't see the directX in your code
and I don't have directX on my PC...
Is there something I can modify to
make it work otherwise?
elecTRONics DOCtor
{registeredPB}P150 32Mb w98/DOS/Linux NO DirX NO IE
I get a directX error when I try your program:
"The PUREBASIC5477502.EXE file is linked to missing
export DINPUT.DLL:DirectInputCreateEX."
I don't see the directX in your code
and I don't have directX on my PC...
Is there something I can modify to
make it work otherwise?
elecTRONics DOCtor
{registeredPB}P150 32Mb w98/DOS/Linux NO DirX NO IE
-
BackupUser
- PureBasic Guru
- Posts: 16777133
- Joined: Tue Apr 22, 2003 7:42 pm
Restored from previous forum. Originally posted by Franco.
Didn't Fred say that the 'InitStuff' is gone since v3.1
Have a nice day...
Franco
Sometimes you have to go a lonely way to accomplish genius things.
InitKeyboard() uses DirectX technology, comment it with ';'I don't see the directX in your code and I don't have directX on my PC...
Didn't Fred say that the 'InitStuff' is gone since v3.1
Have a nice day...
Franco
Sometimes you have to go a lonely way to accomplish genius things.
-
BackupUser
- PureBasic Guru
- Posts: 16777133
- Joined: Tue Apr 22, 2003 7:42 pm
Restored from previous forum. Originally posted by TronDoc.
commenting out that init got rid of the error.
the output from the program when I enter TronDoc
is 15 rows of 91 asterisks...?
-jb
if I enter Hi
I get 15 rows of 26 asterisks..
..case does not seem to matter either.
Edited by - TronDoc on 19 May 2002 10:32:50
commenting out that init got rid of the error.
the output from the program when I enter TronDoc
is 15 rows of 91 asterisks...?
-jb
if I enter Hi
I get 15 rows of 26 asterisks..
..case does not seem to matter either.
Edited by - TronDoc on 19 May 2002 10:32:50
-
BackupUser
- PureBasic Guru
- Posts: 16777133
- Joined: Tue Apr 22, 2003 7:42 pm
Restored from previous forum. Originally posted by fweil.
I just refined the code to use graphical components only.
Does it work better ?
;*********************************************************
;
; Francois Weil - 20020519
;
; Draw a large characters text banner using any available font and size in the system
;
Dim Bannerchars(255, 100, 100)
;
; This InputRequester wents from El_Choni and Wavemaker's PopUpwindow library
; I modified original code to make it more simple to use in this case
;
Procedure$ InputRequester(Title$,Text$,Default$)
FontName.s="Arial"
FontSize.l=8
SizeY=135
Size1.l=Len(Title$)*FontSize
Size2.l=Len(Text$)*FontSize
Size3.l=Len(Default$)*FontSize
If Size3 SizeX
SizeX = Size1
EndIf
If OpenPopUpWindow(WindowID(), 499, (GetSystemMetrics_(#SM_CXSCREEN)/2)-(SizeX/2),(GetSystemMetrics_(#SM_CYSCREEN)/2)-(SizeY/2),SizeX,SizeY,Title$)
FontID.l = LoadFont(0, FontName, FontSize)
SetGadgetFont(FontID())
If CreateGadgetList(PopUpWindowID(0))
TextGadget(0, 12, 14, Size2, FontSize+6, Text$)
StringGadget(1, (Size2 + 24), 12, Size3, FontSize+10, Default$)
ButtonGadget(2, (SizeX - 175), 76, 76, 22, "OK")
ButtonGadget(3, (SizeX - 94), 76, 76, 22, "Cancel")
ActivateGadget(1)
Repeat
EventID.l = WaitWindowEvent()
If EventID = #PB_EventGadget
Select EventGadgetID()
Case 2
Result$=GetGadgetText(1)
EventID = #PB_EventCloseWindow
Case 3
Result$=""
EventID = #PB_EventCloseWindow
EndSelect
EndIf
Until EventID = #PB_EventCloseWindow
EndIf
ClosePopUpWindow(499)
Else
Result$=""
EndIf
ProcedureReturn Result$
EndProcedure
;
; Main program
;
FontName.s = "Arial"
FontSize = 16
MatrixYSize = FontSize
MatrixXSize = FontSize + 8
WindowXSize = MatrixXSize + 10
WindowYSize = MatrixYSize + 10
WindowExternalYSize.l=WindowYSize+48
;
; Creating the main window to draw chars and catch pixels
;
If OpenWindow(0, (GetSystemMetrics_(#SM_CXSCREEN)/2)-(WindowXSize/2), (GetSystemMetrics_(#SM_CYSCREEN)/2)-(WindowExternalYSize/2), WindowXSize, WindowExternalYSize, #PB_Window_SystemMenu + #PB_Window_SizeGadget, "Graphics")
WindowID=WindowID()
StartDrawing(WindowOutput())
DrawingMode(0)
FrontColor(0, 0, 0)
Box(0, 0, WindowXSize, WindowYSize)
BackColor(0, 0, 0)
FrontColor(180, 180, 255)
FontID.l = LoadFont(0, FontName, FontSize)
DrawingFont(FontID())
MatrixXSize = TextLength("M") + 2
For i=0 To 15
For j=0 To 15
Locate(0, 0)
label$=Chr(16*i+j)
If 16*i+j 0
b$=b$+("*")
Else
b$=b$+(" ")
EndIf
Next
Next
WriteStringN(b$)
Next
CloseFile(0)
Locate(100, 100)
DrawText("Output file saved ...")
Else
Locate(100, 100)
DrawText("Could not create output file ...")
EndIf
Delay(1000)
CloseWindow(0)
EndIf
End
;*********************************************************
Francois Weil
14, rue Douer
F64100 Bayonne
I just refined the code to use graphical components only.
Does it work better ?
;*********************************************************
;
; Francois Weil - 20020519
;
; Draw a large characters text banner using any available font and size in the system
;
Dim Bannerchars(255, 100, 100)
;
; This InputRequester wents from El_Choni and Wavemaker's PopUpwindow library
; I modified original code to make it more simple to use in this case
;
Procedure$ InputRequester(Title$,Text$,Default$)
FontName.s="Arial"
FontSize.l=8
SizeY=135
Size1.l=Len(Title$)*FontSize
Size2.l=Len(Text$)*FontSize
Size3.l=Len(Default$)*FontSize
If Size3 SizeX
SizeX = Size1
EndIf
If OpenPopUpWindow(WindowID(), 499, (GetSystemMetrics_(#SM_CXSCREEN)/2)-(SizeX/2),(GetSystemMetrics_(#SM_CYSCREEN)/2)-(SizeY/2),SizeX,SizeY,Title$)
FontID.l = LoadFont(0, FontName, FontSize)
SetGadgetFont(FontID())
If CreateGadgetList(PopUpWindowID(0))
TextGadget(0, 12, 14, Size2, FontSize+6, Text$)
StringGadget(1, (Size2 + 24), 12, Size3, FontSize+10, Default$)
ButtonGadget(2, (SizeX - 175), 76, 76, 22, "OK")
ButtonGadget(3, (SizeX - 94), 76, 76, 22, "Cancel")
ActivateGadget(1)
Repeat
EventID.l = WaitWindowEvent()
If EventID = #PB_EventGadget
Select EventGadgetID()
Case 2
Result$=GetGadgetText(1)
EventID = #PB_EventCloseWindow
Case 3
Result$=""
EventID = #PB_EventCloseWindow
EndSelect
EndIf
Until EventID = #PB_EventCloseWindow
EndIf
ClosePopUpWindow(499)
Else
Result$=""
EndIf
ProcedureReturn Result$
EndProcedure
;
; Main program
;
FontName.s = "Arial"
FontSize = 16
MatrixYSize = FontSize
MatrixXSize = FontSize + 8
WindowXSize = MatrixXSize + 10
WindowYSize = MatrixYSize + 10
WindowExternalYSize.l=WindowYSize+48
;
; Creating the main window to draw chars and catch pixels
;
If OpenWindow(0, (GetSystemMetrics_(#SM_CXSCREEN)/2)-(WindowXSize/2), (GetSystemMetrics_(#SM_CYSCREEN)/2)-(WindowExternalYSize/2), WindowXSize, WindowExternalYSize, #PB_Window_SystemMenu + #PB_Window_SizeGadget, "Graphics")
WindowID=WindowID()
StartDrawing(WindowOutput())
DrawingMode(0)
FrontColor(0, 0, 0)
Box(0, 0, WindowXSize, WindowYSize)
BackColor(0, 0, 0)
FrontColor(180, 180, 255)
FontID.l = LoadFont(0, FontName, FontSize)
DrawingFont(FontID())
MatrixXSize = TextLength("M") + 2
For i=0 To 15
For j=0 To 15
Locate(0, 0)
label$=Chr(16*i+j)
If 16*i+j 0
b$=b$+("*")
Else
b$=b$+(" ")
EndIf
Next
Next
WriteStringN(b$)
Next
CloseFile(0)
Locate(100, 100)
DrawText("Output file saved ...")
Else
Locate(100, 100)
DrawText("Could not create output file ...")
EndIf
Delay(1000)
CloseWindow(0)
EndIf
End
;*********************************************************
Francois Weil
14, rue Douer
F64100 Bayonne
Updated banner tip
Code updated for 5.20+
Code: Select all
Procedure.s Banner(String.s, FontID.l)
ImageNumber = CreateImage(#PB_Any, 100, 100)
StartDrawing(ImageOutput(ImageNumber))
DrawingFont(FontID)
DrawingMode(#PB_2DDrawing_Outlined)
StringWidth = TextWidth(String)
StringHeight = TextHeight(String)
StopDrawing()
FreeImage(ImageNumber)
ImageNumber = CreateImage(#PB_Any, StringWidth, StringHeight)
StartDrawing(ImageOutput(ImageNumber))
DrawingFont(FontID)
DrawingMode(#PB_2DDrawing_Outlined)
DrawText(0, 0, String, #White, #Black)
*String = AllocateMemory((StringWidth + 1) * StringHeight)
*Address.Character = *String
For row = 0 To StringHeight - 1
For column = 0 To StringWidth - 1
If Point(column, row)
*Address\c = 'M'
Else
*Address\c = ' '
EndIf
*Address + 1
Next
*Address\c = 10
*Address + 1
Next
*Address\c = 0
StopDrawing()
Result.s = PeekS(*String)
FreeMemory(*String)
ProcedureReturn Result
EndProcedure
;
;
;
WindowWidth = 1024
WindowHeight = 480
WindowTitle.s = ""
SelectedFontColor = #Blue
SelectedFontName.s = "Verdana"
SelectedFontSize = 8
SelectedFontStyle = 0
FontNumber = LoadFont(#PB_Any, SelectedFontName, SelectedFontSize, SelectedFontStyle)
FontID = FontID(FontNumber)
MainWindow = OpenWindow(#PB_Any, 0, 0, WindowWidth, WindowHeight, WindowTitle, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
If MainWindow
MainWindowID = WindowID(MainWindow)
StatusBar = CreateStatusBar(#PB_Any, MainWindowID)
AddStatusBarField(120)
AddStatusBarField(120)
AddStatusBarField(120)
AddStatusBarField(120)
AddStatusBarField(120)
StatusBarText(StatusBar, 1, "Name : " + SelectedFontName)
StatusBarText(StatusBar, 2, "Size : " + Str(SelectedFontSize))
If SelectedFontStyle & #PB_Font_Bold
sSelectedFontStyle.s = "Bold"
Else
sSelectedFontStyle.s = ""
EndIf
If SelectedFontStyle & #PB_Font_Italic
If sSelectedFontStyle = ""
sSelectedFontStyle.s + " / Italic"
Else
sSelectedFontStyle.s + "Italic"
EndIf
EndIf
StatusBarText(StatusBar, 3, "Style : " + sSelectedFontStyle)
StatusBarText(StatusBar, 4, "Color : " + RSet(Hex(SelectedFontColor), 6, "0"))
AddKeyboardShortcut(MainWindow, #PB_Shortcut_Escape, #PB_Shortcut_Escape)
ButtonGadget_Font = ButtonGadget(#PB_Any, 10, 10, 60, 20, "Font")
StringGadget = StringGadget(#PB_Any, 80, 10, WindowWidth - 160, 20, "Your text here !")
ButtonGadget_OK = ButtonGadget(#PB_Any, WindowWidth - 70, 10, 60, 20, "OK")
EditorGadget = EditorGadget(#PB_Any, 10, 40, WindowWidth - 20, WindowHeight - 70)
SetGadgetFont(EditorGadget, FontID(LoadFont(#PB_Any, "Courier New", 10, #PB_Font_HighQuality)))
SetGadgetText(EditorGadget, Banner(GetGadgetText(StringGadget), FontID))
Quit = #False
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Quit = #True
Case #PB_Event_Menu
Select EventMenu()
Case #PB_Shortcut_Escape
Quit = #True
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case ButtonGadget_Font
FontRequester(SelectedFontName, SelectedFontSize, #PB_FontRequester_Effects, #Blue)
SelectedFontColor = SelectedFontColor()
SelectedFontName.s = SelectedFontName()
SelectedFontSize = SelectedFontSize()
SelectedFontStyle = SelectedFontStyle()
If FontNumber
FreeFont(FontNumber)
EndIf
FontNumber = LoadFont(#PB_Any, SelectedFontName, SelectedFontSize, SelectedFontStyle | #PB_Font_HighQuality)
FontID = FontID(FontNumber)
SetGadgetText(EditorGadget, Banner(GetGadgetText(StringGadget), FontID))
StatusBarText(StatusBar, 1, "Name : " + SelectedFontName)
StatusBarText(StatusBar, 2, "Size : " + Str(SelectedFontSize))
If SelectedFontStyle & #PB_Font_Bold
sSelectedFontStyle.s = "Bold"
Else
sSelectedFontStyle.s = ""
EndIf
If SelectedFontStyle & #PB_Font_Italic
If sSelectedFontStyle = ""
sSelectedFontStyle.s + " / Italic"
Else
sSelectedFontStyle.s + "Italic"
EndIf
EndIf
StatusBarText(StatusBar, 3, "Style : " + sSelectedFontStyle)
StatusBarText(StatusBar, 4, "Color : " + RSet(Hex(SelectedFontColor), 6, "0"))
Case ButtonGadget_OK
SetGadgetText(EditorGadget, Banner(GetGadgetText(StringGadget), FontID))
EndSelect
Case #PB_Event_SizeWindow
WindowWidth = WindowWidth(MainWindow)
WindowHeight = WindowHeight(MainWindow)
If WindowWidth <> OldWindowWidth Or WindowHeight <> OldWindowHeight
ResizeGadget(ButtonGadget_Font, 10, 10, 60, 20)
ResizeGadget(StringGadget, 80, 10, WindowWidth - 160, 20)
ResizeGadget(ButtonGadget_OK, WindowWidth - 70, 10, 60, 20)
ResizeGadget(EditorGadget, 10, 40, WindowWidth - 20, WindowHeight - 70)
EndIf
OldWindowWidth = WindowWidth
OldWindowHeight = WindowHeight
EndSelect
Until Quit
EndIf
CallDebugger
EndMy avatar is a small copy of the 4x1.8m image I created and exposed at 'Le salon international du meuble à Paris' january 2004 in Matt Sindall's 'Shades' designers exhibition. The original laminated print was designed using a 150 dpi printout.
