Winlift Wrapper for FreeBASIC

[Peter Weis]

Hello,
the Winlift include for FREEBASIC

Code Select Expand





extern "Windows-MS"
' Init the WinLIFT SkinEngine
  Declare Function skInitEngine Lib "winlift" Alias "skInitEngine" (ByVal p1 as ZString ptr, ByVal p2 as ZString ptr) AS long
 
  'Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" _ (ByVal nBufferLength As Integer, ByVal lpBuffer As String) As Integer

' The main function to skin a window
  Declare Function skSkinWindow Lib "winlift" Alias "skSkinWindow" (byval hWin as HWND, ByVal zSysButTip as ZString ptr) As long

' Disable skinning of a specific control
  DECLARE FUNCTION skSkinDisable Alias "skSkinDisable" (BYVAL hWnd AS HWND) AS Integer

' Enable skinning of a specific control (use it only after a previous call to skSkinDisable)
  DECLARE FUNCTION skSkinEnable Lib "winlift" Alias "skSkinEnable" (BYVAL hWnd AS HWND) AS Integer

' Returns the "Skin" author name and copyright.
  DECLARE FUNCTION skAuthor Lib "winlift" Alias "skAuthor" () AS STRING

  #define WM_SKGETMENUICON           = &H400 + &H7F  ' &H400 = %WM_USER, &H7F  = %WM_GETICON
                                              ' wParam = menu ID, lParam = %NULL

' Anchor child controls
  DECLARE FUNCTION skSetAnchorCtrl Lib "winlift" Alias "skSetAnchorCtrl" (BYVAL hWnd AS HWND, BYVAL AnchorMode AS LONG) AS LONG

'

'****************************************************************************
'*                THESE MUST BE USED WITH WINLIFT's MENU                    *
'****************************************************************************
' Replace the standard DrawMenuBar API, must be used with WinLIFT's menu
  'DECLARE SUB skRedrawMenuBar LIB "WinLIFT" ALIAS "skRedrawMenuBar" (BYVAL hWnd As Integer)

' Note: WinLIFT's menu are not standard menu thus do not use the standard API GetMenu
' to retrieve a menu handle but the specific skGetMenu below.
' Instead of using skGetMenu you can also save the menu handle in a global variable and then
' use this global variable in lieu of the GetMenu API.
  Declare FUNCTION skGetMenu LIB "WinLIFT" ALIAS "skGetMenu" (BYVAL hWnd As HWND) AS integer

' Retrieve the handle of the WinLIFT's menu container
  Declare FUNCTION skMenuContainer LIB "WinLIFT" ALIAS "skMenuContainer" (BYVAL hWnd As HWND) AS LONG
