J'ai mis mon CharMap à la version 4.51. Elle fonctionne avec ton programme.
Code : Tout sélectionner
; CharMap.
; OS = Windows. (A cause des Z'APIS!)
; Auteur :Chris
; -------------------------------------------------------------
;{- Constantes
Enumeration
#Win_Main
EndEnumeration
Enumeration
#Cmb_Fonts
#Img_Preview
#Txt_Result
#TxtCopie
#Chk_Japbe
#Chk_InsertChr
#Chk_Sticky
#Frame3D_Copy
#Btn_CopyAsString
#Btn_CopyAsChar
#Btn_CopyAsHex
#Btn_CopyAsBin
#Btn_CopyAsDec
#Btn_CopyAsCar
#Btn_Erase
EndEnumeration
#STN_CLICKED = 0
#WMCD_InsertText = 2
;}
;{- Variables, Listes tableaux
Global NewList Fontes.s()
Global NewList Texts.l()
Global CurPos.POINT
Global Dim CommanChars.s(32)
;}
;{- Déclarations
Declare Create_Image(Lettre.s)
Declare EnumFontProc(*lpelf.ENUMLOGFONT, *lpntm.NEWTEXTMETRIC, FontType, lParam)
Declare GetFont_Info()
Declare Hi_Word(Long)
Declare Open_Window_0()
Declare WinCallback(Hwn, Msge, wParam, lParam)
Declare UpdateTexts()
;}
;{- Image vide
CreateImage(10, 255, 250)
StartDrawing(ImageOutput(10))
Box(0, 0, 255, 250, $FFFFFF)
StopDrawing()
;}
;{- Procédures
Procedure Open_Window_0()
x_Text = 270 : y_Text = 5 : IdTxt = 1000
If OpenWindow(#Win_Main, 5, 5, 675, 445, "Table des caractères", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_TitleBar )
ImageGadget(#Img_Preview, 5, 30, 255, 250, ImageID(10), #PB_Image_Border)
ComboBoxGadget(#Cmb_Fonts, 5, 5, 260, 20)
TextGadget(#Txt_Result, 5, 420, 665, 20, "", #PB_Text_Center | #PB_Text_Border | #SS_NOPREFIX)
SetGadgetFont(#Txt_Result, FontID(2))
TextGadget(#TxtCopie, 5, 290, 170, 20, "", #PB_Text_Center | #PB_Text_Border | #SS_NOPREFIX)
SetGadgetFont(#TxtCopie, FontID(2))
CheckBoxGadget(#Chk_Sticky, 10, 390, 100, 25, "Toujours devant")
CheckBoxGadget(#Chk_InsertChr, 130, 390, 100, 25, "Ajouter le ''Chr()''")
Frame3DGadget(#Frame3D_Copy, 5, 320, 260, 65, "Mode de copie")
ButtonGadget(#Btn_CopyAsDec, 10, 340, 80, 20, "Décimal")
ButtonGadget(#Btn_CopyAsChar, 95, 340, 80, 20, "Char")
ButtonGadget(#Btn_CopyAsBin, 180, 340, 80, 20, "Binaire")
ButtonGadget(#Btn_CopyAsHex, 10, 360, 80, 20, "Hexadécimal")
ButtonGadget(#Btn_CopyAsString, 95, 360, 80, 20, "Chaine")
ButtonGadget(#Btn_CopyAsCar, 180, 360, 80, 20, "Caractère")
ButtonGadget(#Btn_Erase, 180, 290, 80, 20, "Effacer")
Sz_L = 25 : Sz_W = Sz_L
For i = 0 To 255
AddElement(Texts())
TextGadget(IdTxt, x_Text, y_Text, Sz_L, Sz_W, "", #PB_Text_Center | #PB_Text_Border | #SS_NOTIFY | #SS_NOPREFIX)
Texts() = IdTxt : IdTxt + 1
x_Text + Sz_L : If x_Text > 660 : x_Text = 270 : y_Text + Sz_W : EndIf
SetGadgetFont(Texts(), FontID(0))
Next
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure EnumFontProc(*lpelf.ENUMLOGFONT, *lpntm.NEWTEXTMETRIC, FontType, lParam)
FnN$ = PeekS(@*lpelf\elfLogFont\lfFaceName[0])
AddElement(Fontes())
Fontes() = FnN$
ProcedureReturn #True
EndProcedure
Procedure GetFont_Info()
hdc = GetDC_(GetDesktopWindow_())
EnumFontFamilies_(hdc, 0, @EnumFontProc(),0)
ReleaseDC_ (GetDesktopWindow_(), hdc)
EndProcedure
Procedure UpdateTexts()
ForEach Texts()
i = ListIndex(Texts())
SetGadgetFont(Texts(), FontID(0))
SetGadgetText(Texts(), Chr(i))
Next
EndProcedure
Procedure Hi_Word(Long)
ProcedureReturn (Long >>16) & $FFFF
EndProcedure
Procedure WinCallback(Hwn, Msge, wParam, lParam)
Result = #PB_ProcessPureBasicEvents
Select Msge
Case #WM_COMMAND
If Hi_Word(wParam) = #STN_CLICKED
ForEach Texts()
If GadgetID(Texts()) = lParam
SetGadgetText(#TxtCopie, GetGadgetText(Texts()))
If Texts() >= 1000 And Texts() <= 1031
DisableGadget(#Btn_CopyAsChar, 1)
Else
DisableGadget(#Btn_CopyAsChar, 0)
EndIf
EndIf
Next
EndIf
EndSelect
ProcedureReturn Result
EndProcedure
Procedure Create_Image(Lettre.s)
If CreateImage(0, 255, 250)
StartDrawing(ImageOutput(0))
DrawingMode(#PB_2DDrawing_XOr ) : DrawingFont(FontID(1))
W_Lettre = TextWidth(Lettre) : H_Lettre = TextHeight(Lettre)
Box(0, 0, 255, 250, $FFFFFF)
DrawText(128 - W_Lettre/2, 128 - H_Lettre / 2, Lettre)
StopDrawing()
SetGadgetState(#Img_Preview, ImageID(0))
EndIf
EndProcedure
;}
;{- Initialisation
GetFont_Info() : SortList(Fontes(), 2)
If OpenPreferences("CharMap.pref")
CmbState = ReadPreferenceLong("IdFont", 19)
StickyState = ReadPreferenceLong("OnTop", 1)
ChrState = ReadPreferenceLong("AddChr", 0)
ClosePreferences()
EndIf
SelectElement(Fontes(), CmbState) : LoadFont(0, Fontes(), 12) : LoadFont(1, Fontes(), 140) : LoadFont(2, "Courier New", 11, #PB_Font_Bold)
Restore CommandChar
For i = 0 To 32
Read.s CommanChars(i)
Next
If Open_Window_0()
ForEach Fontes()
AddGadgetItem(#Cmb_Fonts, -1, Fontes())
Next
SetGadgetState(#Cmb_Fonts, CmbState)
SetGadgetState(#Chk_Sticky, StickyState)
SetGadgetState(#Chk_InsertChr, ChrState)
StickyWindow(#Win_Main, GetGadgetState(#Chk_Sticky))
SetWindowCallback(@WinCallback())
Else
End
EndIf
UpdateTexts()
;}
;{- Boucle
Repeat;{
GetCursorPos_(@CurPos)
HObjet = WindowFromPoint_(CurPos\x|CurPos\y <<32) : IDWindow = GetWindowLong_(HObjet, #GWL_ID);: Debug IDWindow -1000
If IDWindow >= 1000
If IDWindow >= 1000 And IDWindow <=1032
c = IDWindow - 1000
Ms1$ = CommanChars(IDWindow - 1000) + " "
Ms2$ = "Ascii = " + RSet(Str(c), 3, "0") + " "
Ms3$ = "Hex = $" + RSet(Hex(c), 2, "0") + " "
Ms4$ = "Bin = %" + RSet(Bin(c), 8, "0")
SetGadgetText(#Txt_Result, Ms1$ + Ms2$ + Ms3$ + Ms4$)
SetGadgetState(#Img_Preview, ImageID(10))
Else
If IDWindow >=1033 And IDWindow <= 1255
SelectElement(Texts(), IDWindow - 1000)
C$ = GetGadgetText(Texts()) : c = Asc(C$)
Ms1$ = "Car. = " + RSet(C$, 1, " ") + " "
Ms2$ = "Ascii = " + RSet(Str(c), 3, "0") + " "
Ms3$ = "Hex = $" + RSet(Hex(c), 2, "0") + " "
Ms4$ = "Bin = %" + RSet(Bin(c), 8, "0")
SetGadgetText(#Txt_Result, Ms1$ + Ms2$ + Ms3$ + Ms4$)
Create_Image(GetGadgetText(Texts()))
EndIf
EndIf
EndIf
Select WaitWindowEvent();{
Case #PB_Event_Gadget
Select EventGadget();{
Case #Cmb_Fonts;{
If EventType() = #CBN_SELCHANGE
SelectElement(Fontes(), GetGadgetState(#Cmb_Fonts))
LoadFont(0, Fontes(), 12) : LoadFont(1, Fontes(), 140)
UpdateTexts()
SetGadgetState(#Img_Preview, ImageID(10))
EndIf;}
Case #Btn_CopyAsBin;{
c = Asc(GetGadgetText(#TxtCopie))
If GetGadgetState(#Chk_InsertChr) = 1
Res$ = "chr(%" + Bin(c) + ")"
Else
Res$ = "%" + Bin(c)
EndIf
SetClipboardText(Res$) ;}
Case #Btn_CopyAsChar;{
If GetGadgetState(#Chk_InsertChr) = 1
Res$ = "Chr('"+ GetGadgetText(#TxtCopie) + "')"
Else
Res$ = "'"+GetGadgetText(#TxtCopie)+"'"
EndIf
SetClipboardText(Res$);}
Case #Btn_CopyAsDec;{
c = Asc(GetGadgetText(#TxtCopie))
If GetGadgetState(#Chk_InsertChr) = 1
Res$ = "chr("+Str(c)+")"
Else
Res$ =Str(c)
EndIf
SetClipboardText(Res$) ;}
Case #Btn_CopyAsHex;{
c = Asc(GetGadgetText(#TxtCopie))
If GetGadgetState(#Chk_InsertChr) = 1
Res$ = "chr($"+Hex(c)+")"
Else
Res$ = "$"+Hex(c)
EndIf
SetClipboardText(Res$) ;}
Case #Btn_CopyAsString;{
Res$ = Chr(34) + GetGadgetText(#TxtCopie) + Chr(34)
SetClipboardText(Res$) ;}
Case #Btn_CopyAsCar;{
Res$ = GetGadgetText(#TxtCopie)
SetClipboardText(Res$) ;}
Case #Btn_Erase;{
SetGadgetText(#TxtCopie, "");}
Case #Chk_Sticky;{
StickyWindow(#Win_Main, GetGadgetState(#Chk_Sticky));}
EndSelect;}
Case #PB_Event_CloseWindow;{
CreatePreferences("CharMap.pref")
WritePreferenceLong("IdFont", GetGadgetState(#Cmb_Fonts))
WritePreferenceLong("OnTop", GetGadgetState(#Chk_Sticky))
WritePreferenceLong("AddChr", GetGadgetState(#Chk_InsertChr))
ClosePreferences()
Quit =#True;}
EndSelect;}
Until Quit;}
End;}
;{- Datas
DataSection
CommandChar:
Data.s "NUL - Null","SOH - Start Of Header", "STX - Start Of Text", "ETX - End Of Text", "EOT - End Of Transmission", "ENQ - Enquiry", "ACK - Acknowledge", "BEL - Bell"
Data.s "BS - BackSpace", "HT - Horizontal Tab", "LF - Line Feed", "VT - Vertical Tab", "FF - Form Feed", "CR - Carriage Return", "SO - Shift Out", "SI - Shift In", "DLE - Data Link Escape"
Data.s "DC1 - (XON) Device Control 1", "DC2 - Device Control 2", "DC3 - (XOFF) Device Control 3", "DC4 - Device Control 4", "NAK - Negative Acknowledge", "SYN - Synchronous IDLE"
Data.s "ETB - End of Trans. Block", "CAN - Cancel", "EM - End of Medium", "SUB - Substitute", "ESC - Escape", "FS - File Separator", "GS - Group Separator"
Data.s "RS - Request to Send", "US - Unit Separator", "SP - Space"
EndDataSection;}
)
