Forum - Εμφάνιση ενός μόνο μηνύματος

#2 18-02-09, 19:04

Καλησπέρα και συγχαρητήρια στο νέο αυτό φόρουμ!

Κατ αρχή, δε είμαι σίγουρος αν βρισκόμαστε στην κατάλληλη ενότητα του φόρουμ
(...Εδώ μπορείτε να αποστέλετε διάφορα εργαλεία για τις εφαρμογές σας σε mdb)!

Αγαπητέ φίλε, αν τα αποτελέσματα των πράξεων αυτών σχετίζονται με κάποια πεδία
της φόρμας σου τότε θα χρειαστούν περισσότερες πληροφορίες από την πλευρά σου
προκειμένου να πάρεις μια απάντηση.

Αν πάλι χρειάζεσαι μια απλή αριθμομηχανή, νομίζω ότι θα σ εξυπηρετήσει η αριθμομηχανή
των Windows που με τη χρήση ενός κουμπιού και του παρακάτω κώδικα θα μπορόυσες
να την ανοίγεις κατευθείαν από τη φόρμα.

Σε μια λειτουργική μονάδα πέρασε τον παρακάτω κώδικα:

Κώδικας:

Option Compare Database
Option Explicit

Declare Function FindWindow Lib "user32" Alias _
        "FindWindowA" (ByVal lpClassName As Any, ByVal _
        lpWindowName As Any) As Long

Declare Function SetWindowPos Lib "user32" _
        (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
        ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
        ByVal cy As Long, ByVal wFlags As Long) As Long

Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
        lpRect As Rect) As Long
        
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                   (ByVal hwnd As Long, ByVal lpszOp As String, _
                    ByVal lpszFile As String, ByVal lpszParams As String, _
                    ByVal LpszDir As String, ByVal FsShowCmd As Long) _
                    As Long

Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Const SW_SHOWNORMAL = 1&
Const HWND_TOPMOST = -1&
Const SWP_NOSIZE = &H1

Sub LoadCalc(frmHandle&)

    Dim xHandle&, i%, LRect As Rect, appLeft&, appTop&, _
            frmVM&, frmHM&, appHM&, appVM&, Retval&

    Retval = ShellExecute(frmHandle, "open", "CALC.EXE", "", "", SW_SHOWNORMAL)
    If Retval < 33 Then
        MsgBox "Could not load Windows Calculator!!", vbExclamation, "Load failed!"
        Exit Sub
    End If
    While xHandle = 0
        DoEvents
        xHandle = FindWindow("SciCalc", 0&)
    Wend

    GetWindowRect frmHandle, LRect
    frmHM = LRect.Left + (LRect.Right - LRect.Left) / 2
    frmVM = LRect.Top + (LRect.Bottom - LRect.Top) / 2

    GetWindowRect xHandle, LRect
    appHM = (LRect.Right - LRect.Left) / 2
    appVM = (LRect.Bottom - LRect.Top) / 2

    appLeft = frmHM - appHM
    appTop = frmVM - appVM

    SetWindowPos xHandle, HWND_TOPMOST, appLeft, appTop, 0, 0, SWP_NOSIZE
    
End Sub

Και στο συμβάν του κουμπιού:

Κώδικας:

Private Sub cmdCallCalc_Click()
    LoadCalc Me.hwnd
End Sub

Θέμα: αριθμομηχανη