' Lock the block to get a far pointer ' to this memory. lpGlobalMemory = GlobalLock(hGlobalMemory)
' Copy the string to this global memory. lpGlobalMemory = lstrcpy(lpGlobalMemory, sS)
' Unlock the memory. If GlobalUnlock(hGlobalMemory) <> 0 Then Call fnMsgBoxErrOK("fnCLPSetData" + vbCrLf + _ "Could Not unlock memory location. Copy aborted.", _ "Ошибка") fnCLPSetData = "" GoTo l_End End If
' Open the Clipboard to copy data to. If OpenClipboard(0&) = 0 Then Call fnMsgBoxErrOK("fnCLPSetData" + vbCrLf + _ "Could Not Open the Clipboard. Copy aborted.", _ "Ошибка") fnCLPSetData = "" Exit Function End If
' Clear the Clipboard. X = EmptyClipboard()
' Copy the data to the Clipboard. hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
l_End:
If CloseClipboard() = 0 Then Call fnMsgBoxErrOK("fnCLPSetData" + vbCrLf + _ "Could Not close Clipboard.", "Ошибка") End If
fnCLPSetData = sS End Function
Function fnCLPGetData() Dim hClipMemory As Long Dim lpClipMemory As Long Dim sS As String Dim RetVal As Long
If OpenClipboard(0&) = 0 Then Call fnMsgBoxErrOK("fnCLPGetData" + vbCrLf + _ "Could Not Open the Clipboard. Another " & _ "application may have it open", "Ошибка") Exit Function End If
' Obtain the handle to the global memory ' block that is referencing the text. hClipMemory = GetClipboardData(CF_TEXT) If IsNull(hClipMemory) Then Call fnMsgBoxErrOK("fnCLPGetData" + vbCrLf + _ "Could Not allocate memory", "Ошибка") GoTo l_End End If
' Lock Clipboard memory so we can reference ' the actual data string. lpClipMemory = GlobalLock(hClipMemory)
If Not IsNull(lpClipMemory) Then sS = Space$(MAXSIZE) RetVal = lstrcpy(sS, lpClipMemory) RetVal = GlobalUnlock(hClipMemory)
' Peel off the null terminating character. sS = Mid(sS, 1, InStr(1, sS, Chr$(0), 0) - 1) Else Call fnMsgBoxErrOK("fnCLPGetData" + vbCrLf + _ "Could Not lock memory to copy String from.", _ "Ошибка") End If
l_End:
RetVal = CloseClipboard() fnCLPGetData = sS
End Function
Function fnCLPSetDigit(doD As Double) As Double fnCLPSetDigit = _ val(fnCLPSetData(fnReplace(Str(doD), ",", "."))) End Function
Function fnCLPGetDigit() As Double fnCLPGetDigit = _ val(fnReplace(fnCLPGetData(), ",", ".")) End Function
Function fnCLPAdd(doDigit As Double) As Double fnCLPAdd = fnCLPSetDigit((fnCLPGetDigit() + doDigit)) End Function
Function fnCLPSubstract(doDigit As Double) As Double fnCLPSubstract = _ fnCLPSetDigit((fnCLPGetDigit() - doDigit)) End Function
Function fnCLPSubstractViceVersa(doDigit As Double) _ As Double fnCLPSubstractViceVersa = _ fnCLPSetDigit((doDigit - fnCLPGetDigit())) End Function
Function fnCLPMultiply(doDigit As Double) As Double fnCLPMultiply = _ fnCLPSetDigit((fnCLPGetDigit() * doDigit)) End Function
Function fnCLPDivide(doDigit As Double) As Double If doDigit <> 0 Then fnCLPDivide = _ fnCLPSetDigit((fnCLPGetDigit() / doDigit)) Else Call fnMsgBoxErrOK("Деление на ноль.", "Ошибка") End If End Function
Function fnCLPDivideViceVersa(doDigit As Double) _ As Double If fnCLPGetDigit() <> 0 Then fnCLPDivideViceVersa = _ fnCLPSetDigit((doDigit / fnCLPGetDigit())) Else Call fnMsgBoxErrOK("Деление на ноль.", "Ошибка") End If End Function
Function fnCLPAddLocal() On Error Resume Next Dim sCLPOldData As String sCLPOldData = Str(fnCLPGetDigit()) fnCLPAddLocal = _ fnCLPAdd(val(fnReplace(Str(Screen.ActiveControl.Value), ",", "."))) Application.Echo True, _ sCLPOldData + " + " + _ Str(Screen.ActiveControl.Value) + "=" + fnCLPGetDigit() End Function
Function fnCLPSubstractLocal() On Error Resume Next Dim sCLPOldData As String sCLPOldData = Str(fnCLPGetDigit()) fnCLPSubstractLocal = _ fnCLPSubstract _ (val(fnReplace(Str(Screen.ActiveControl.Value), ",", "."))) Application.Echo True, sCLPOldData _ + " - " + Str(Screen.ActiveControl.Value) _ + "=" + fnCLPGetDigit() End Function
Function fnCLPMultiplyLocal() On Error Resume Next Dim sCLPOldData As String sCLPOldData = Str(fnCLPGetDigit()) fnCLPMultiplyLocal = _ fnCLPMultiply _ (val(fnReplace(Str(Screen.ActiveControl.Value) _ , ",", "."))) Application.Echo True, sCLPOldData _ + " * " + Str(Screen.ActiveControl.Value) + "=" + _ fnCLPGetDigit() End Function
Function fnCLPDivideLocal() On Error Resume Next Dim sCLPOldData As String sCLPOldData = Str(fnCLPGetDigit()) fnCLPDivideLocal = _ fnCLPDivide _ (val(fnReplace(Str(Screen.ActiveControl.Value) _ , ",", "."))) Application.Echo True, sCLPOldData _ + " / " + Str(Screen.ActiveControl.Value) _ + "=" + fnCLPGetDigit() End Function
Function fnCLPSubstractViceVersaLocal() On Error Resume Next Dim sCLPOldData As String sCLPOldData = Str(fnCLPGetDigit()) fnCLPSubstractViceVersaLocal = _ fnCLPSubstractViceVersa _ (val(fnReplace(Str(Screen.ActiveControl.Value) _ , ",", "."))) Application.Echo True, _ Str(Screen.ActiveControl.Value) + " - " _ + sCLPOldData + "=" + fnCLPGetDigit() End Function
Function fnCLPDivideViceVersaLocal() On Error Resume Next Dim sCLPOldData As String sCLPOldData = Str(fnCLPGetDigit()) fnCLPDivideViceVersaLocal = _ fnCLPDivideViceVersa _ (val(fnReplace(Str(Screen.ActiveControl.Value) _ , ",", "."))) Application.Echo True, _ Str(Screen.ActiveControl.Value) + " / " + _ sCLPOldData + "=" + fnCLPGetDigit() End Function
Function fnCLPShowOrHide() If fnIsFormVisible("фИнфоВсплывающая") Then DoCmd.Close acForm, "фИнфоВсплывающая" Else DoCmd.OpenForm "фИнфоВсплывающая" DoCmd.MoveSize , 0, 1700, 1000 End If End Function