'****************************************************************************
'*                           END OF SKINNED MENU                            *
'****************************************************************************

  Declare FUNCTION skCreateDW LIB "WinLIFT" ALIAS "skCreateDW" (BYVAL hParent AS HWND) AS LONG
  Declare SUB      skDestroyDW LIB "WinLIFT" ALIAS "skDestroyDW" (BYREF hDW AS HWND)

  Declare FUNCTION skDialogAlert LIB "WinLIFT" ALIAS "skDialogAlert" (ByVal zCaption AS ZString ptr, ByVal zMessage AS ZString ptr, ByVal zButton AS ZString Ptr) AS LONG
  Declare FUNCTION skDialogError LIB "WinLIFT" ALIAS "skDialogError" (ByVal zCaption AS ZString ptr, ByVal zMessage AS ZString ptr, ByVal zButton AS ZString ptr) AS LONG
  Declare FUNCTION skDialogInfo LIB "WinLIFT" ALIAS "skDialogInfo" (ByVal zCaption AS ZString ptr, ByVal zMessage AS zstring ptr, ByVal zButton AS ZString ptr) AS LONG
  Declare FUNCTION skDialogYesNo LIB "WinLIFT" ALIAS "skDialogYesNo" (ByVal zCaption AS ZString Ptr, ByVal zMessage AS ZString ptr, ByVal zButton AS ZString ptr) AS LONG
  Declare FUNCTION skDialogInput LIB "WinLIFT" ALIAS "skDialogInput" (ByVal zCaption AS ZString Ptr, ByVal zMessage AS ZString ptr, ByVal zButton AS ZString ptr) AS STRING

  Declare FUNCTION skVersion LIB "WinLIFT" ALIAS "skVersion" () AS STRING

  Declare FUNCTION skCaptionFont LIB "WinLIFT" ALIAS "skCaptionFont" () AS LONG
  Declare FUNCTION skFont LIB "WinLIFT" ALIAS "skFont" () AS LONG
  Declare FUNCTION skFontBold LIB "WinLIFT" ALIAS "skFontBold" () AS LONG
  Declare FUNCTION skFontDlg LIB "WinLIFT" ALIAS "skFontDlg" () AS LONG

  Declare FUNCTION skButtonImage LIB "WinLIFT" ALIAS "skButtonImage" (BYVAL hOwner AS HWND, ByVal zFullpathImageName AS ZString ptr, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL ButID AS LONG, BYVAL StateMax AS LONG) AS LONG
  Declare FUNCTION skBorder LIB "WinLIFT" ALIAS "skBorder" (BYVAL hWnd AS HWND, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL xW AS LONG, BYVAL yH AS LONG, BYVAL nID AS LONG, BYVAL nBorder AS LONG) AS LONG

  Declare FUNCTION skCreateToolTip LIB "WinLIFT" ALIAS "skCreateToolTip" (BYVAL hObj AS HWND, ByVal zText AS ZString Ptr) AS LONG
  Declare SUB skSetToolTipText LIB "WinLIFT" ALIAS "skSetToolTipText" (BYVAL hObj AS HWND, ByVal zText AS ZString Ptr)
  Declare FUNCTION skGetToolTipText LIB "WinLIFT" ALIAS "skGetToolTipText" (BYVAL hObj AS HWND) AS String
 
  End Extern
 
  'Anchor constants
  #define ANCHOR_NONE                   0
  #Define ANCHOR_WIDTH                  1
  #Define ANCHOR_RIGHT                  2
  #Define ANCHOR_CENTER_HORZ            3
  #Define ANCHOR_HEIGHT                 4
  #Define ANCHOR_HEIGHT_WIDTH           5
  #Define ANCHOR_HEIGHT_RIGHT           6
  #Define ANCHOR_BOTTOM                 7
  #Define ANCHOR_BOTTOM_WIDTH           8
  #Define ANCHOR_BOTTOM_RIGHT           9
  #Define ANCHOR_CENTER_HORZ_BOTTOM    10
  #Define ANCHOR_CENTER_VERT           11
  #Define ANCHOR_CENTER_VERT_RIGHT     12
  #Define ANCHOR_CENTER                13


greetings Peter

[Patrice Terrier]

Thank you Peter for this translation of the WinLIFT header to FreeBASIC.

I have never used the FB compiler myself, thus i can't say anything about it.

...

[Peter Weis]

Hello Patrice
Small example Winlift with FreeBASIC

Code Select Expand


/'
Dialog Example, by Peter Weis

compile with: fbc -s gui dialog.rc dialog.bas

'/

'option explicit

#include once "windows.bi"
#Include Once "winlift.bi"

#include "DialogAppRes.bi"

