Addin for FbEdit ( Gui ) with window9.bi

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

Addin for FbEdit ( Gui ) with window9.bi

Postby enform » Apr 09, 2019 17:07

Hello,
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)



AddinWindow9.rc

Code: Select all

#define MANIFEST 24
#define IDR_XPMANIFEST1 1

IDR_XPMANIFEST1 MANIFEST "xpmanifest.xml"

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 1 guest