jeff123wang

Option Explicit

Private Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As LongPtr, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function SetClipboardViewer Lib "user32.dll" (ByVal hWndNewViewer As LongPtr) As LongPtr
Private Declare PtrSafe Function ChangeClipboardChain Lib "user32.dll" (ByVal hWndRemove As LongPtr, ByVal hWndNewNext As LongPtr) As Long
Private Declare Function IsClip

jeff123wang

Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" _
    () As Long
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
    (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr

Private Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" _
    (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long

Private Declare PtrSafe Function CallNextHookEx Lib "user32" _
    (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

jeff123wang

Sub CATMain()

    CATIA.DisplayFileAlerts = False

    message = msgbox ("Do you want to close all windows?", vbYesNo,"Close All Window")

    if message = vbYes then

    Do while CATIA.Documents.count <> 0

jeff123wang

' this catscript will search all empty geometrical sets and delete empty one. 
Sub CATMain()

'definition of variables

Dim part1 
Dim partdocuemnt1 
Dim selection1 
Dim flag, empty_set 

jeff123wang

' this cat script will export search result to a txt file. 
Sub CATMain()

    Dim sPath
    Dim i
    Dim oSelection                               'As Selection
    Dim oSelectedElement                         'As SelectedElement
    Dim sElementName                             'As String
    Dim sElementPath                             'As String
    Dim sInput

jeff123wang

' so in summary, there are three ways to create memory bitmap and use it.
' createbitmap header, info structure --> put to disk file --> load to userform
' createbitmap header, info struction --> use copy memory to construct a IPicture --> load to userform
' use OleCreatePictureIndirect API call to save from bitmap handle directly.
' no need to mess with bitmap header or other low level detail.

' i like method 2, it is the most difficutl one, but i learned a lot about Win32 API and VB.
' Especially User Defined Type. and CopyMemory function.

' this example uses PUT method to save BitMapHeader and BitMapInfo struct to disk.

jeff123wang

' this method first get a DC entire window. 
' then turn it into a memory bitmap. 
' then create a iPicture interface using the bitmap.
' the benefit of using OleCreatePictureIndirect is that we don't need to worry about filling 
' out bitmap header infomation manually. 
' it is easier than other method in my git. 
' You can also use GDI+, or even DotNet API, which provides simplified API than GDI. 
' But i like low level API better. 

Option Explicit

jeff123wang

' this is a excel vba userform. 
' it has only one image control. 
' this macro will create a bitmap in memroy the hard way.
' filling BitMap header and BitMapinfo manually, then use BitBlt to get pixel to a Bytes array.
' use memorycopy to merge the 3 parts together to a byte array.
' then load the BMP array to to a IPicture interface.
' last step is to load the IPicture to the image control.

Private Declare PtrSafe Function CreateCompatibleDC Lib "Gdi32" (ByVal hDc As LongPtr) As LongPtr
Private Declare PtrSafe Function CreateCompatibleBitmap Lib "Gdi32" (ByVal hDc As LongPtr, _

jeff123wang

' https://stackoverflow.com/questions/64729347/getting-a-udt-from-a-longptr-in-vba
' There are three ways to assign UDT.
' 1. Simply use = assgiment
' 2. use copymemory.
' 3. Allocate memory as a swap space, transfer the value.
' 4. in VB, you can't dereference a UDT pointer directly like in C "->"
' 5. You need to use copymemory to a UDT variable. Then use "." to reference that variable.

Type IDT
    id As Long

jeff123wang

'https://www.vbforums.com/showthread.php?329373-MsgBoxEx-Extended-Message-Box
'*************************************************************
'* MsgBoxEx() - Written by Aaron Young, February 7th 2000
'*            - Edited by Philip Manavopoulos, May 19th 2005
'*************************************************************
 
Option Explicit
 
Private Type CWPSTRUCT
    lParam As Long