With window9.bi it is easy to code our own Addin .
This is a simple example . Be happy !
Add a manifest , Compile for dll :
AddinWindow9.bas
Code: Select all
' test of FbEdit addin with window9.bi , with Gui managed in a callback function
#Include Once "window9.bi"
#Include "..\..\FbEdit\Inc\RAFile.bi"
#include "..\..\FbEdit\Inc\RAEdit.bi"
#include "..\..\FbEdit\Inc\Addins.bi"
#Define ld __LINE__ ' usage : ? ld,"myvar",myvar,item,etc
Dim Shared hInstance as HINSTANCE
Dim Shared hooks as ADDINHOOKS
Dim Shared lpHandles as ADDINHANDLES ptr
Dim Shared lpFunctions as ADDINFUNCTIONS ptr
Dim Shared lpData as ADDINDATA Ptr
Dim Shared IdSelectWord As Long
Dim Shared As Long deltax,new_gmx,old_gmx,deltay,new_gmy,old_gmy
Dim Shared As Long screenx,winx0,winy0,winx1,winy1, _
createdhw0,overwin0,IShortcut,IShortcut8,IShortcut9
Dim Shared As HWND hw0
Dim Shared As String sEditline
Const top = -1
Const down = 1
Sub db(lldd As Long ,para As String) ' for debug-trace
Static As Long lnbdb
lnbdb += 1
If lnbdb =1 Then
OpenWindow("",1200,0,500,700)
ListBoxGadget(12001,1,1,450,650)
SetGadgetColor(12001,&hd0e5e5,0,3)
EndIf
AddListBoxItem (12001,Str(lldd) + " : " + para)
SetItemListBox(12001,CountItemListBox(12001)-1)
End Sub
screenx = GetSystemMetrics(SM_CXSCREEN)
'screeny = GetSystemMetrics(SM_CYSCREEN)
winx0 = GlobalMouseX+600 : winy0 = 200 ' GlobalMouseY not correct ?
If winx0+450 > screenx Then
winx0 = screenx -1050
EndIf
winx1 = winx0 : winy1 = winy0+436
'If winy0 > (screeny -450) Then ' GlobalMouseY not correct ?
' winy0 = screeny - 450
' winy1 = winy0
'EndIf
Sub msgs(msg As Long,wParam As Long =0,lParam As Long =0) ' tests of events
If createdhw0 Then
Select Case msg
Case 0,15,5,308,32 ',280,308,512,513,132,32,33,528 ',9600
' nothing
Case Else
AddListBoxItem(2001,"msg "+ Str(msg)+" , "+Str(Hex(msg))+" , "+Str(LoWord(wParam))+" , "+Str(HiWord(wParam)))',LoWord(lParam),HiWord(lParam)
SetItemListBox(2001,CountItemListBox(2001)-1)
Sleep 150
End Select
EndIf
End Sub
' hw0 is a moveable popup windows ; click on the border and move . See DlgProc()
Sub objects()
hw0 = OpenWindow("",winx0,winy0,450,435,WS_POPUPWINDOW Or WS_VISIBLE) ',WS_EX_TOPMOST)
WindowColor(hw0,BGR(220,140,140))
ListBoxGadget(2001,10,20,450,420)
SetGadgetColor(2001,&hd0e5e5,0,3)
SetGadgetFont(2001,Cint(LoadFont("Arial",9,,,,,)))
CheckBoxGadget(2004,10,1,85,17," TopMost") ' not managed here
'SetGadgetState(2004,1)
ButtonGadget(2008,100,1,90,17,"Get line")
ButtonGadget(2009,210,1,90,17,"Paste line")
ButtonGadget(2015,320,1,45,17,"Close")
End Sub
'---------------------------------------------------------
' adapted from window9.bi , modif for hwnd as param instead of GadgetId
Function GetLineTextEditorA(hw As HWND,Number As Long,Buffer As Long=512) As String
Dim buff As ZString*1024
buff = MKShort(1024) + STRING(1024, 0)
SendMessage(hw,EM_GETLINE,Number,Cast(LPARAM,StrPtr(buff)))
Function = buff
End Function
Function LineFromCharEditorA(hw As HWND,index As Long=-1) As Long
Return SendMessage(hw,EM_LINEFROMCHAR,index,0)
End Function
Function SetSelectTextEditorGadgetA(hw As HWND,begin As Long,End_ As Long)As Long
SetFocus(hw)
Return SendMessage(hw,EM_SETSEL,begin-1 ,Cast(LPARAM,end_))
End Function
Function GetCurrentIndexCharEditorA(hw As HWND) As Long
Dim buf As Long
SendMessage(hw,EM_GETSEL,Cast(wparam,@buf),0)
Return buf
End Function
Function LineIndexEditorA(hw As HWND, ByVal NumberLine As Long=-1) As Long
Return SendMessage(hw,EM_LINEINDEX,NumberLine,0)
End Function
Function LineLengthEditorA(hw As HWND, ByVal index As Long=-1) As Long
Return SendMessage(hw,EM_LINELENGTH,index,0)
End Function
Function PasteEditorA(hw As HWND, ByVal text As String , ByVal param As BOOL=1) As Long
Return SendMessage(hw,EM_REPLACESEL,param,Cast(LPARAM,StrPtr(Text)))
End Function
Function GetLineCountEditorA(hw As HWND) As Long
Return SendMessage(hw,EM_GETLINECOUNT,0,0)
End Function
Function GetSelectText(hw As HWND)As String
Dim As CHARRANGE range
Dim buff As ZString*1024
buff = MKShort(1024) + STRING(1024, 0)
SendMessage(hw,EM_EXGETSEL,0,Cast(LPARAM, @range))
SendMessage(hw,EM_GETSELTEXT,0,Cast(LPARAM,StrPtr(buff)))
Function = buff
End Function
'--------------------------------------------------------
Sub SelectWord0()
Dim chrg As CHARRANGE
SendMessage(lpHandles->hred,EM_EXGETSEL,0,Cast(LPARAM,@chrg))
chrg.cpMin=SendMessage(lpHandles->hred,EM_FINDWORDBREAK,WB_MOVEWORDLEFT,chrg.cpMin)
chrg.cpMax=SendMessage(lpHandles->hred,EM_FINDWORDBREAK,WB_MOVEWORDRIGHT,chrg.cpMin)
SendMessage(lpHandles->hred,EM_EXSETSEL,0,Cast(LPARAM,@chrg))
End Sub
Sub SelectWordLeftBreak()
Dim chrg As CHARRANGE
SendMessage(lpHandles->hred,EM_EXGETSEL,0,Cast(LPARAM,@chrg))
chrg.cpMin=SendMessage(lpHandles->hred,EM_FINDWORDBREAK,WB_LEFTBREAK,chrg.cpMin)
chrg.cpMax=SendMessage(lpHandles->hred,EM_FINDWORDBREAK,WB_MOVEWORDRIGHT,chrg.cpMin)
SendMessage(lpHandles->hred,EM_EXSETSEL,0,Cast(LPARAM,@chrg))
End Sub
'---------------------------------------------------------------------------------
' find out a word among several lines , from top to down or down to top
Function FindInLine(sSt As String ,lPosi As Long = 1,lStrt As Long = 0,lEndof As Long = 50000,lStp As Long = down)As Long
Static As String sLn1,sLn2
Static As Long lPosiSt1,lPosiSt2,lLensSt
' MessBox ""&ld,"" & " Find -------------------------------"
For r As Long = lStrt To lEndof Step lStp
sLn1 = GetLineTextEditorA(lpHandles->hred,r)
'db(ld,"FindInLine " & sLn1)
If lPosi = -1 Then ' with -1 as param , at any position
lPosiSt1 = InStr(LCase(sLn1),LCase(sSt))
'db (ld,Str(lPosiSt1))
If lPosiSt1 Then
Return r
EndIf
ElseIf lPosi > 0 Then ' if at the given position
lPosiSt1 = InStr(LCase(sLn1),LCase(sSt))
'db (ld,Str(lPosiSt1))
If lPosiSt1 = lPosi Then Return r
EndIf
Next
Return 0
End Function
Sub AddAccelerator(ByVal fvirt As Long,ByVal akey As Long,ByVal id As Long)
Dim nAccel As Integer
Dim acl(500) As ACCEL
Dim i As Integer
nAccel=CopyAcceleratorTable(lpHandles->haccel,NULL,0)
CopyAcceleratorTable(lpHandles->haccel,@acl(0),nAccel)
DestroyAcceleratorTable(lpHandles->haccel)
' Check if id exist
For i=0 To nAccel-1
If acl(i).cmd=id Then
' id exist, update accelerator
acl(i).fVirt=fvirt
acl(i).key=akey
GoTo Ex
EndIf
Next i
' Check if accelerator exist
For i=0 To nAccel-1
If acl(i).fVirt=fvirt And acl(i).key=akey Then
' Accelerator exist, update id
acl(i).cmd=id
GoTo Ex
EndIf
Next i
' Add new accelerator
acl(nAccel).fVirt=fvirt
acl(nAccel).key=akey
acl(nAccel).cmd=id
nAccel=nAccel+1
Ex:
lpHandles->haccel=CreateAcceleratorTable(@acl(0),nAccel)
End Sub
Sub GetLine()
Var lEditline = LineFromCharEditorA(lpHandles->hred)
sEditline = GetLineTextEditorA(lpHandles->hred,lEditline)
db ld,sEditline
End Sub
Sub PasteLine()
db ld,sEditline
PasteEditorA(lpHandles->hred,sEditline+Chr(13,10))
End Sub
Sub closewin(hw As HWND)
If hw = hw0 Then
If createdhw0 = 1 Then
DestroyWindow(hw)
createdhw0 = 0
EndIf
EndIf
End Sub
' Returns info on what messages the addin hooks into (in an ADDINHOOKS type).
Function InstallDll CDECL alias "InstallDll" (byval hWin as HWND,byval hInst as HINSTANCE) as ADDINHOOKS ptr EXPORT
' The dll's instance
hInstance=hInst
' Get pointer to ADDINHANDLES
lpHandles=Cast(ADDINHANDLES ptr,SendMessage(hWin,AIM_GETHANDLES,0,0))
' Get pointer to ADDINDATA
lpData=Cast(ADDINDATA ptr,SendMessage(hWin,AIM_GETDATA,0,0))
' Get pointer to ADDINFUNCTIONS
lpFunctions=Cast(ADDINFUNCTIONS ptr,SendMessage(hWin,AIM_GETFUNCTIONS,0,0))
IShortcut = SendMessage(hWin,AIM_GETMENUID,0,0) ' create a window
IShortcut8 = SendMessage(hWin,AIM_GETMENUID,0,0)
IShortcut9 = SendMessage(hWin,AIM_GETMENUID,0,0)
' add our shortcuts
AddAccelerator(FVIRTKEY Or FNOINVERT Or FALT, Asc("C"),IShortcut8) ' Alt + c ' get
AddAccelerator(FVIRTKEY Or FNOINVERT Or FALT, Asc("V"),IShortcut9) ' Alt + v ' paste
AddAccelerator(FVIRTKEY Or FNOINVERT Or FALT, Asc("W"),IShortcut) ' Alt + w ' create a window
' Messages this addin will hook into
hooks.hook1=HOOK_COMMAND
hooks.hook2=0
hooks.hook3=0
hooks.hook4=0
Return @hooks
End Function
' FbEdit calls this function for every addin message that this addin is hooked into.
' Returning TRUE will prevent FbEdit and other addins from processing the message.
Function DllFunction CDECL alias "DllFunction" (byval hWin as HWND,byval uMsg as UINT,byval wParam as WPARAM,byval lParam as LPARAM) as bool EXPORT
'If createdhw0 = 1 Then msgs(umsg,wParam,lParam) ' debug
Select Case uMsg
Case AIM_COMMAND
If lpHandles->hred<>0 And lpHandles->hred<>lpHandles->hres Then
'If createdhw0 = 1 Then db ld,"" & umsg & " "& LoWord(wParam)
Select Case LoWord(wParam)
Case IShortcut ' ALT + w
If createdhw0 = 0 Then
objects() ' create a window
createdhw0 = 1
EndIf
Case IShortcut8 ' ALT + c
GetLine()
Case IShortcut9 ' ALT + v
PasteLine()
End Select
EndIf
Case AIM_CLOSE
If createdhw0 = 1 Then
SetWindowTop(hw0,0)
DestroyWindow(hw0)
EndIf
End Select
Return FALSE
End Function
Function DlgProc(ByVal hWin As HWND,ByVal uMsg As UINT,ByVal wParam As WPARAM,ByVal lParam As LPARAM) As Long
Static As Long id,itm
Dim ln As ZString * 64
Static lntmp As String
'msgs(umsg,wParam,lParam) ' tests of events , maybe too much
Select Case uMsg
'Case WM_CLOSE ' not for a pop-up window
' closewin
Case EventLBDown ' move hw0
old_gmx = GlobalMouseX
old_gmy = GlobalMouseY
If IsMouseOver(hw0) Then
If overwin0 = 0 Then
overwin0 = 1
SetCursor(LoadCursor(0,IDC_HAND))
EndIf
EndIf
Case EventLBUp ' after hw0 moved
If IsMouseOver(hw0) Then
overwin0 = 0
winx0 = WindowX(hw0) : winy0 = WindowY(hw0)
EndIf
Case EventMouseMove ' clicked , over hw0
If IsMouseOver(hw0) Then
If overwin0 = 1 Then
SetCursor(LoadCursor(0,IDC_HAND))
new_gmx = GlobalMouseX
new_gmy = GlobalMouseY
deltax = new_gmx - old_gmx
deltay = new_gmy - old_gmy
ResizeWindow(hw0,WindowX(hw0)+deltax,WindowY(hw0)+deltay,,)
old_gmx = new_gmx
old_gmy = new_gmy
Endif
EndIf
Case WM_COMMAND ' 273
id = LoWord(wParam)
' msgs(umsg,wParam,lParam) ' tests of events
Select Case id
Case 2008 ' get line
GetLine()
Case 2009 ' paste line
PasteLine()
Case 2015
closewin(hw0)
End Select
Case Else
Return FALSE
End Select
Return TRUE
End Function
SetWindowCallback(CInt(@ DlgProc()),0)
Code: Select all
#define MANIFEST 24
#define IDR_XPMANIFEST1 1
IDR_XPMANIFEST1 MANIFEST "xpmanifest.xml"