Addin for FbEdit ( Gui ) with

User projects written in or related to FreeBASIC.
Posts: 177
Joined: Apr 24, 2011 12:57
Location: France

Addin for FbEdit ( Gui ) with

Postby enform » Apr 09, 2019 17:07

With it is easy to code our own Addin .
This is a simple example . Be happy !

Add a manifest , Compile for dll :


Code: Select all

 ' test of FbEdit addin with , with Gui managed in a callback function
#Include Once ""
#Include "..\..\FbEdit\Inc\"
#include "..\..\FbEdit\Inc\"
#include "..\..\FbEdit\Inc\"

#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, _
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
   AddListBoxItem (12001,Str(lldd) + " : " + para)
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
   winx1 = winx0  : winy1 =  winy0+436

   'If winy0 > (screeny -450) Then  '  GlobalMouseY not correct ?
   '   winy0 = screeny - 450
   '   winy1 = winy0
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)
         Sleep 150
      End Select
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)
   CheckBoxGadget(2004,10,1,85,17," TopMost") ' not managed here
   ButtonGadget(2008,100,1,90,17,"Get line")
   ButtonGadget(2009,210,1,90,17,"Paste line")
End Sub

 ' adapted from , 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)
   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
 Return SendMessage(hw,EM_SETSEL,begin-1 ,Cast(LPARAM,end_))
End Function

Function GetCurrentIndexCharEditorA(hw As HWND) As Long
  Dim buf As Long
  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))
   Function = buff 
End Function


Sub SelectWord0()
   Dim chrg As CHARRANGE
End Sub

Sub SelectWordLeftBreak()
   Dim chrg As CHARRANGE
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
      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
   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

   ' Check if id exist
   For i=0 To nAccel-1
      If acl(i).cmd=id Then
         ' id exist, update accelerator
         GoTo Ex
   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
         GoTo Ex
   Next i
   ' Add new accelerator

End Sub

Sub GetLine()
   Var lEditline = LineFromCharEditorA(lpHandles->hred)
   sEditline = GetLineTextEditorA(lpHandles->hred,lEditline)
   db ld,sEditline
End Sub

Sub PasteLine()
   db ld,sEditline
End Sub

Sub closewin(hw As HWND)
   If hw = hw0 Then
      If createdhw0 = 1 Then
         createdhw0 = 0
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
   ' 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
   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
               Case IShortcut8  ' ALT + c
               Case IShortcut9  ' ALT + v
            End Select
      Case AIM_CLOSE
         If createdhw0 = 1 Then
   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
      Case EventLBUp  ' after hw0 moved
            If IsMouseOver(hw0) Then
               overwin0 = 0
               winx0 = WindowX(hw0)   : winy0 = WindowY(hw0)
      Case EventMouseMove  ' clicked , over hw0
            If IsMouseOver(hw0) Then
               If overwin0 = 1 Then
                  new_gmx = GlobalMouseX
                  new_gmy = GlobalMouseY
                  deltax  = new_gmx - old_gmx
                  deltay  = new_gmy - old_gmy
                  old_gmx = new_gmx
                  old_gmy = new_gmy
      Case WM_COMMAND ' 273
         id = LoWord(wParam)
      '   msgs(umsg,wParam,lParam) ' tests of events
         Select Case id
            Case 2008   ' get line
            Case 2009   ' paste line
            Case 2015   
         End Select
      Case Else
         Return FALSE
   End Select
   Return TRUE
End Function

SetWindowCallback(CInt(@ DlgProc()),0)


Code: Select all

#define MANIFEST 24


Return to “Projects”

Who is online

Users browsing this forum: No registered users and 2 guests