﻿Dim Shared ansiStr_CodePage As ULong = {CodePage}  '默认A字符代码页，用于不同语言系统之间可以正常显示字符。
Dim Shared String_CharSet As ULong = {CharSet}
'   #if __FB_OUT_EXE__ 
'Sub Setup_ansiStr_CodePage(cd As uLong) '设置代码页
'   ansiStr_CodePage = cd
'   '获取 FB 内置函数代码页保存位置。
'   Dim As Any Ptr library = DyLibLoad( "Kernel32" )
'   If (library = 0) Then Return
'   Dim xxFlsGetValue As Function(ByVal eID As Integer) As UInteger
'   xxFlsGetValue = DyLibSymbol(library, "FlsGetValue")
'   Dim py As Long, ff As UInteger
'   If (xxFlsGetValue = 0) Then
'      xxFlsGetValue = DyLibSymbol(library, "TlsGetValue")
'      ff = xxFlsGetValue(1)
'      If ff = 0 Or ff = xxFlsGetValue Then Return  '有时 XP 的 TlsGetValue返回时自己函数地址。
'      'XP 系统
'      ff += &H64
'   Else  'XP以后的系统
'      ff = xxFlsGetValue(1)
'      If ff = 0 Then Return
'      ff += IIf(Len(UInteger) = 4, &H6C,&HB8)  '64位和32位
'   End if
'   If ff = 0 Then Return
'   ff = Peek(UInteger, ff) + 4
'    *CPtr(uLong Ptr, ff) = cd
'   DyLibFree(library)
'End Sub
'Setup_ansiStr_CodePage({CodePage}) '设置代码页
'   #endif 
Dim Shared vfb_Control_Ptr_Save As Any Ptr '控件数据指针保存处
Function vfb_Get_Control_Ptr(hWndControl As Any Ptr) As Any Ptr '获取控件数据指针
   if vfb_Control_Ptr_Save = 0 Then Return 0
   Dim tsave As Any Ptr Ptr = vfb_Control_Ptr_Save
   Dim ii    As Long
   Do
      For ii = 0 To 198 Step 2
         if tsave[ii] = hWndControl Then Return tsave[ii + 1]
      Next
      if tsave[201] = 0 Then Return 0  '没有下一个指针组
      tsave = tsave[201]
   Loop
End Function
Sub vfb_Set_Control_Ptr(hWndControl As Any Ptr ,pp As Any Ptr)   ' 设置控件数据指针
   '1个数据为：窗口句柄+数据指针  每组数据 100个，第101个是，前1个数据组指针+后1个数据组指针。
   '数据只增加不减少，可以应对多线程操作安全。用完后需要回收，可以保存其它窗口。每个控件只保存唯一指针，重复保存只是更新指针
   '参考 API GetProp SetProp RemoveProp 自己写函数保存比API快而安全。
   if vfb_Control_Ptr_Save = 0 Then vfb_Control_Ptr_Save = CAllocate(SizeOf(Integer) * 202)
   Dim tsave As Any Ptr Ptr = vfb_Control_Ptr_Save
   Dim ii    As Long
   '先寻找是不是重复窗口，有重复就更新
   Do
      For ii = 0 To 198 Step 2
         if tsave[ii] = hWndControl Then
            tsave[ii + 1] = pp
            Return
         End if
      Next
      if tsave[201] = 0 Then Exit Do '没有下一个指针组
      tsave = tsave[201]
   Loop
   '寻找空位置来保存窗口数据指针
   Do
      For ii = 0 To 198 Step 2
         if tsave[ii] = 0 Then
            tsave[ii] = hWndControl
            tsave[ii + 1] = pp
            Return
         End if
      Next
      if tsave[201] = 0 Then  '没有下一组，就创建一个
         tsave[200] = tsave
         tsave[201] = CAllocate(SizeOf(Integer) * 202)
      End if
      tsave = tsave[201]
   Loop
End Sub
Sub vfb_Remove_Control_Ptr(hWndControl As Any Ptr) '删除数据指针
   if vfb_Control_Ptr_Save = 0 Then Return 
   Dim tsave As Any Ptr Ptr = vfb_Control_Ptr_Save
   Dim ii    As Long
   Do
      For ii = 0 To 198 Step 2
         if tsave[ii] = hWndControl Then  '清除数据，为别的控件可以保存数据
            tsave[ii] = 0
            tsave[ii + 1] = 0
            Return
         End if
      Next
      if tsave[201] = 0 Then Return  '没有下一个指针组
      tsave = tsave[201]
   Loop
