muß man es halt wieder über OpenLibrary() machen. Kein Problem.
anzeigt. Ich hoffe es hilft Dir als Einstieg.
Code: Alles auswählen
;
; by Danilo, April 2011, PB 4.51 (x86)
;
; GetFontUnicodeRanges_() demo
;
; - displays unicode character ranges for a given font
; - displays the unicode characters
;
; requires Windows 2000+
;
; http://forums.purebasic.com/german/viewtopic.php?f=16&t=24209
;
EnableExplicit
CompilerIf #PB_Compiler_Unicode = 0
MessageRequester("ERROR","Compile with Unicode support!")
End
CompilerEndIf
;---------------------------------------------------------------
; WinAPI Imports and Declarations
;---------------------------------------------------------------
Structure WCRANGE
wcLow.u
cGlyphs.u
EndStructure
Structure GLYPHSET
cbThis.l
flAccel.l
cGlyphsSupported.l
cRanges.l
ranges.WCRANGE[$FFFF]
EndStructure
Prototype.l GetFontUnicodeRanges(hdc.l, *gs.GLYPHSET)
Procedure.l GetFontUnicodeRanges_(hdc.l, *gs.GLYPHSET)
;
; [in] hdc A handle to the device context.
; [out] *gs.GLYPHSET A pointer to a GLYPHSET structure that receives
; the glyph set information.
; If this parameter is #Null, the function returns
; the size of the GLYPHSET Structure required
; To store the information.
;
; ReturnValue: If the function succeeds, it returns number of bytes
; written To the GLYPHSET Structure Or, If the *gs parameter
; is #Null, it returns the size of the GLYPHSET Structure
; required To store the information.
; If the function fails, it returns zero.
;
; Requirements: Windows 2000 Professional
;
Define gdi32.l, returnValue.l
Define gfur.GetFontUnicodeRanges
If OSVersion() >= #PB_OS_Windows_2000
gdi32 = OpenLibrary(#PB_Any,"gdi32.dll")
If gdi32
gfur = GetFunction(gdi32,"GetFontUnicodeRanges")
If gfur
returnValue = gfur(hdc,*gs)
EndIf
CloseLibrary(gdi32)
EndIf
EndIf
ProcedureReturn returnValue
EndProcedure
;---------------------------------------------------------------
Procedure getFontRanges( _font, List _ranges.WCRANGE())
;
; getFontRanges() fills the LinkedList _ranges()
; with the wide char ranges supported by _font
;
Define hdc, size, i, oldFont
Define *gs.GLYPHSET
ClearList( _ranges() )
hdc = GetDC_( 0 )
oldFont = SelectObject_(hdc,FontID(_font))
size = GetFontUnicodeRanges_(hdc,#Null)
If size
*gs = AllocateMemory(size)
If *gs
If GetFontUnicodeRanges_(hdc,*gs)
For i = 0 To *gs\cRanges-1
If AddElement( _ranges() )
_ranges()\wcLow = *gs\ranges[i]\wcLow
_ranges()\cGlyphs = *gs\ranges[i]\cGlyphs
EndIf
Next i
EndIf
FreeMemory(*gs)
EndIf
EndIf
SelectObject_(hdc,oldFont)
ReleaseDC_(0,hdc)
EndProcedure
Procedure UpdateListBoxes(lbRanges, lbOut, font)
;
; get the WCRANGES for font
; and update the listboxes
;
NewList ranges.WCRANGE()
getFontRanges( font, ranges() )
SendMessage_(GadgetID(lbRanges),#WM_SETREDRAW,0,0)
SendMessage_(GadgetID(lbOut),#WM_SETREDRAW,0,0)
ClearGadgetItems(lbRanges)
ClearGadgetItems(lbOut)
AddGadgetItem(lbRanges,-1," All")
ForEach ranges()
Define range$ = RSet(StrU(ranges()\wcLow,#PB_Unicode),5) + " - " + RSet(StrU(ranges()\wcLow+ranges()\cGlyphs-1,#PB_Unicode),5)
AddGadgetItem(lbRanges,-1,range$)
Next
SetGadgetState(lbRanges,0)
ForEach ranges()
Define j
For j = 0 To ranges()\cGlyphs-1
AddGadgetItem(lbOut,-1, Chr(ranges()\wcLow+j) )
Next
;AddGadgetItem(lbOut,-1,"-------------------")
Next
SendMessage_ (GadgetID(lbRanges),#WM_SETREDRAW,1,0)
SendMessage_ (GadgetID(lbOut) ,#WM_SETREDRAW,1,0)
RedrawWindow_(GadgetID(lbRanges),0,0,#RDW_ERASE|#RDW_FRAME|#RDW_INVALIDATE|#RDW_ALLCHILDREN)
RedrawWindow_(GadgetID(lbOut) ,0,0,#RDW_ERASE|#RDW_FRAME|#RDW_INVALIDATE|#RDW_ALLCHILDREN)
EndProcedure
Define mainWindow
Define fontButton, fontInfo, listBoxRanges, listBoxOutput
Define listBoxRangesFont, listBoxOutputFont, fontInfoFont, tempFont
Define currentFontName$, currentFontSize, currentFontStyle
Define eventGadget
Define listBoxRangesSelection$
Define listBoxRangesSelectionStart.q, listBoxRangesSelectionEnd.q
Define i
mainWindow = OpenWindow(#PB_Any,0,0,800,500,"GetFontUnicodeRanges_",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
If mainWindow
currentFontName$ = "Arial"
currentFontSize = 24
currentFontStyle = 0
listBoxOutputFont = LoadFont(#PB_Any, currentFontName$, currentFontSize, currentFontStyle)
listBoxRangesFont = LoadFont(#PB_Any, "Lucida Console", 12)
fontInfoFont = LoadFont(#PB_Any, "Lucida Console", 18, #PB_Font_Bold)
fontButton = ButtonGadget(#PB_Any,10,5,150,25,"Set Font")
fontInfo = TextGadget(#PB_Any,170,5,620,25,currentFontName$+", "+Str(currentFontSize))
SetGadgetFont(fontInfo,FontID(fontInfoFont))
TextGadget(#PB_Any,10,35,155,20,"Unicode Ranges:")
listBoxRanges = ListViewGadget(#PB_Any,10,55,155,440)
SetGadgetFont(listBoxRanges,FontID(listBoxRangesFont))
SetGadgetColor(listBoxRanges,#PB_Gadget_FrontColor,RGB($00,$FF,$80))
SetGadgetColor(listBoxRanges,#PB_Gadget_BackColor ,RGB($00,$00,$00))
TextGadget(#PB_Any,170,35,150,20,"Valid Characters:")
listBoxOutput = ListViewGadget(#PB_Any,170,55,620,440)
SetGadgetFont(listBoxOutput,FontID(listBoxOutputFont))
SetGadgetColor(listBoxOutput,#PB_Gadget_FrontColor,RGB($00,$FF,$80))
SetGadgetColor(listBoxOutput,#PB_Gadget_BackColor ,RGB($00,$00,$00))
UpdateListBoxes(listBoxRanges,listBoxOutput,listBoxOutputFont)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
eventGadget = EventGadget()
If EventGadget = fontButton
If FontRequester(currentFontName$, currentFontSize,0,0,currentFontStyle)
currentFontName$ = SelectedFontName()
currentFontSize = SelectedFontSize()
currentFontStyle = SelectedFontStyle()
tempFont = listBoxOutputFont
listBoxOutputFont = LoadFont(#PB_Any, currentFontName$, currentFontSize, currentFontStyle)
SetGadgetFont(listBoxOutput,FontID(listBoxOutputFont))
SetGadgetText(fontInfo, currentFontName$+", "+Str(currentFontSize))
UpdateListBoxes(listBoxRanges,listBoxOutput,listBoxOutputFont)
FreeFont(tempFont)
EndIf
ElseIf EventGadget = listBoxRanges
listBoxRangesSelection$ = GetGadgetItemText(listBoxRanges,GetGadgetState(listBoxRanges))
If listBoxRangesSelection$ = " All"
UpdateListBoxes(listBoxRanges,listBoxOutput,listBoxOutputFont)
Else
listBoxRangesSelectionStart = Val(StringField(listBoxRangesSelection$,1,"-"))
listBoxRangesSelectionEnd = Val(StringField(listBoxRangesSelection$,2,"-"))
SendMessage_ (GadgetID(listBoxOutput),#WM_SETREDRAW,0,0)
ClearGadgetItems(listBoxOutput)
For i = listBoxRangesSelectionStart To listBoxRangesSelectionEnd
AddGadgetItem(listBoxOutput,-1, Chr(i) )
Next i
SendMessage_ (GadgetID(listBoxOutput),#WM_SETREDRAW,1,0)
RedrawWindow_(GadgetID(listBoxOutput),0,0,#RDW_ERASE|#RDW_FRAME|#RDW_INVALIDATE|#RDW_ALLCHILDREN)
EndIf
EndIf
EndSelect
ForEver
EndIf