Function DlgProc(byval hDlg as HWND, byval uMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as integer
dim as long id, event, x, y
dim hBtn as HWND
dim rect as RECT

select case uMsg
case WM_INITDIALOG
If skInitEngine("ipod.sks","") Then

        skSkinWindow hdlg, "Dock|Undock|Minimize|Maximize|Restore|Close"
End If
'
case WM_CLOSE
EndDialog(hDlg, 0)
'
case WM_COMMAND
id=loword(wParam)
event=hiword(wParam)
select case id
case IDC_BTN1
EndDialog(hDlg, 0)
'
end select
case WM_SIZE
'GetClientRect(hDlg,@rect)
'hBtn=GetDlgItem(hDlg,IDC_BTN1)
'x=rect.right-100
'y=rect.bottom-35
'MoveWindow(hBtn,x,y,97,31,TRUE)
'
case else
return FALSE
'
end select
return TRUE

End Function

'''
''' Program start
'''

''
'' Create the Dialog
''
DialogBoxParam(GetModuleHandle(NULL), Cast(zstring ptr,IDD_DLG1), NULL, @DlgProc, NULL)
''
'' Program has ended
''
ExitProcess(0)
end

'''
''' Program end
'''



regards Peter

[Patrice Terrier]

The size of the resulting EXE, seems to be rather small, and i can see .obj files, are they LIB compatible?

Do they have a 64-bit version?

[Peter Weis]

Hello Patrice,

the Object files are fully compatible with Microsoft C and C++. You/they can be also linked together!

There is no 64Bit compiler but also. But a C emitter. Did not yet work with it, however!

Greetings Peter

[Patrice Terrier]

Peter,

While speaking of WinLIFT, here is my last baby: Fly! version 3.00
http://forum.flyworship.co.uk/index.php?topic=5.0

using my new "Metro" skin 

...

[Peter Weis]

Hello Patrice,

is a very interesting multimedia project. Why not publish it in the José forum?

Would be happy!

regards Peter

[Patrice Terrier]

Peter

It is a commercial project targeted to musician audience.

...

[Peter Weis]

Hello
My definition of STRING in winlift Wrapper is not right that I have to still change to BSTR
regards Peter

[Peter Weis]

Hello Patrice,

did it again reworked version for FREE BASIC

Because FREE BASIC strings BSTR is not compatible, I've changed again

Have five functions together to make it even with BSTR get along!

The functions FB_skVersion, FB_skDialogInput, FB_skGetToolTipText, FB_skVersion and BSTR_to_FBstr hot that I have stored in Winlift.bas

Code Select Expand


#Include once "windows.bi"
#Include Once "win/unknwn.bi"
#Include Once "win/oleauto.bi"
#Include Once "winlift.bi"


Extern "windows-ms"

Declare Function BSTR_to_FBstr Alias "BSTR_to_FBstr" (ByRef srcBSTR AS BSTR)  AS String

FUNCTION FB_skAuthor Alias "FB_skAuthor" () AS String
Dim s As BSTR

s = skAuthor()
Function = BSTR_to_FBstr(s)
SysFreeString(s)

End Function

FUNCTION FB_skDialogInput Alias "FB_skDialogInput" (ByVal zCaption AS ZString Ptr, ByVal zMessage AS ZString ptr, ByVal zButton AS ZString ptr) AS String
Dim s As bstr

s = skDialogInput(zCaption, zMessage, zButton)
Function = BSTR_to_FBstr(s)
SysFreeString(s)

End Function

Function FB_skVersion ALIAS "FB_skVersion" () AS String
Dim s As BSTR
s = skVersion()
Function = BSTR_to_FBstr(s)
SysFreeString(s)

End Function

FUNCTION FB_skGetToolTipText ALIAS "FB_skGetToolTipText" (BYVAL hObj AS HWND) AS String
Dim s As BSTR
s = skGetToolTipText (hObj)
Function = BSTR_to_FBstr(s)
SysFreeString(s)

End Function



FUNCTION BSTR_to_FBstr Alias "BSTR_to_FBstr" (ByRef srcBSTR AS BSTR)  AS String Export
Dim AS LONG i
Dim AS ANY PTR j
Dim AS STRING s
Asm
mov eax, [srcBSTR]
      mov ecx, [eax-4]
      mov [i], ecx
End ASM
If i>0 THEN
      s = Space(i)
      j = StrPtr(s)
      Asm
        mov esi, [srcBSTR]
        mov edi, [j]
        mov ecx, [i] 'length of data
       
        cld
        Shr ecx, 1
        rep movsw
        jnb NotNext
        movsb
        NotNext:
             
      End ASM
End If

Function = s
End Function


End Extern


regards Peter