End Sub

{FF_APPSTART}
#include Once "win/shlobj.bi"   'WIN系统对象库，shell32.dll的头文件，主要涉及shell及通用对话框等。
#include Once "Afx/CWStr.inc"   

' 程序员可以通过共享APP变量访问的公共信息。
Type APP_TYPE
   Comments        As  CWSTR      ' 注释
   CompanyName     As  CWSTR       ' 公司名 
   EXEName         As  CWSTR      ' 程序的EXE名称 
   FileDescription As  CWSTR       ' 文件描述 
   hInstance       As  HINSTANCE                ' 程序的实例句柄
   Path            As  CWSTR      ' EXE的当前路径
   ProductName     As  CWSTR      ' 产品名称 
   LegalCopyright  As  CWSTR       ' 版权所有 
   LegalTrademarks As  CWSTR     ' 商标
   ProductMajor    As Long                    ' 产品主要编号 
   ProductMinor    As Long                    ' 产品次要编号   
   ProductRevision As Long                    ' 产品修订号
   ProductBuild    As Long                    ' 产品内部编号   
   FileMajor       As Long                    ' 文件主要编号     
   FileMinor       As Long                    ' 文件次要编号     
   FileRevision    As Long                    ' 文件修订号  
   FileBuild       As Long                    ' 文件内部编号     
   ReturnValue     As Integer                 ' 返回的用户值
End Type
Dim Shared App As APP_TYPE
Sub Setting_up_Application_Common_Information()
   '设置共享应用程序变量的值
   #if __FB_OUT_EXE__
   App.hInstance = GetModuleHandle(null)
   #else
   Dim mbi as MEMORY_BASIC_INFORMATION
   VirtualQuery(@Setting_up_Application_Common_Information, @mbi, SizeOf(mbi))
   App.hInstance = mbi.AllocationBase
   #endif
   Dim zTemp As WString * MAX_PATH
   Dim x As Long
   App.CompanyName = "{APP_COMPANY_NAME}"
   App.FileDescription = "{APP_FILE_DESCRIPTION}"
   App.ProductName = "{APP_PRODUCTNAME}"
   App.LegalCopyright = "{APP_COPYRIGHT}"
   App.LegalTrademarks = "{APP_TRADEMARKS}"
   App.Comments = "{APP_COMMENTS}"
   
   App.ProductMajor = {APP_PRODUCTMAJOR_VER}
   App.ProductMinor = {APP_PRODUCTMINOR_VER}
   App.ProductRevision = {APP_PRODUCTREVISION_VER}
   App.ProductBuild = {APP_PRODUCTBUILD_VER}
   
   App.FileMajor = {APP_FILEMAJOR_VER}
   App.FileMinor = {APP_FILEMINOR_VER}
   App.FileRevision = {APP_FILEREVISION_VER}
   App.FileBuild = {APP_FILEBUILD_VER}
   
   'App.hInstance 在WinMain / LibMain中设置
   
   '检索程序完整路径和 EXE/DLL 名称
   GetModuleFileNameW App.hInstance, zTemp, MAX_PATH
   x = InStrRev(zTemp, Any ":/\")
   If x Then
      App.Path = Left(zTemp, x)
      App.EXEname = Mid(zTemp, x + 1)
   Else
      App.Path = ""
      App.EXEname = zTemp
   End If
End Sub
Setting_up_Application_Common_Information
' 声明/等同 项目中的所有函数，表单和控件
{ALL_INCLUDES}    

{FF_WINMAIN}

{FF_PUMPHOOK}

Function FLY_Win_Main(ByVal hInstance As HINSTANCE) As Long

   {GDIPLUS_STARTUP}

   ' 调用 FLY_WinMain()函数。 如果该函数返回True，则停止执行该程序。
   If FF_WINMAIN(hInstance) Then Return True
   ' 创建启动窗体。
   #if __FB_OUT_EXE__ 
   {STARTUP_FORM_NAME}
   {GDIPLUS_SHUTDOWN}
   #endif 
   Function = 0
End Function
Public Sub WinMainsexit() Destructor
   FF_WINEND(App.hInstance)
End Sub
FLY_Win_Main( App.hInstance )




