![]() |
#1
|
||||
|
||||
![]()
there is a well-known commands to speed-up macros and any shape processing code by bracketing the code inside paired block of Optimization + EventsEnabled + ActiveDocument.PreserveSelection + ActiveDocument.BeginCommandGroup
However today I just have found that some of the DRAW's dockers slow down complex macros 10 times. Usually I don't use any dockers except for an occasional lookup in ObjectManager (for Layers) only - I have everything I need on PropertyBar and of course assigned to various hotkeys. Here's a list of dockers that when being opened slow down (up to 10 times) complex shape manipulations applied in [macro] code:
The only way I've managed to invent is to close and reopen them. Implementing which in pre-X4 programmatically is a somewhat tricky task since there is no object-model provided access to docker's visibility state. Yet I've done it via lowlevel winapi :-) Usage: Code:
BadDockersShow false ............... ...............do something complex ............... BadDockersShow true Code:
Option Explicit Private Declare Function EnumThreadWindows Lib "user32" (ByVal dwThreadId&, ByVal lpfn&, ByVal lParam&) As Integer Private Declare Function GetCurrentThreadId& Lib "kernel32" () Private Declare Function LoadLibraryExW& Lib "kernel32" (ByVal lpDllNameW&, ByVal rsvd&, ByVal dwFlags&) Private Declare Function FreeLibrary& Lib "kernel32" (ByVal hMod&) Private Declare Function FindResourceW& Lib "kernel32" (ByVal hModule&, ByVal lpName&, ByVal lpType&) Private Declare Function LoadResource& Lib "kernel32" (ByVal hModule&, ByVal hResInfo&) Private Declare Function SizeofResource& Lib "kernel32" (ByVal hModule&, ByVal hResInfo&) Private Declare Function LockResource& Lib "kernel32" (ByVal hResData&) Private Declare Sub memmove Lib "ntdll" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef source As Any, ByVal Length&) Private Declare Function lstrlenW& Lib "kernel32" (ByVal lpStrW&) Private Declare Function GetWindowTextW Lib "user32" (ByVal hWnd&, ByVal lpText&, ByVal maxLen%) As Integer Private Declare Function GetClassNameW Lib "user32" (ByVal hWnd&, ByVal lpwClassName&, ByVal nMaxCount%) As Long Private Declare Function FindWindowExW& Lib "user32" (ByVal hParent&, ByVal hChildAfter&, ByVal lpClassW&, ByVal lpTitleW&) Private Declare Function IsWindowVisible Lib "user32" (ByVal hWnd&) As Integer Sub BadDockersShow(ByVal bEnable As Boolean) Const sDlgs$ = "VGCoreIntl.dll:248:292:46:236:254:306:+T308:+T310:+T309:+T311:+T312:" & _ "41:37:237" & _ "|CrlCUIintl.dll:24270", _ sDockers$ = "b9c96a22-ab10-4b92-abb8-44d767c126ce|" & _ "90e01b9d-74dc-41c1-86f6-ccb51e0f68fd|" & _ "0de570eb-18ef-4532-9415-3ca1b3f63470|" & _ "2972bbb3-832c-4847-8efe-96b62bc78488|" & _ "1c86e69f-30a5-4a01-85cb-e4a76cca5fd5|" & _ "Transforms|" & _ "08f43f37-103b-4984-b228-83d9f30c6598|" & _ "61743a73-92e2-4894-8cd1-a3f8738aa916|" & _ "04db307d-ebcb-48a0-852f-9780fb58a7ab|" & _ "cd75e4f5-7745-4386-a7ed-bba92e6f2532|" & _ "17f02bce-2f43-4891-b8d6-54385c425c58|" & _ "6268eac5-0cf7-4d43-a20a-aacc50b04562|" & _ "952e4cc8-4316-4bca-9ad9-9f79cf8574f2|" & _ "8faeb2db-405f-4e51-ad63-f85484ae9683|" & _ "99b8c7af-3072-46c9-a6b5-df7c9f772565|" Const RT_DIALOG& = 5, s32770$ = "#32770" Static coTitles As Collection, coDockers As Collection Dim vJob, vDialog, dlgID&, sDLL$, hMod&, hRes&, hMem&, i&, L&, s$, bSubDlg%, arrDockers$() On Error Resume Next If coTitles Is Nothing Then Set coTitles = New Collection For Each vJob In Split(sDlgs, "|") i = InStr(vJob, ":"): sDLL = Trim$(Left$(vJob, i - 1)): vJob = Mid$(vJob, i + 1) sDLL = LanguagePath & "\programs\" & sDLL hMod = LoadLibraryExW(StrPtr(sDLL), 0, 2): 'LOAD_LIBRARY_AS_DATAFILE If hMod = 0 Then Exit Sub For Each vDialog In Split(vJob, ":") Do bSubDlg = (Left$(vDialog, 1) = "+") dlgID = IIf(bSubDlg, Mid$(vDialog, 3), vDialog) hRes = FindResourceW(hMod, dlgID, RT_DIALOG): If hRes = 0 Then Exit Do hMem = LoadResource(hMod, hRes): If hMem = 0 Then Exit Do hMem = LockResource(hMem): If hMem = 0 Then Exit Do If SizeofResource(hMod, hRes) < 30 Then Exit Do L = hMem + 26: i = 0 memmove i, ByVal L, 2: If i = &HFFFF& Then L = L + 4 Else L = L + 2 + lstrlenW(L) * 2 memmove i, ByVal L, 2: If i = &HFFFF& Then L = L + 4 Else L = L + 2 + lstrlenW(L) * 2 i = lstrlenW(L) If bSubDlg Then L = L + i * 2 + 2 memmove i, ByVal hMem + 12, 4 If i And &H40 Then L = L + 6 + lstrlenW(L + 6) * 2 + 2 'DS_SETFONT L = ((L + 3) And (Not 3&)) + 22: i = 0 memmove i, ByVal L, 2: If i = &HFFFF& Then L = L + 4 Else L = L + 2 + lstrlenW(L) * 2 memmove i, ByVal L, 2: If i = &HFFFF& Then L = L + 4 i = lstrlenW(L): s = Space$(i + 2): Mid$(s, 1) = Mid$(vDialog, 1, 2) memmove ByVal StrPtr(s) + 4, ByVal L, i * 2 Else If i = 0 Then Exit Do Else s = Space$(i): memmove ByVal StrPtr(s), ByVal L, i * 2 End If coTitles.Add coTitles.Count + 1, s Loop Until 1 Next vDialog FreeLibrary hMod Next vJob End If If bEnable = 0 Then arrDockers = Split(sDockers, "|") Set coDockers = New Collection 'enumerate docked pane hMod = 0: bSubDlg = 0 Do hMod = FindWindowExW(AppWindow.Handle, hMod, 0, 0): If hMod = 0 Then Exit Do s = Space$(200): i = GetClassNameW(hMod, StrPtr(s), 200): s = Left$(s, i) If Left$(s, 4) = "Afx:" Then hRes = 0 Do hRes = FindWindowExW(hMod, hRes, StrPtr(s32770), 0): If hRes = 0 Then Exit Do bSubDlg = True hMem = FindWindowExW(hRes, 0, StrPtr(s32770), 0) i = 0: i = coTitles(WindowCaption(hMem)) If i = 6 Then 'Transforms docker i = 0: hMem = FindWindowExW(FindWindowExW(hMem, 0, StrPtr(s32770), 0), 0, 0, 0) If hMem Then i = coTitles("+T" & WindowCaption(hMem)) End If If i Then coDockers.Add arrDockers(i - 1) Loop If bSubDlg Then Exit Do End If Loop 'enumerate floating dockers sDLL = Space$(100 * 4): L = StrPtr(sDLL) EnumThreadWindows GetCurrentThreadId, AddressOf EnumThreadDockersProc, VarPtr(L) bSubDlg = 0 For hMem = StrPtr(sDLL) To L - 1 Step 4 memmove L, ByVal hMem, 4 i = 0: hMod = coTitles(WindowCaption(L)) If hMod = 6 Then 'Transforms docker hMod = 0 If Not bSubDlg Then hRes = FindWindowExW(FindWindowExW(L, 0, 0, 0), 0, StrPtr(s32770), 0): hMem = 0 Do hMem = FindWindowExW(hRes, hMem, StrPtr(s32770), 0): If hMem = 0 Then Exit Do If IsWindowVisible(hMem) Then L = FindWindowExW(hMem, 0, 0, 0) If L Then hMod = coTitles("+T" & WindowCaption(i)): If hMod Then bSubDlg = True: Exit Do End If Loop End If End If If hMod Then coDockers.Add arrDockers(hMod - 1) Next End If For Each vDialog In coDockers: FrameWork.Automation.Invoke vDialog: Next DoEvents End Sub Private Function EnumThreadDockersProc&(ByVal hWnd&, ByRef ptr&) EnumThreadDockersProc = True If IsWindowVisible(hWnd) = 0 Then Exit Function If FindWindowExW(hWnd, 0, StrPtr("#32770"), 0) = 0 Then Exit Function memmove ByVal ptr, hWnd, 4 ptr = ptr + 4 End Function Private Function WindowCaption$(ByVal hWnd&) Dim L& WindowCaption = Space$(200) L = GetWindowTextW(hWnd, StrPtr(WindowCaption), 200): WindowCaption = Left$(WindowCaption, L) End Function Last edited by wOxxOm; 14-03-2008 at 06:30. |
Currently Active Users Viewing This Thread: 1 (0 members and 1 guests) | |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
How to write a processing macro? | enewbold | Macros/Add-ons | 2 | 21-11-2006 11:15 |
How to increase redraw speed 100 times | wOxxOm | Feature requests/wishlist | 1 | 05-05-2006 21:17 |
musthave macro: REPEAT LAST COMMAND custom number of times | wOxxOm | CorelDRAW/Corel DESIGNER VBA | 3 | 04-09-2005 13:08 |
Speed up printing | RonHill | General | 0 | 22-06-2004 14:20 |
closing dockers/interactive toolbars to speed up a macro | Rick Randall | CorelDRAW CS | 1 | 09-12-2002 21:39 |