http://r00t.3host.in/emailer.jpg
FIREFLY FORM:
Code: Select all
'--------------------------------------------------------------------------------
Function EMAILERFORM_TO_EN_CHANGE ( _
ControlIndex as Long, _ ' index in Control Array
hWndForm as HWnd, _ ' handle of Form
hWndControl as HWnd, _ ' handle of Control
idTextControl as Long _ ' identifier of text control
) as Long
Function = 0 ' Sub FF_Control_Disable( ByVal hWndControl as HWnd )
' Disable the window.
EnableWindow hWndControl, False
End Sub
End Function
'--------------------------------------------------------------------------------
Function EMAILERFORM_FROMLABEL_STN_CLICKED ( _
ControlIndex as Long, _ ' index in Control Array
hWndForm as HWnd, _ ' handle of Form
hWndControl as HWnd, _ ' handle of Control
idStaticControl as Long _ ' identifier of static control
) as Long
Function = 0 ' change according to your needs
End Function
'--------------------------------------------------------------------------------
Function EMAILERFORM_TABCONTROL1_TCN_SELCHANGE ( _
ControlIndex as Long, _ ' index in Control Array
hWndForm as HWnd, _ ' handle of Form
hWndControl as HWnd, _ ' handle of Control
ByVal lpNMHDR as NMHDR Ptr _ ' pointer to NMHDR
) as Long
Function = 0 ' change according to your needs
End Function
'--------------------------------------------------------------------------------
Function EMAILERFORM_SENDTOEMAILFRAME_CUSTOM ( _
ControlIndex as Long, _ ' index in Control Array
hWndForm as HWnd, _ ' handle of Form
hWndControl as HWnd, _ ' handle of Control
wMsg as UInteger, _ ' type of message
wParam as WPARAM, _ ' first message parameter
lParam as LPARAM _ ' second message parameter
) as Long
Function = 0 ' change according to your needs
End Function
'--------------------------------------------------------------------------------
Function EMAILERFORM_UPDOWN1_CUSTOM ( _
ControlIndex as Long, _ ' index in Control Array
hWndForm as HWnd, _ ' handle of Form
hWndControl as HWnd, _ ' handle of Control
wMsg as UInteger, _ ' type of message
wParam as WPARAM, _ ' first message parameter
lParam as LPARAM _ ' second message parameter
) as Long
Function = 0 ' change according to your needs
End Function
'--------------------------------------------------------------------------------
Function EMAILERFORM_RICHEDIT1_EN_SELCHANGE ( _
ControlIndex as Long, _ ' index in Control Array
hWndForm as HWnd, _ ' handle of Form
hWndControl as HWnd, _ ' handle of Control
idTextControl as Long, _ ' identifier of text control
ByVal lpSelChange as SELCHANGE Ptr _ ' pointer to SELCHANGE structure
) as Long
Function = 0 ' change according to your needs
End Function
'--------------------------------------------------------------------------------
Function EMAILERFORM_EMAILSUBJECT_EN_CHANGE ( _
ControlIndex as Long, _ ' index in Control Array
hWndForm as HWnd, _ ' handle of Form
hWndControl as HWnd, _ ' handle of Control
idTextControl as Long _ ' identifier of text control
) as Long
Function = 0 ' change according to your needs
End Function
'--------------------------------------------------------------------------------
Function EMAILERFORM_BROSWFILEPATHOPTION_BN_CLICKED ( _
ControlIndex as Long, _ ' index in Control Array
hWndForm as HWnd, _ ' handle of Form
hWndControl as HWnd, _ ' handle of Control
idButtonControl as Long _ ' identifier of button
) as Long
Function = 0 ' change according to your needs
End Function
'--------------------------------------------------------------------------------
Function EMAILERFORM_SENDFILECHECKBOX_BN_CLICKED ( _
ControlIndex as Long, _ ' index in Control Array
hWndForm as HWnd, _ ' handle of Form
hWndControl as HWnd, _ ' handle of Control
idButtonControl as Long _ ' identifier of button
) as Long
Function = 0 ' change according to your needs
End Function
FBIDE (.bas)
Code: Select all
'------------------------------------------------------------------------------
' Source code generated by FireFly Visual Designer Version: 3.78
' Generated: Monday August 28, 2017 at 01:12:23 AM
' Visit www.planetsquires.com for more information
'------------------------------------------------------------------------------
#Lang "FB"
#Include once "windows.bi"
#IncLib "gdiplus"
#Include Once "win\gdiplus.bi"
#ifdef __FB_64BIT__
#if __FB_VERSION__ >= "1.04"
Using gdiplus
#EndIf
#Else
Using gdiplus
#EndIf
#Include once "win/commctrl.bi" ' needed for WinXP Theme support
#Include once "win/commdlg.bi"
#Include once "win/richedit.bi"
' Place your user defined Declares, Constants, and #Include files below this line. FireFly will not
' parse any of your defined #Include files - it simply includes it in the final generated code.
' -------------------------------------------------------------------------------------------------
'[END_APPSTART]
Dim Shared gFLY_RichEditClass As zString * MAX_PATH
Dim Shared gFLY_AppID As zString * MAX_PATH
Dim Shared gFLY_FontHandles(Any) As HFONT
Dim Shared gFLY_hDlgCurrent As HWND
#Define DQ 34 ' double quote
#if __FB_VERSION__ < "1.02"
#define ENM_PARAGRAPHEXPANDED &h00000020
#define LV_COLUMNA LVCOLUMNA
#define LV_COLUMNW LVCOLUMNW
#define NM_LISTVIEW NMLISTVIEW
#define LV_ITEMA LVITEMA
#define LV_ITEMW LVITEMW
#define GCLP_HBRBACKGROUND GCL_HBRBACKGROUND
#endif
#Include Once "win/shlobj.bi"
Type FLY_RESCALEDATA
FormInit As Long ' Form initial width or height
FormCur As Long ' Form current width or height
P_Init As Long ' Point initial value
P_New As Long ' Point newly calculated value
End Type
' Structure that holds Form/Control information
Type FLY_DATA
OldProc As WNDPROC ' address to old window procedure
hWndControl As HWND ' handle of the control
hWndParent As HWND ' handle of the parent
IsForm As Long ' flag indicating that this is a Form
IsModal As Long ' flag indicating modal form
hFont As HFONT ' handle to font
hAccel As HACCEL ' handle to accelerator table
hBackBitmap As HBITMAP ' handle of background form bitmap
hStatusBarTimer as Long ' handle of timer for statusbar
ControlIndex As Long ' controlindex of control
CtrlFocus As HWND ' control with current focus
SelText As Long ' flag to highlight text in edit controls
ProcessCtlColor As Long ' flag to process color messages
IsForeSysColor As Long ' flag indicating to use system color
IsBackSysColor As Long ' flag indicating to use system color
hBackBrush As HBRUSH ' brush for background color
nForeColor As Long ' foreground color
nBackColor As Long ' background color
fResizeInit As Long ' flag signaling that resize has been initialized
rcForm As Rect ' Rectangle holding the Form's client dimensions (resizing)
rcCtrl As Rect ' Rectangle of the control in client relative dimensions (resizing)
zConstraints As zString * 30 ' resize constraints
End Type
' Common info that the programmer can access via the Shared APP variable.
Type APP_TYPE
Comments As zString * MAX_PATH ' Comments
CompanyName As zString * MAX_PATH ' Company Name
EXEName As zString * MAX_PATH ' EXE name of program
FileDescription As zString * MAX_PATH ' File Description
hInstance As HINSTANCE ' Instance handle of the program
Path As zString * MAX_PATH ' Current Path to the EXE
ProductName As zString * MAX_PATH ' Product Name
LegalCopyright As zString * MAX_PATH ' Legal Copyright
LegalTrademarks As zString * MAX_PATH ' Legal Trademarks
ProductMajor As Long ' Product Major number
ProductMinor As Long ' Product Minor number
ProductRevision As Long ' Product Revision number
ProductBuild As Long ' Product Build number
FileMajor As Long ' File Major number
FileMinor As Long ' File Minor number
FileRevision As Long ' File Revision number
FileBuild As Long ' File Build number
ReturnValue As Long ' User value returned from FF_FormClose
End Type
Dim Shared App As APP_TYPE
Function FF_Remain_Internal( ByRef sMainString as String, _
ByRef sMatchPattern as String _
) as String
Dim nLenMain as Long = Len(sMainString)
Dim i as Long
i = InStr(sMainString, sMatchPattern)
If i Then
Function = Mid(sMainString,i+1)
Else
Function = ""
End If
End Function
' =====================================================================================
' Get the Windows version (based on code from Jose Roca)
' =====================================================================================
FUNCTION AfxGetWindowsVersion () AS Single
Dim dwVersion AS Long
Dim nMajorVer As Long
Dim nMinorVer As Long
dwVersion = GetVersion
nMajorVer = LOBYTE(LOWORD(dwVersion))
nMinorVer = HIBYTE(LOWORD(dwVersion))
FUNCTION = nMajorVer + (nMinorVer / 100)
END FUNCTION
' =====================================================================================
' Scales an horizontal coordinate according the DPI (dots per pixel) being used by the application.
' Based on code from Jsoe Roca
' =====================================================================================
Function AfxScaleX (BYVAL cx AS SINGLE) AS SINGLE
#IfDef FF_NOSCALE
Function = cx
#Else
Dim hDC As HDC
hDC = GetDC(Null)
Function = cx * (GetDeviceCaps(hDC, LOGPIXELSX) / 96)
ReleaseDC Null, hDC
#EndIf
End Function
' =====================================================================================
' Scales a vertical coordinate according the DPI (dots per pixel) being used by the application.
' Based on code from Jose Roca
' =====================================================================================
Function AfxScaleY (BYVAL cy AS SINGLE) AS SINGLE
#IfDef FF_NOSCALE
Function = cy
#Else
Dim hDC As HDC
hDC = GetDC(Null)
Function = cy * (GetDeviceCaps(hDC, LOGPIXELSY) / 96)
ReleaseDC Null, hDC
#EndIf
End Function
' =====================================================================================
' =====================================================================================
' Based on code from Jose Roca
' Creates a standard tooltip for a window's entire client area.
' Parameters:
' - hwnd = Handle to the window
' - strTooltipText = Tooltip text
' - bBalloon = Ballon tip (TRUE or FALSE)
' Return Value:
' The handle of the tooltip control
' =====================================================================================
Function FF_AddTooltip( BYVAL hwnd AS HWND, strTooltipText AS STRING, BYVAL bBalloon AS Long ) As HWND
IF hwnd = 0 Then Exit Function
Dim hwndTT AS HWND
Dim dwStyle As Long
dwStyle = WS_POPUP OR TTS_NOPREFIX OR TTS_ALWAYSTIP
IF bBalloon THEN dwStyle = dwStyle OR TTS_BALLOON
hwndTT = CreateWindowEx(WS_EX_TOPMOST, "tooltips_class32", "", dwStyle, 0, 0, 0, 0, 0, Cast(HMENU, Null), 0, ByVal Cast(LPVOID, Null))
IF hwndTT = 0 THEN Exit Function
SetWindowPos(hwndTT, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE OR SWP_NOSIZE OR SWP_NOACTIVATE)
' // Register the window with the tooltip control
Dim tti AS TOOLINFO
tti.cbSize = SIZEOF(tti)
tti.uFlags = TTF_SUBCLASS
tti.hwnd = hwnd
tti.hinst = GetModuleHandle(BYVAL NULL)
GetClientRect(hwnd, Varptr(tti.rect))
' // The length of the string must not exceed of 80 characters, including the terminating null
IF LEN(strTooltipText) > 79 THEN strTooltipText = LEFT(strTooltipText, 79)
tti.lpszText = STRPTR(strTooltipText)
tti.uId = 0
SendMessage hwndTT, TTM_ADDTOOL, 0, Cast(LPARAM, Varptr(tti))
Function = hwndTT
End Function
' Declares/equates for all functions, Forms and Controls in the project
' Modules specified with ParseModule property set to False
' Modules specified with ParseModule property set to True
#Include Once "CODEGEN_EMAILER_DECLARES.inc"
#Include Once "CODEGEN_EMAILER_UTILITY.inc"
#Include Once "CODEGEN_EMAILER_FORM1_FORM.inc"
'#PARSESTART# 'do not delete this line
Function FF_WINMAIN( ByVal hInstance As HINSTANCE, _
ByVal hPrevInstance As HINSTANCE, _
ByRef lpCmdLine As String, _
ByVal iCmdShow As Long ) As Long
' If this function returns TRUE (non-zero) then the actual WinMain will exit
' thus ending the program. You can do program initialization in this function.
Function = FALSE 'return TRUE if you want the program to end.
End Function
'[END_WINMAIN]
Function FF_PUMPHOOK( uMsg As Msg ) As Long
' If this function returns FALSE (zero) then the processing of the regular
' FireFly message pump will continue. Returning TRUE (non-zero) will bypass
' the regular message pump.
Function = FALSE ' return TRUE if you need to bypass the FireFly message pump
End Function
'[END_PUMPHOOK]
Sub FLY_InitializeVariables()
' All FireFly variables relating to Forms and Controls are initialized here. This
' includes any Control Arrays that have been defined and control identifiers
' per the listing in the Declares include file.
IDC_FORM1_OPTION1 = 1000
IDC_FORM1_LABEL1 = 1001
IDC_FORM1_TEXT5 = 1002
IDC_FORM1_TEXT4 = 1003
IDC_FORM1_COMMAND1 = 1004
IDC_FORM1_TEXT3 = 1005
IDC_FORM1_VSCROLL1 = 1006
IDC_FORM1_TEXT2 = 1007
IDC_FORM1_LABEL4 = 1008
IDC_FORM1_LABEL3 = 1009
IDC_FORM1_TEXT1 = 1010
IDC_FORM1_LABEL2 = 1011
IDC_FORM1_IPCONTROL1 = 1012
IDC_FORM1_SENDFILE = 1013
IDC_FORM1_PROGRESSBAR1 = 1014
IDC_FORM1_FRAME1 = 1015
End Sub
Sub FLY_SetAppVariables()
' All FireFly App variables are initialized here. This Type variable provides
' easy access to many commonly used FireFly settings.
Dim zTemp As zString * MAX_PATH
Dim x As Long
App.CompanyName = ""
App.FileDescription = ""
App.ProductName = ""
App.LegalCopyright = ""
App.LegalTrademarks = ""
App.Comments = ""
App.ProductMajor = 1
App.ProductMinor = 0
App.ProductRevision = 0
App.ProductBuild = 0
App.FileMajor = 1
App.FileMinor = 0
App.FileRevision = 0
App.FileBuild = 0
' App.hInstance is set in WinMain/LibMain
' Retrieve program full path and EXE/DLL name
GetModuleFileName App.hInstance, zTemp, MAX_PATH
x = InStr(-1, zTemp, Any ":/\")
If x Then
App.Path = Left(zTemp, x)
App.EXEname = Mid(zTemp, x + 1)
Else
App.Path = ""
App.EXEname = zTemp
End If
' The following two arrays are used to allow FireFly to reuse font
' handles that are common to one or more Controls. This saves us
' from consuming a GDI resource for every created control font.
ReDim gFLY_FontNames(0) As String
ReDim gFLY_FontHandles(0) As HFONT
End Sub
Function FLY_AdjustWindowRect( ByVal hWndForm As HWND, _
ByVal cxClient As Long , _
ByVal cyClient As Long _
) As Long
Dim dwStyle As Long
Dim hMenu As HMENU
Dim rc As Rect
If (cxClient <> 0) And (cyClient <> 0) Then
dwStyle = GetWindowLongPtr( hWndForm, GWL_STYLE )
rc.Left = 0: rc.Top = 0: rc.Right = cxClient: rc.Bottom = cyClient
hMenu = GetMenu( hWndForm )
AdjustWindowRectEx VarPtr(rc), dwStyle, (hMenu <> 0), GetWindowLongPtr(hWndForm, GWL_EXSTYLE)
If (dwStyle and WS_HSCROLL) = WS_HSCROLL Then rc.Bottom = rc.Bottom + GetSystemMetrics(SM_CYHSCROLL)
If (dwStyle and WS_VSCROLL) = WS_VSCROLL Then rc.Right = rc.Right + GetSystemMetrics(SM_CXVSCROLL)
SetWindowPos hWndForm, 0, 0, 0, _
rc.Right-rc.Left, rc.Bottom-rc.Top, _
SWP_NOZORDER Or SWP_NOMOVE Or SWP_NOACTIVATE
End If
Function = 0
End Function
' Enum all child windows of the Form (basically, all Controls) in order to handle
' the WM_SYSCOLORCHANGE message. This will delete existing brushes and recreate
' them using the new system colors.
Function FLY_EnumSysColorChangeProc( ByVal hWnd As HWND, lParam As LPARAM ) As Long
Dim ff As FLY_DATA Ptr
ff = GetProp(hWnd, "FLY_PTR")
If ff Then
If ff->ProcessCtlColor Then
' Create the new colors/brushes if we are using System colors
If ff->IsForeSysColor Then ff->nForeColor = GetSysColor(ff->nForeColor)
If ff->IsBackSysColor Then
If ff->hBackBrush Then DeleteObject(Cast(HGDIOBJ, ff->hBackBrush))
ff->hBackBrush = GetSysColorBrush(ff->nBackColor)
End If
End If
End If
Function = TRUE
End Function
Function FLY_SetControlData( ByVal hWndControl As HWND, _
ByVal AllowSubclass As Long , _
ByVal AllowSetFont As Long , _
ByRef sFontString As String, _
ByVal nControlIndex As Long , _
ByVal nProcessColor As Long , _
ByVal IsForeSysColor As Long , _
ByVal IsBackSysColor As Long , _
ByVal nForeColor As Long , _
ByVal nBackColor As Long , _
ByVal nTransparentBrush As HBRUSH, _
ByVal CodeProcedure As WNDPROC, _
sResizeRules As String, _
ByVal nFontUpgrade As Long _
) As FLY_DATA ptr
Dim zClassName As zString * 50
Dim sFont As String
Dim ff As FLY_DATA Ptr
ff = HeapAlloc( GetProcessHeap(), HEAP_ZERO_MEMORY, SizeOf(*ff) )
If ff Then
' Store the pointer for later use
SetProp hWndControl, "FLY_PTR", ff
' Subclass the control
If AllowSubclass = TRUE Then
ff->OldProc = Cast(WNDPROC,SetWindowLongPtr( hWndControl, GWLP_WNDPROC, Cast(LONG_PTR, CodeProcedure) ))
End If
' Set the Font for this Form/Control
If AllowSetFont = TRUE Then
' FireFly handles two types of font strings. The first is the traditional
' logfont string and the second is the simplified PB version. FireFly is moving
' towards the simplified version but needs to handle the logfont version
' for backwards compatibility.
' If the FontUpgrade property is active then we need to replace the FontName
' based on the current operating system.
If nFontUpgrade <> 0 Then
IF AfxGetWindowsVersion >= 6 THEN ' Vista/Windows 7+
sFontString = "Segoe UI," & FF_Remain_Internal(sFontString, ",")
Else
sFontString = "Tahoma," & FF_Remain_Internal(sFontString, ",")
End If
End If
ff->hFont = FF_MakeFontEx_Internal( sFontString )
If ff->hFont Then
SendMessage hWndControl, WM_SETFONT, Cast(WPARAM,ff->hFont), True
If UCase(zClassName) = "SYSDATETIMEPICK32" Then
SendMessage hWndControl, DTM_SETMCFONT, Cast(WPARAM,ff->hFont), True
End If
End If
End If
ff->ControlIndex = nControlIndex
ff->IsForm = FALSE
ff->hwndControl = hWndControl
ff->zConstraints = sResizeRules
' Flag to process the WM_CTLCOLOR??? messages.
ff->ProcessCtlColor = nProcessColor
If ff->ProcessCtlColor Then
ff->IsForeSysColor = IsForeSysColor
ff->IsBackSysColor = IsBackSysColor
ff->nForeColor = nForeColor
ff->nBackColor = nBackColor
' Create a Brush for painting the background of this Control.
If nTransparentBrush <> Cast(HBRUSH,-1) Then
ff->hBackBrush = nTransparentBrush
Else
ff->hBackBrush = IIF( ff->IsBackSysColor, GetSysColorBrush(ff->nBackColor), CreateSolidBrush(ff->nBackColor) )
End If
End If
End If
Function = ff ' return the pointer to the data structure
End Function
Function FLY_DoMessagePump( ByVal ShowModalFlag As Long, _
ByVal hWndForm As HWND, _
ByVal hWndParent As HWND, _
ByVal nFormShowState As Long, _
ByVal IsMDIForm As Long _
) As HWND
Dim zTempString As zString * MAX_PATH
Dim hWndActive As HWND
Dim msg As MSG
Dim ff As FLY_DATA Ptr
ff = GetProp( hWndForm, "FLY_PTR" )
If ff = 0 Then Exit Function
' If this is an MDI child form, then it can not be displayed as modal.
If ( GetWindowLongPtr(hWndForm, GWL_EXSTYLE) And WS_EX_MDICHILD ) = WS_EX_MDICHILD Then ShowModalFlag = FALSE
If ShowModalFlag = TRUE Then
' Determine the top level window of the active control
WHILE (GetWindowLongPtr(hWndParent, GWL_STYLE) AND WS_CHILD) <> 0
hWndParent = GetParent(hWndParent)
IF (GetWindowLongPtr(hWndParent, GWL_EXSTYLE) AND WS_EX_MDICHILD) <> 0 THEN EXIT WHILE
WEND
' Set property to show that this is a Modal Form. The hWndParent is
' stored in a property because that window needs to be re-enabled
' prior to modal form being destroyed and exiting the modal message loop.
ff->IsModal = TRUE
ff->hWndParent = hWndParent
' Disable Mouse and keyboard input for the Parent Form
If hWndParent <> 0 Then EnableWindow( hWndParent, False )
ShowWindow hWndForm, nFormShowState
UpdateWindow hWndForm
' Main message loop:
Do While GetMessage( @Msg, 0, 0, 0 )
' Exit the modal message loop if the Form was destroyed (important).
If IsWindow(hWndForm) = FALSE Then Exit Do
If msg.message = WM_QUIT Then Exit Do
If FF_PUMPHOOK(Msg) = 0 Then
If IsMDIForm = TRUE Then
If TranslateMDISysAccel(hWndForm, @Msg) <> 0 Then Continue Do
End If
If TranslateAccelerator(hWndForm, ff->hAccel, @Msg) = 0 Then
hWndActive = FLY_GetActiveHandle(gFLY_hDlgCurrent)
' Handle the strange situation where pressing ESCAPE in a multiline
' textbox causes the application to receive a WM_CLOSE that could
' cause an application to terminate. also allow the TAB key to move
' in and out of a multiline textbox.
GetClassName GetFocus, zTempString, SizeOf(zTempString)
Select Case Ucase(zTempString)
Case "EDIT", Ucase(gFLY_RichEditClass)
IF (GetWindowLongPtr(GetFocus, GWL_STYLE) AND ES_MULTILINE) = ES_MULTILINE THEN
If (msg.message = WM_KEYDOWN) And (Msg.wParam = VK_ESCAPE) Then
msg.message = WM_COMMAND
msg.wParam = MakeLong(IDCANCEL, 0)
msg.lParam = 0
ElseIf (Msg.message = WM_CHAR) And (Msg.wParam = 9) Then
' allow the Tab key to tab out of a multiline textbox
If (GetAsyncKeyState(VK_SHIFT) And &H8000) = 0 Then
SetFocus GetNextDlgTabItem( GetParent(Msg.hWnd), Msg.hWnd, FALSE )
Else
SetFocus GetNextDlgTabItem( GetParent(Msg.hWnd), Msg.hWnd, TRUE )
End If
msg.message = WM_NULL
End If
End If
End Select
If (hWndActive = 0) Or (IsDialogMessage(hWndActive, @Msg) = 0) Then
TranslateMessage @Msg
DispatchMessage @Msg
End If
End If
End If
Loop
Function = Cast(HWND, Cast(LONG_PTR,App.ReturnValue))
App.ReturnValue = 0
Else
ShowWindow hWndForm, nFormShowState
Function = hWndForm
End If
End Function
Function FLY_GetActiveHandle( ByVal hWnd As HWND ) as HWND
Static szClassName As zString * 100
' Determine the top level window of the active control
Do While (GetWindowLongPtr(hWnd, GWL_STYLE) AND WS_CHILD) <> 0
IF (GetWindowLongPtr(hWnd, GWL_EXSTYLE) AND WS_EX_MDICHILD) <> 0 THEN EXIT DO
GetClassName hWnd, szClassName, SizeOf(szClassName)
If Left(szClassName, 5) = "FORM_" Then EXIT DO
hWnd = GetParent(hWnd)
loop
FUNCTION = hWnd
End Function
Function FLY_ResizeRuleInitEnum( ByVal hWnd As HWND, ByVal lParam As LPARAM ) As Long
Dim ff As FLY_DATA Ptr
ff = GetProp(hWnd, "FLY_PTR")
If ff = 0 Then Function = TRUE: Exit Function
If ff->fResizeInit = TRUE Then Function = TRUE: Exit Function
' Store form width and height for future reference
GetClientRect GetParent(hWnd), Varptr(ff->rcForm)
' Get the control's rectangle and convert it to client coordinates
GetWindowRect hWnd, Varptr(ff->rcCtrl)
MapWindowPoints 0, GetParent(hWnd), Cast(LPPOINT,Varptr(ff->rcCtrl)), 2
ff->fResizeInit = TRUE
Function = TRUE
End Function
Function FLY_ResizeRuleEnum( ByVal hWnd As HWND, ByVal lParam As LPARAM ) As Long
Dim buf(1 To 4) As FLY_RESCALEDATA
Dim i As Long
Dim Constr As String
Dim Constraints As String
Dim ConstrRef As String
Dim RefPntPercentage As Single
Dim ControlName As String
Dim rc As Rect
Dim ff As FLY_DATA Ptr
ff = GetProp(hWnd, "FLY_PTR")
If ff = 0 Then Function = TRUE: Exit Function
If ff->fResizeInit = FALSE Then Function = TRUE: Exit Function
Constraints = UCase(ff->zConstraints)
if Len(Constraints) < 7 Then Function = TRUE: Exit Function
' Control was already initialized. Get its initial coordinates to be used for reference.
' Store the controls initial coordinates in the calculation buffer.
' One entry for every side of the control.
Buf(1).P_Init = ff->rcCtrl.Left ' Left x-coordinate of the control
Buf(2).P_Init = ff->rcCtrl.Top ' Top y-coordinate of the control
Buf(3).P_Init = ff->rcCtrl.Right ' Right x-coordinate of the control
Buf(4).P_Init = ff->rcCtrl.Bottom ' Bottom y-coordinate of the control
' Store the form's width and height in the calculation buffer.
' One entry for every side of the form
Buf(1).FormInit = ff->rcForm.Right ' For Left x-coordinate of the control
Buf(2).FormInit = ff->rcForm.Bottom ' For Top y-coordinate of the control
Buf(3).FormInit = ff->rcForm.Right ' For Right x-coordinate of the control
Buf(4).FormInit = ff->rcForm.Bottom ' For Bottom y-coordinate of the control
' -------------------------------------------------------------------------------
' (2) Get current dimensions of form and store the coordinates in a
' buffer to be calculated later on
' -------------------------------------------------------------------------------
GetClientRect GetParent(hWnd), Varptr(rc)
Buf(1).FormCur = rc.Right ' Left x-coordinate
Buf(2).FormCur = rc.Bottom ' Top y-coordinate
Buf(3).FormCur = rc.Right ' Right x-coordinate
Buf(4).FormCur = rc.Bottom ' Bottom y-coordinate
' -------------------------------------------------------------------------------
' (3) Calculate new control coordinates (for every one of the 4 control sides)
' -------------------------------------------------------------------------------
For i = 1 To 4
Constr = FF_Parse(Constraints, ",", i)
Select Case Left(Constr, 1)
Case "S" ' Scaled coordinate
Buf(i).P_New = Buf(i).P_Init * (Buf(i).FormCur / Buf(i).FormInit)
Case "F" ' Fixed coordinate
ConstrRef = Mid(Constr, 2) ' Remove the "F"
Select Case ConstrRef
Case "L" : RefPntPercentage = 0 ' Left side
Case "R" : RefPntPercentage = 100 ' Right side
Case "T" : RefPntPercentage = 0 ' Top
Case "B" : RefPntPercentage = 100 ' Bottom
Case Else ' Must have been a number
RefPntPercentage = Val(ConstrRef)
End Select
' Calc the new position
Buf(i).P_New = Buf(i).P_Init - _
(Buf(i).FormInit * (RefPntPercentage / 100)) + _
(Buf(i).FormCur * (RefPntPercentage / 100))
Case Else
'MsgBox "Unknown constraint parameter:" & Left$(Constr, 1) & " in " & Constraints
End Select
Next
' -------------------------------------------------------------------------------
' (4) Redraw the control
' -------------------------------------------------------------------------------
SetWindowPos hWnd, 0, _
Buf(1).P_New, Buf(2).P_New, _
Buf(3).P_New - Buf(1).P_New, Buf(4).P_New - Buf(2).P_New, _
SWP_NOZORDER
Function = TRUE ' Continue enumeration of children
End Function
Function WinMain( ByVal hInstance As HINSTANCE, _
ByVal hPrevInstance As HINSTANCE, _
ByRef lpCmdLine As String, _
ByVal iCmdShow As Long _
) As Long
' Initialize the Common Controls. This is necessary on WinXP platforms in order
' to ensure that the XP Theme styles work.
Dim uCC As INITCOMMONCONTROLSEX
Dim hLib As HINSTANCE
uCC.dwSize = SizeOf(uCC)
uCC.dwICC = ICC_NATIVEFNTCTL_CLASS Or ICC_COOL_CLASSES Or ICC_BAR_CLASSES Or _
ICC_TAB_CLASSES Or ICC_USEREX_CLASSES Or ICC_WIN95_CLASSES Or _
ICC_STANDARD_CLASSES Or ICC_ANIMATE_CLASS Or ICC_DATE_CLASSES Or _
ICC_HOTKEY_CLASS Or ICC_INTERNET_CLASSES Or ICC_LISTVIEW_CLASSES Or _
ICC_PAGESCROLLER_CLASS Or ICC_PROGRESS_CLASS Or ICC_TREEVIEW_CLASSES Or _
ICC_UPDOWN_CLASS
InitCommonControlsEx VarPtr(uCC)
' RichEdit 4.1 (Windows XP)
hLib = LoadLibrary("MSFTEDIT.DLL")
IF hLib THEN
gFLY_RichEditClass = "RichEdit50W"
Else
' Try RichEdit 2.0 or 3.0
hLib = LoadLibrary("RICHED20.DLL")
IF hLib THEN
gFLY_RichEditClass = "RichEdit20A"
Else
' Try RichEdit 1.0
hLib = LoadLibrary("RICHED32.DLL")
IF hLib THEN
gFLY_RichEditClass = "RichEdit"
End If
End If
END IF
' Define variable used to uniquely identify this application. This is used
' by the FireFly function FF_PrevInstance.
gFLY_AppID = "FORM_Emailer_Form1_CLASS"
' Define Control Arrays if necessary
FLY_InitializeVariables
' Set the values for the Shared App variable
App.hInstance = hInstance
FLY_SetAppVariables
' Initialize the GDI+ library
Dim gdipToken As ULONG_PTR
Dim gdipsi As GdiplusStartupInput
gdipsi.GdiplusVersion = 1
GdiplusStartup( @gdipToken, @gdipsi, Null )
' Call the Function FLY_WinMain(). If that function returns True
' then cease to continue execution of this program.
If FF_WINMAIN(hInstance, hPrevInstance, lpCmdLine, iCmdShow) Then
Function = App.ReturnValue
Exit Function
End If
' Create the Startup Form.
Form1_Show 0, TRUE
' Shutdown the GDI+ library
GdiplusShutdown( gdipToken )
Function = App.ReturnValue
End Function
End WinMain( GetModuleHandle( null ), null, Command(), SW_NORMAL )