1 {
2 Extra Win32 code that's not in the RTL.
3 Copyright (C) 2001, 2002 Keith Bowes.
4 Modified by Marc Weustink
5
6 *****************************************************************************
7 This file is part of the Lazarus Component Library (LCL)
8
9 See the file COPYING.modifiedLGPL.txt, included in this distribution,
10 for details about the license.
11 *****************************************************************************
12 }
13
14 unit Win32Extra;
15
16 {$mode objfpc}{$H+}
17 {$I win32defines.inc}
18
19 {$IFDEF TRACE}
20 {$ASSERTIONS ON}
21 {$ENDIF}
22
23 {$PACKRECORDS C}
24 {$SMARTLINK ON}
25
26 interface
27
28 uses
29 InterfaceBase, Classes, LCLType, Windows, GraphType, SysUtils, ActiveX, ShlObj;
30
31 { Win32 API constants not included in windows.pp }
32 const
33 // Layout orientation
34 LAYOUT_RTL = $00000001; // Right to left
35 LAYOUT_BTT = $00000002; // Bottom to top
36 LAYOUT_VBH = $00000004; // Vertical before horizontal
37 LAYOUT_ORIENTATIONMASK = (LAYOUT_RTL or LAYOUT_BTT or LAYOUT_VBH);
38 LAYOUT_BITMAPORIENTATIONPRESERVED = $00000008;
39 // not defined in fpc 2.4.3
40 GCLP_HBRBACKGROUND = -10;
41
42 type
43 tagMENUBARINFO = record
44 cbSize: DWORD;
45 rcBar: TRect;
46 hMenu: HMENU;
47 hwndMenu: HWND;
48 Flags: DWORD;
49 end;
50 MENUBARINFO = tagMENUBARINFO;
51 PMENUBARINFO = ^tagMENUBARINFO;
52
53 // Window information snapshot
54 tagWINDOWINFO = record
55 cbSize: DWORD;
56 rcWindow: TRect;
57 rcClient: TRect;
58 dwStyle: DWORD;
59 dwExStyle: DWORD;
60 dwWindowStatus: DWORD;
61 cxWindowBorders: UINT;
62 cyWindowBorders: UINT;
63 atomWindowType: ATOM;
64 wCreatorVersion: WORD;
65 end;
66 WINDOWINFO = tagWINDOWINFO;
67 PWINDOWINFO = ^tagWINDOWINFO;
68
69 // ===================== Task Dialog =========================
70
wndnull71 PFTASKDIALOGCALLBACK = function(hwnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM; lpRefData: LONG_PTR): HRESULT; stdcall;
72
73 // _TASKDIALOG_FLAGS enum
74 const
75 TDF_ENABLE_HYPERLINKS = $0001;
76 TDF_USE_HICON_MAIN = $0002;
77 TDF_USE_HICON_FOOTER = $0004;
78 TDF_ALLOW_DIALOG_CANCELLATION = $0008;
79 TDF_USE_COMMAND_LINKS = $0010;
80 TDF_USE_COMMAND_LINKS_NO_ICON = $0020;
81 TDF_EXPAND_FOOTER_AREA = $0040;
82 TDF_EXPANDED_BY_DEFAULT = $0080;
83 TDF_VERIFICATION_FLAG_CHECKED = $0100;
84 TDF_SHOW_PROGRESS_BAR = $0200;
85 TDF_SHOW_MARQUEE_PROGRESS_BAR = $0400;
86 TDF_CALLBACK_TIMER = $0800;
87 TDF_POSITION_RELATIVE_TO_WINDOW = $1000;
88 TDF_RTL_LAYOUT = $2000;
89 TDF_NO_DEFAULT_RADIO_BUTTON = $4000;
90 TDF_CAN_BE_MINIMIZED = $8000;
91
92 type
93 TASKDIALOG_FLAGS = Integer; // Note: _TASKDIALOG_FLAGS is an int
94
95 // _TASKDIALOG_MESSAGES enum
96 const
97 TDM_NAVIGATE_PAGE = WM_USER+101;
98 TDM_CLICK_BUTTON = WM_USER+102; // wParam = Button ID
99 TDM_SET_MARQUEE_PROGRESS_BAR = WM_USER+103; // wParam = 0 (nonMarque) wParam != 0 (Marquee)
100 TDM_SET_PROGRESS_BAR_STATE = WM_USER+104; // wParam = new progress state
101 TDM_SET_PROGRESS_BAR_RANGE = WM_USER+105; // lParam = MAKELPARAM(nMinRange, nMaxRange)
102 TDM_SET_PROGRESS_BAR_POS = WM_USER+106; // wParam = new position
103 TDM_SET_PROGRESS_BAR_MARQUEE = WM_USER+107; // wParam = 0 (stop marquee), wParam != 0 (start marquee), lparam = speed (milliseconds between repaints)
104 TDM_SET_ELEMENT_TEXT = WM_USER+108; // wParam = element (TASKDIALOG_ELEMENTS), lParam = new element text (LPCWSTR)
105 TDM_CLICK_RADIO_BUTTON = WM_USER+110; // wParam = Radio Button ID
106 TDM_ENABLE_BUTTON = WM_USER+111; // lParam = 0 (disable), lParam != 0 (enable), wParam = Button ID
107 TDM_ENABLE_RADIO_BUTTON = WM_USER+112; // lParam = 0 (disable), lParam != 0 (enable), wParam = Radio Button ID
108 TDM_CLICK_VERIFICATION = WM_USER+113; // wParam = 0 (unchecked), 1 (checked), lParam = 1 (set key focus)
109 TDM_UPDATE_ELEMENT_TEXT = WM_USER+114; // wParam = element (TASKDIALOG_ELEMENTS), lParam = new element text (LPCWSTR)
110 TDM_SET_BUTTON_ELEVATION_REQUIRED_STATE = WM_USER+115; // wParam = Button ID, lParam = 0 (elevation not required), lParam != 0 (elevation required)
111 TDM_UPDATE_ICON = WM_USER+116; // wParam = icon element (TASKDIALOG_ICON_ELEMENTS), lParam = new icon (hIcon if TDF_USE_HICON_* was set, PCWSTR otherwise)
112
113 // _TASKDIALOG_NOTIFICATIONS enum
114 const
115 TDN_CREATED = 0;
116 TDN_NAVIGATED = 1;
117 TDN_BUTTON_CLICKED = 2; // wParam = Button ID
118 TDN_HYPERLINK_CLICKED = 3; // lParam = (LPCWSTR)pszHREF
119 TDN_TIMER = 4; // wParam = Milliseconds since dialog created or timer reset
120 TDN_DESTROYED = 5;
121 TDN_RADIO_BUTTON_CLICKED = 6; // wParam = Radio Button ID
122 TDN_DIALOG_CONSTRUCTED = 7;
123 TDN_VERIFICATION_CLICKED = 8; // wParam = 1 if checkbox checked, 0 if not, lParam is unused and always 0
124 TDN_HELP = 9;
125 TDN_EXPANDO_BUTTON_CLICKED = 10; // wParam = 0 (dialog is now collapsed), wParam != 0 (dialog is now expanded)
126
127 type
128 _TASKDIALOG_BUTTON = packed record
129 nButtonID: Integer;
130 pszButtonText: PCWSTR;
131 end;
132 TASKDIALOG_BUTTON = _TASKDIALOG_BUTTON;
133 TTASKDIALOG_BUTTON = TASKDIALOG_BUTTON;
134 PTASKDIALOG_BUTTON = ^TASKDIALOG_BUTTON;
135
136 // _TASKDIALOG_ELEMENTS enum
137 const
138 TDE_CONTENT = 0;
139 TDE_EXPANDED_INFORMATION = 1;
140 TDE_FOOTER = 2;
141 TDE_MAIN_INSTRUCTION = 3;
142
143 // _TASKDIALOG_ICON_ELEMENTS enum
144 TDIE_ICON_MAIN = 0;
145 TDIE_ICON_FOOTER = 1;
146
147 TD_WARNING_ICON = MAKEINTRESOURCEW(Word(-1));
148 TD_ERROR_ICON = MAKEINTRESOURCEW(Word(-2));
149 TD_INFORMATION_ICON = MAKEINTRESOURCEW(Word(-3));
150 TD_SHIELD_ICON = MAKEINTRESOURCEW(Word(-4));
151 TD_SHIELD_GRADIENT_ICON = MAKEINTRESOURCEW(Word(-5));
152 TD_SHIELD_WARNING_ICON = MAKEINTRESOURCEW(Word(-6));
153 TD_SHIELD_ERROR_ICON = MAKEINTRESOURCEW(Word(-7));
154 TD_SHIELD_OK_ICON = MAKEINTRESOURCEW(Word(-8));
155 TD_SHIELD_GRAY_ICON = MAKEINTRESOURCEW(Word(-9));
156
157 // _TASKDIALOG_COMMON_BUTTON_FLAGS enum
158 TDCBF_OK_BUTTON = $0001; // selected control return value IDOK
159 TDCBF_YES_BUTTON = $0002; // selected control return value IDYES
160 TDCBF_NO_BUTTON = $0004; // selected control return value IDNO
161 TDCBF_CANCEL_BUTTON = $0008; // selected control return value IDCANCEL
162 TDCBF_RETRY_BUTTON = $0010; // selected control return value IDRETRY
163 TDCBF_CLOSE_BUTTON = $0020; // selected control return value IDCLOSE
164
165 type
166 TASKDIALOG_COMMON_BUTTON_FLAGS = Integer; // Note: _TASKDIALOG_COMMON_BUTTON_FLAGS is an int
167
168 _TASKDIALOGCONFIG = packed record
169 cbSize: UINT;
170 hwndParent: HWND;
171 hInstance: HINST; // used for MAKEINTRESOURCE() strings
172 dwFlags: TASKDIALOG_FLAGS; // TASKDIALOG_FLAGS (TDF_XXX) flags
173 dwCommonButtons: TASKDIALOG_COMMON_BUTTON_FLAGS; // TASKDIALOG_COMMON_BUTTON (TDCBF_XXX) flags
174 pszWindowTitle: PCWSTR; // string or MAKEINTRESOURCE()
175 case Boolean of
176 False: (hMainIcon: HICON);
177 True: (
178 pszMainIcon: PCWSTR;
179 pszMainInstruction: PCWSTR;
180 pszContent: PCWSTR;
181 cButtons: UINT;
182 pButtons: PTASKDIALOG_BUTTON;
183 nDefaultButton: Integer;
184 cRadioButtons: UINT;
185 pRadioButtons: PTASKDIALOG_BUTTON;
186 nDefaultRadioButton: Integer;
187 pszVerificationText: PCWSTR;
188 pszExpandedInformation: PCWSTR;
189 pszExpandedControlText: PCWSTR;
190 pszCollapsedControlText: PCWSTR;
191 case Boolean of
192 False: (hFooterIcon: HICON);
193 True: (
194 pszFooterIcon: PCWSTR;
195 pszFooter: PCWSTR;
196 pfCallback: PFTASKDIALOGCALLBACK;
197 lpCallbackData: LONG_PTR;
198 cxWidth: UINT; // width of the Task Dialog's client area in DLU's. If 0, Task Dialog will calculate the ideal width.
199 );
200 );
201 end;
202 TASKDIALOGCONFIG = _TASKDIALOGCONFIG;
203 PTASKDIALOGCONFIG = ^TASKDIALOGCONFIG;
204 TTASKDIALOGCONFIG = TASKDIALOGCONFIG;
205
206 // ==================== End TaskDialog =======================
207
208 // File dialogs
209 const
210 CLSID_FileOpenDialog: TGUID = '{DC1C5A9C-E88A-4dde-A5A1-60F82A20AEF7}';
211 CLSID_FileSaveDialog: TGUID = '{C0B4E2F3-BA21-4773-8DBA-335EC946EB8B}';
212
213 // GETPROPERTYSTOREFLAGS enum
214 GPS_DEFAULT = 0;
215 GPS_HANDLERPROPERTIESONLY = $1;
216 GPS_READWRITE = $2;
217 GPS_TEMPORARY = $4;
218 GPS_FASTPROPERTIESONLY = $8;
219 GPS_OPENSLOWITEM = $10;
220 GPS_DELAYCREATION = $20;
221 GPS_BESTEFFORT = $40;
222 GPS_NO_OPLOCK = $80;
223 GPS_MASK_VALID = $ff;
224
225 // SIATTRIBFLAGS enum
226 SIATTRIBFLAGS_AND = $1;
227 SIATTRIBFLAGS_OR = $2;
228 SIATTRIBFLAGS_APPCOMPAT = $3;
229 SIATTRIBFLAGS_MASK = $3;
230 SIATTRIBFLAGS_ALLITEMS = $4000;
231
232 // CDCONTROLSTATEF enum
233 CDCS_INACTIVE = 0;
234 CDCS_ENABLED = $1;
235 CDCS_VISIBLE = $2;
236 CDCS_ENABLEDVISIBLE = $3;
237
238 type
239 GETPROPERTYSTOREFLAGS = DWord;
240 SIATTRIBFLAGS = DWord;
241 CDCONTROLSTATEF = DWord;
242
243 _tagpropertykey = packed record
244 fmtid: TGUID;
245 pid: DWORD;
246 end;
247 PROPERTYKEY = _tagpropertykey;
248 REFPROPERTYKEY = ^PROPERTYKEY;
249 REFPROPVARIANT = ^TPROPVARIANT;
250 IEnumShellItems = interface(IUnknown)
251 ['{70629033-e363-4a28-a567-0db78006e6d7}']
Nextnull252 function Next(celt: ULONG; out rgelt: IShellItem; var pceltFetched: ULONG): HResult; stdcall;
Skipnull253 function Skip(celt: ULONG): HResult; stdcall;
Resetnull254 function Reset: HResult; stdcall;
Clonenull255 function Clone(out ppenum: IEnumShellItems): HResult; stdcall;
256 end;
257
258 IShellItemArray = interface(IUnknown)
259 ['{b63ea76d-1f85-456f-a19c-48159efa858b}']
BindToHandlernull260 function BindToHandler(pbc: IBindCtx; const bhid: TGUID; const riid: REFIID; out ppvOut): HResult; stdcall;
GetPropertyStorenull261 function GetPropertyStore(flags: GETPROPERTYSTOREFLAGS; const riid: REFIID; out ppv): HResult; stdcall;
GetPropertyDescriptionListnull262 function GetPropertyDescriptionList(keyType: REFPROPERTYKEY; const riid: REFIID; out ppv): HResult; stdcall;
GetAttributesnull263 function GetAttributes(AttribFlags: SIATTRIBFLAGS; sfgaoMask: SFGAOF; var psfgaoAttribs: SFGAOF): HResult; stdcall;
GetCountnull264 function GetCount(var pdwNumItems: DWORD): HResult; stdcall;
GetItemAtnull265 function GetItemAt(dwIndex: DWORD; var ppsi: IShellItem): HResult; stdcall;
EnumItemsnull266 function EnumItems(var ppenumShellItems: IEnumShellItems): HResult; stdcall;
267 end;
268
269 IPropertyStore = interface(IUnknown)
270 ['{886d8eeb-8cf2-4446-8d02-cdba1dbdcf99}']
GetCountnull271 function GetCount(out cProps: DWORD): HResult; stdcall;
GetAtnull272 function GetAt(iProp: DWORD; out pkey: PROPERTYKEY): HResult; stdcall;
GetValuenull273 function GetValue(key: REFPROPERTYKEY; out pv: PROPVARIANT): HResult; stdcall;
SetValuenull274 function SetValue(key: REFPROPERTYKEY; propvar: REFPROPVARIANT): HResult; stdcall;
Commitnull275 function Commit: HResult; stdcall;
276 end;
277
278 IPropertyDescriptionList = interface(IUnknown)
279 ['{1f9fc1d0-c39b-4b26-817f-011967d3440e}']
GetCountnull280 function GetCount(out pcElem: UINT): HResult; stdcall;
GetAtnull281 function GetAt(iElem: UINT; const riid: REFIID; out ppv): HResult; stdcall;
282 end;
283
284 IFileOperationProgressSink = interface(IUnknown)
285 ['{04b0f1a7-9490-44bc-96e1-4296a31252e2}']
StartOperationsnull286 function StartOperations: HResult; stdcall;
FinishOperationsnull287 function FinishOperations(hrResult: HResult): HResult; stdcall;
PreRenameItemnull288 function PreRenameItem(dwFlags: DWORD; psiItem: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
PostRenameItemnull289 function PostRenameItem(dwFlags: DWORD; psiItem: IShellItem; pszNewName: LPCWSTR; hrRename: HRESULT; psiNewlyCreated: IShellItem): HResult; stdcall;
PreMoveItemnull290 function PreMoveItem(dwFlags: DWORD; psiItem: IShellItem; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
PostMoveItemnull291 function PostMoveItem(dwFlags: DWORD; psiItem: IShellItem; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR; hrMove: HRESULT; psiNewlyCreated: IShellItem): HResult; stdcall;
PreCopyItemnull292 function PreCopyItem(dwFlags: DWORD; psiItem: IShellItem; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
PostCopyItemnull293 function PostCopyItem(dwFlags: DWORD; psiItem: IShellItem; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR; hrCopy: HRESULT; psiNewlyCreated: IShellItem): HResult; stdcall;
PreDeleteItemnull294 function PreDeleteItem(dwFlags: DWORD; psiItem: IShellItem): HResult; stdcall;
PostDeleteItemnull295 function PostDeleteItem(dwFlags: DWORD; psiItem: IShellItem; hrDelete: HRESULT; psiNewlyCreated: IShellItem): HResult; stdcall;
PreNewItemnull296 function PreNewItem(dwFlags: DWORD; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
PostNewItemnull297 function PostNewItem(dwFlags: DWORD; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR; pszTemplateName: LPCWSTR; dwFileAttributes: DWORD; hrNew: HRESULT; psiNewItem: IShellItem): HResult; stdcall;
UpdateProgressnull298 function UpdateProgress(iWorkTotal: UINT; iWorkSoFar: UINT): HResult; stdcall;
ResetTimernull299 function ResetTimer: HResult; stdcall;
PauseTimernull300 function PauseTimer: HResult; stdcall;
ResumeTimernull301 function ResumeTimer: HResult; stdcall;
302 end;
303
304 IFileDialogCustomize = interface(IUnknown)
305 ['{e6fdd21a-163f-4975-9c8c-a69f1ba37034}']
EnableOpenDropDownnull306 function EnableOpenDropDown(dwIDCtl: DWORD): HResult; stdcall;
AddMenunull307 function AddMenu(dwIDCtl: DWORD; pszLabel: LPCWSTR): HResult; stdcall;
AddPushButtonnull308 function AddPushButton(dwIDCtl: DWORD; pszLabel: LPCWSTR): HResult; stdcall;
AddComboBoxnull309 function AddComboBox(dwIDCtl: DWORD): HResult; stdcall;
AddRadioButtonListnull310 function AddRadioButtonList(dwIDCtl: DWORD): HResult; stdcall;
AddCheckButtonnull311 function AddCheckButton(dwIDCtl: DWORD; pszLabel: LPCWSTR; bChecked: BOOL): HResult; stdcall;
AddEditBoxnull312 function AddEditBox(dwIDCtl: DWORD; pszText: LPCWSTR): HResult; stdcall;
AddSeparatornull313 function AddSeparator(dwIDCtl: DWORD): HResult; stdcall;
AddTextnull314 function AddText(dwIDCtl: DWORD; pszText: LPCWSTR): HResult; stdcall;
SetControlLabelnull315 function SetControlLabel(dwIDCtl: DWORD; pszLabel: LPCWSTR): HResult; stdcall;
GetControlStatenull316 function GetControlState(dwIDCtl: DWORD; out pdwState: CDCONTROLSTATEF): HResult; stdcall;
SetControlStatenull317 function SetControlState(dwIDCtl: DWORD; dwState: CDCONTROLSTATEF): HResult; stdcall;
GetEditBoxTextnull318 function GetEditBoxText(dwIDCtl: DWORD; out ppszText: WCHAR): HResult; stdcall;
SetEditBoxTextnull319 function SetEditBoxText(dwIDCtl: DWORD; pszText: LPCWSTR): HResult; stdcall;
GetCheckButtonStatenull320 function GetCheckButtonState(dwIDCtl: DWORD; out pbChecked: BOOL): HResult; stdcall;
SetCheckButtonStatenull321 function SetCheckButtonState(dwIDCtl: DWORD; bChecked: BOOL): HResult; stdcall;
AddControlItemnull322 function AddControlItem(dwIDCtl: DWORD; dwIDItem: DWORD; pszLabel: LPCWSTR): HResult; stdcall;
RemoveControlItemnull323 function RemoveControlItem(dwIDCtl: DWORD; dwIDItem: DWORD): HResult; stdcall;
RemoveAllControlItemsnull324 function RemoveAllControlItems(dwIDCtl: DWORD): HResult; stdcall;
GetControlItemStatenull325 function GetControlItemState(dwIDCtl: DWORD; dwIDItem: DWORD; out pdwState: CDCONTROLSTATEF): HResult; stdcall;
SetControlItemStatenull326 function SetControlItemState(dwIDCtl: DWORD; dwIDItem: DWORD; dwState: CDCONTROLSTATEF): HResult; stdcall;
GetSelectedControlItemnull327 function GetSelectedControlItem(dwIDCtl: DWORD; out pdwIDItem: DWORD): HResult; stdcall;
SetSelectedControlItemnull328 function SetSelectedControlItem(dwIDCtl: DWORD; dwIDItem: DWORD): HResult; stdcall;
StartVisualGroupnull329 function StartVisualGroup(dwIDCtl: DWORD; pszLabel: LPCWSTR): HResult; stdcall;
EndVisualGroupnull330 function EndVisualGroup: HResult; stdcall;
MakeProminentnull331 function MakeProminent(dwIDCtl: DWORD): HResult; stdcall;
SetControlItemTextnull332 function SetControlItemText(dwIDCtl: DWORD; dwIDItem: DWORD; pszLabel: LPCWSTR): HResult; stdcall;
333 end;
334
335 IFileDialogControlEvents = interface(IUnknown)
336 ['{36116642-D713-4b97-9B83-7484A9D00433}']
OnItemSelectednull337 function OnItemSelected(pfdc: IFileDialogCustomize; dwIDCtl: DWORD; dwIDItem: DWORD): HResult; stdcall;
OnButtonClickednull338 function OnButtonClicked(pfdc: IFileDialogCustomize; dwIDCtl: DWORD): HResult; stdcall;
OnCheckButtonTogglednull339 function OnCheckButtonToggled(pfdc: IFileDialogCustomize; dwIDCtl: DWORD; bChecked: BOOL): HResult; stdcall;
OnControlActivatingnull340 function OnControlActivating(pfdc: IFileDialogCustomize; dwIDCtl: DWORD): HResult; stdcall;
341 end;
342
343 IFileOpenDialog = interface(IFileDialog)
344 ['{d57c7288-d4ad-4768-be02-9d969532d960}']
GetResultsnull345 function GetResults(var ppenum: IShellItemArray): HResult; stdcall;
GetSelectedItemsnull346 function GetSelectedItems(var ppsai: IShellItemArray): HResult; stdcall;
347 end;
348
349 IFileSaveDialog = interface(IFileDialog)
350 ['{84bccd23-5fde-4cdb-aea4-af64b83d78ab}']
SetSaveAsItemnull351 function SetSaveAsItem(psi: IShellItem): HResult; stdcall;
SetPropertiesnull352 function SetProperties(pStore: IPropertyStore): HResult; stdcall;
SetCollectedPropertiesnull353 function SetCollectedProperties(pList: IPropertyDescriptionList; fAppendDefault: BOOL): HResult; stdcall;
GetPropertiesnull354 function GetProperties(var ppStore: IPropertyStore): HResult; stdcall;
ApplyPropertiesnull355 function ApplyProperties(psi: IShellItem; pStore: IPropertyStore; hwnd: HWND; pSink: IFileOperationProgressSink): HResult; stdcall;
356 end;
357
358 // AlphaBlend is only defined for win98&2k and up
ifnull359 // load dynamic and use ownfunction if not defined
360 var
361 AlphaBlend: function(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest, nHeightDest: Integer; hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc: Integer; blendFunction: TBlendFunction): BOOL; stdcall;
Cnull362 GradientFill: function(DC: HDC; p2: PTriVertex; p3: ULONG; p4: Pointer; p5, p6: ULONG): BOOL; stdcall;
wndCombonull363 GetComboBoxInfo: function(hwndCombo: HWND; pcbi: PComboboxInfo): BOOL; stdcall;
wndnull364 GetMenuBarInfo: function(hwnd: HWND; idObject: LONG; idItem: LONG; pmbi: PMENUBARINFO): BOOL; stdcall;
wndnull365 GetWindowInfo: function(hwnd: HWND; pwi: PWINDOWINFO): BOOL; stdcall;
cnull366 SetLayout: function(dc: HDC; l: DWord): DWord; stdcall;
367 SetLayeredWindowAttributes: function (HWND: hwnd; crKey: COLORREF; bAlpha: byte; dwFlags: DWORD): BOOL; stdcall;
Wndnull368 UpdateLayeredWindow: function(hWnd: HWND; hdcDst: HDC; pptDst: PPoint; psize: PSize;
dwFlagsnull369 hdcSrc: HDC; pptSrc: PPoint; crKey: COLORREF; pblend: PBlendFunction; dwFlags: DWORD): BOOL; stdcall;
BOOLnull370 IsProcessDPIAware: function: BOOL; stdcall;
onstnull371 TaskDialogIndirect: function(const pTaskConfig: PTASKDIALOGCONFIG; pnButton: PInteger; pnRadioButton: PInteger; pfVerificationFlagChecked: PBOOL): HRESULT; stdcall;
wndParentnull372 TaskDialog: function(hwndParent: HWND; hInstance: HINST; pszWindowTitle: PCWSTR; pszMainInstruction: PCWSTR; pszContent: PCWSTR;
373 dwCommonButtons: TASKDIALOG_COMMON_BUTTON_FLAGS; pszIcon: PCWSTR; pnButton: PInteger): HRESULT; stdcall;
szPathnull374 SHCreateItemFromParsingName: function(pszPath: PCWSTR; pbc: IBindCtx; const riid: REFIID; out ppv): HResult; stdcall;
375
376 const
377 // ComCtlVersions
378 ComCtlVersionIE3 = $00040046;
379 ComCtlVersionIE4 = $00040047;
380 ComCtlVersionIE401 = $00040048;
381 ComCtlVersionIE5 = $00050050;
382 ComCtlVersionIE501 = $00050051;
383 ComCtlVersionIE6 = $00060000;
384
385 type
386 SHSTOCKICONINFO = record
387 cbSize: DWORD;
388 hIcon: HICON;
389 iSysImageIndex: integer;
390 iIcon: integer;
391 szPath: array[0..MAX_PATH - 1] of WCHAR;
392 end;
393 TSHSTOCKICONINFO = SHSTOCKICONINFO;
394 PSHSTOCKICONINFO = ^SHSTOCKICONINFO;
395
396 var
iidnull397 SHGetStockIconInfo: function(siid: integer; uFlags: UINT; psii: PSHSTOCKICONINFO): HResult; stdcall;
398
399 const
400 SIID_SHIELD = 77;
401 SHGFI_SMALLICON = $000000001;
402 SHGFI_LARGEICON = $000000000;
403 SHGFI_ICON = $000000100;
404
405 type
406 //64bit safe Timer functions and callback
407 //todo: remove as soon the last supported fpc version has updated header (rev 22526)
408 TIMERPROC = procedure (hWnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
409
SetTimernull410 function SetTimer(hWnd:HWND; nIDEvent:UINT_PTR; uElapse:UINT; lpTimerFunc: TIMERPROC): UINT_PTR; stdcall; external 'user32' name 'SetTimer';
KillTimernull411 function KillTimer(hWnd:HWND; uIDEvent:UINT_PTR):WINBOOL; stdcall; external 'user32' name 'KillTimer';
HasManifestnull412 function HasManifest: Boolean;
PrintWindownull413 function PrintWindow(HWND:HWND;hdcBlt:HDC;nFlags:DWORD):WINBOOL; stdcall; external 'user32.dll';
414
415 implementation
416
417 uses
418 Win32Proc;
419
420 {$PACKRECORDS NORMAL}
421
_AlphaBlendnull422 function _AlphaBlend(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest, nHeightDest: Integer; hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc: Integer; blendFunction: TBlendFunction): BOOL; stdcall;
423 var
424 SCA: Byte absolute blendFunction.SourceConstantAlpha;
425
426 R: TRect;
427 DC, TmpDC: HDC;
428 OldBmp, OldTmpBmp, SrcBmp, DstBmp, TmpBmp, AlphaBmp: HBITMAP;
429 StretchSrc: Boolean;
430 SrcSection, DstSection: TDIBSection;
431 Info: record
432 Header: TBitmapInfoHeader;
433 Colors: array[0..3] of Cardinal; // reserve extra color for colormasks
434 end;
435
436 SrcBytesPtr, DstBytesPtr, TmpBytesPtr, AlphaBytesPtr: Pointer;
437 SrcLinePtr, DstLinePtr: PByte;
438 CleanupSrc, CleanupSrcPtr, CleanupDst, CleanupAlpha: Boolean;
439 SrcSize: PtrUInt;
440 SrcPixelBytes, DstPixelBytes: Byte;
441 SrcRowStride, DstRowStride: Integer;
442 SrcLineOrder: TRawImageLineOrder;
443
444 X, Y: Integer;
445 SrcRGBA, TmpRGBA, DstRGBA: PRGBAQuad;
446 SrcAlpha: PByte;
447 NotAlpha: Byte;
448 begin
449 if nXOriginSrc < 0 then Exit(False);
450 if nYOriginSrc < 0 then Exit(False);
451 if nWidthSrc < 0 then Exit(False);
452 if nHeightSrc < 0 then Exit(False);
453 if nWidthDest < 0 then Exit(False);
454 if nHeightDest < 0 then Exit(False);
455
456 if blendFunction.SourceConstantAlpha = 0
457 then Exit(True); // nothing to do
458
459 if (blendFunction.AlphaFormat = 0)
460 and (blendFunction.SourceConstantAlpha = 255)
461 then begin
462 // simple strechblt
463 Result := StretchBlt(hdcDest, nXOriginDest, nYOriginDest, nWidthDest, nHeightDest, hdcSrc, nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc, SRCCOPY);
464 Exit;
465 end;
466
467 // get source info, atleast bitmap, if possible also section
468 if GetObjectType(hdcSrc) <> OBJ_MEMDC then Exit(False);
469 SrcBmp := GetCurrentObject(hdcSrc, OBJ_BITMAP);
470 if GetObject(SrcBmp, SizeOf(SrcSection), @SrcSection) = 0 then Exit(False);
471 if nXOriginSrc + nWidthSrc > SrcSection.dsBm.bmWidth then Exit(False);
472 if nYOriginSrc + nHeightSrc > SrcSection.dsBm.bmHeight then Exit(False);
473
474 if (blendFunction.AlphaFormat = AC_SRC_ALPHA) and (SrcSection.dsBm.bmBitsPixel <> 32) then Exit(False); // invalid
475
476 // get destination info, atleast bitmap, if possible also section
477 if WindowsVersion in [wv95, wv98]
478 then begin
479 // under windows 98 GetObjectType() sometimes produce AV inside and
480 // as result our debugger stopes and show exception
481 // lazarus is not alone application with such problem under windows 98
482 // here is workaround for windows 9x
483 DstBmp := GetCurrentObject(hdcDest, OBJ_BITMAP);
484 DstSection.dsBm.bmBits := nil;
485 if (DstBmp <> 0)
486 and ((GetObject(DstBmp, SizeOf(DstSection), @DstSection) < SizeOf(TDIBSection)) or (DstSection.dsBm.bmBits = nil))
487 then DstBmp := 0;
488 end
489 else begin
490 if GetObjectType(hdcDest) = OBJ_MEMDC
491 then DstBmp := GetCurrentObject(hdcDest, OBJ_BITMAP)
492 else DstBmp := 0;
493 if (DstBmp <> 0) and (GetObject(DstBmp, SizeOf(DstSection), @DstSection) = 0)
494 then DstBmp := 0;
495 end;
496
497 if (DstBmp = 0)
498 then begin
499 // GetCurrentObject can only be used on memory devices,
500 // so fill in some values manually
501 DstSection.dsBm.bmWidth := GetDeviceCaps(hdcDest, HORZRES);
502 DstSection.dsBm.bmHeight := GetDeviceCaps(hdcDest, VERTRES);
503 DstSection.dsBm.bmBitsPixel := GetDeviceCaps(hdcDest, BITSPIXEL);
504 DstSection.dsBm.bmBits := nil;
505 end;
506
507 // docs doesn't require dest retangle inside dest.
508 // however if dest rect is outside the destination, we're done here
509 if nXOriginDest + nWidthDest < 0 then Exit(True);
510 if nYOriginDest + nHeightDest < 0 then Exit(True);
511 if nXOriginDest >= DstSection.dsBm.bmWidth then Exit(True);
512 if nYOriginDest >= DstSection.dsBm.bmHeight then Exit(True);
513
514 // get lineorder of source so we use the right direction
515 SrcLineOrder := GetBitmapOrder(SrcSection.dsBm, SrcBmp);
516
517 // setup info shared by alpha, source and destination bytes
518 FillChar(Info, sizeof(Info), 0);
519 Info.Header.biSize := sizeof(Windows.TBitmapInfoHeader);
520 Info.Header.biWidth := nWidthDest;
521 if SrcLineOrder = riloBottomToTop
522 then Info.Header.biHeight := nHeightDest
523 else Info.Header.biHeight := -nHeightDest;
524 Info.Header.biPlanes := 1;
525 Info.Header.biBitCount := 32;
526 Info.Header.biSizeImage := nWidthDest * nHeightDest * 4;
527 Info.Header.biCompression := BI_BITFIELDS;
528 // when 24bpp, CE only supports B8G8R8 encoding
529 Info.Colors[0] := $FF0000; {le-red}
530 Info.Colors[1] := $00FF00; {le-green}
531 Info.Colors[2] := $0000FF; {le-blue}
532
533 Result := False;
534 StretchSrc := (nWidthDest <> nWidthSrc) or (nHeightDest <> nHeightSrc);
535 if StretchSrc
536 then begin
537 // we need to strech the source
538
539 // create alphabmp
540 if blendFunction.AlphaFormat = AC_SRC_ALPHA
541 then begin
542 // create alpha source data
543 R := Classes.Rect(nXOriginSrc, nYOriginSrc, nXOriginSrc + nWidthSrc, nYOriginSrc + nHeightSrc);
544 if not GetBitmapBytes(SrcSection.dsBm, SrcBmp, R, rileDWordBoundary, SrcLineOrder, SrcBytesPtr, SrcSize) then Exit(False);
545
546 // set info to source size
547 Info.Header.biWidth := nWidthSrc;
548 if SrcLineOrder = riloBottomToTop
549 then Info.Header.biHeight := nHeightSrc
550 else Info.Header.biHeight := -nHeightSrc;
551 Info.Header.biSizeImage := nWidthSrc * nHeightSrc * 4;
552
553 // create temp bitmap to store orginal grayscale alpha
554 TmpBmp := CreateDIBSection(hdcSrc, PBitmapInfo(@Info)^, DIB_RGB_COLORS, TmpBytesPtr, 0, 0);
555 if TmpBmp = 0 then Exit(False);
556 if TmpBytesPtr = nil
557 then begin
558 FreeMem(SrcBytesPtr);
559 DeleteObject(TmpBmp);
560 Exit(False);
561 end;
562
563 // create grayscale image from alpha
564 TmpRGBA := TmpBytesPtr;
565 SrcRGBA := SrcBytesPtr;
566 while SrcSize > 0 do
567 begin
568 TmpRGBA^.Blue := SrcRGBA^.Alpha;
569 TmpRGBA^.Green := SrcRGBA^.Alpha;
570 TmpRGBA^.Red := SrcRGBA^.Alpha;
571 TmpRGBA^.Alpha := 255;
572 Inc(SrcRGBA);
573 Inc(TmpRGBA);
574 Dec(SrcSize, 4);
575 end;
576
577 // restore to destination size
578 Info.Header.biWidth := nWidthDest;
579 if SrcLineOrder = riloBottomToTop
580 then Info.Header.biHeight := nHeightDest
581 else Info.Header.biHeight := -nHeightDest;
582 Info.Header.biSizeImage := nWidthDest * nHeightDest * 4;
583
584 // create bitmap to store stretched grayscale alpha
585 AlphaBmp := CreateDIBSection(hdcSrc, PBitmapInfo(@Info)^, DIB_RGB_COLORS, AlphaBytesPtr, 0, 0);
586 if (AlphaBmp = 0) or (AlphaBytesPtr = nil)
587 then begin
588 FreeMem(SrcBytesPtr);
589 DeleteObject(TmpBmp);
590 DeleteObject(AlphaBmp);
591 Exit(False);
592 end;
593
594 // stretch grayscale alpha bitmap
595 DC := CreateCompatibleDC(hdcSrc);
596 OldBmp := SelectObject(DC, AlphaBmp);
597 TmpDC := CreateCompatibleDC(hdcSrc);
598 OldTmpBmp := SelectObject(TmpDC, TmpBmp);
599 StretchBlt(DC, 0, 0, nWidthDest, nHeightDest, TmpDC, 0, 0, nWidthSrc, nHeightSrc, SRCCOPY);
600 SelectObject(DC, OldBmp);
601 DeleteDC(DC);
602 SelectObject(TmpDC, OldTmpBmp);
603 DeleteDC(TmpDC);
604 DeleteObject(TmpBmp);
605 FreeMem(SrcBytesPtr);
606
607 // as long as AlphaBmp exists, AlphaBytesPtr is valid.
608 CleanupAlpha := True;
609 end
610 else begin
611 CleanupAlpha := False;
612 AlphaBmp := INVALID_HANDLE_VALUE;
613 end;
614
615 // create new srcbmp
616 SrcBmp := CreateDIBSection(hdcSrc, PBitmapInfo(@Info)^, DIB_RGB_COLORS, SrcBytesPtr, 0, 0);
617 if (SrcBmp = 0) or (SrcBytesPtr = nil)
618 then begin
619 DeleteObject(AlphaBmp);
620 DeleteObject(SrcBmp);
621 Exit(False);
622 end;
623 SrcSize := Info.Header.biSizeImage;
624 CleanupSrc := True;
625 CleanupSrcPtr := False;
626 SrcPixelBytes := 4;
627 SrcRowStride := nWidthDest * SrcPixelBytes;
628
629 DC := CreateCompatibleDC(hdcSrc);
630 OldBmp := SelectObject(DC, SrcBmp);
631 StretchBlt(DC, 0, 0, nWidthDest, nHeightDest, hdcSrc, nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc, SRCCOPY);
632 SelectObject(DC, OldBmp);
633 DeleteDC(DC);
634
635 // adjust source size
636 nWidthSrc := nWidthDest;
637 nHeightSrc := nHeightDest;
638 nXOriginSrc := 0;
639 nYOriginSrc := 0;
640 end
641 else begin
642 // only get source data
643 SrcPixelBytes := SrcSection.dsBm.bmBitsPixel shr 3;
644 if SrcSection.dsBm.bmBits <> nil
645 then begin
646 // source is a dibsection :)
647 SrcBytesPtr := SrcSection.dsBm.bmBits;
648 SrcRowStride := SrcSection.dsBm.bmWidthBytes;
649 CleanupSrc := False;
650 CleanupSrcPtr := False;
651 end
652 else begin
653 R := Classes.Rect(nXOriginSrc, nYOriginSrc, nXOriginSrc + nWidthSrc, nYOriginSrc + nHeightSrc);
654 if not GetBitmapBytes(SrcSection.dsBm, SrcBmp, R, rileDWordBoundary, SrcLineOrder, SrcBytesPtr, SrcSize) then Exit;
655 SrcRowStride := nWidthSrc * SrcPixelBytes;
656 CleanupSrc := False;
657 CleanupSrcPtr := True;
658 nXOriginSrc := 0;
659 nYOriginSrc := 0;
660 end;
661 AlphaBytesPtr := nil;
662 CleanupAlpha := False;
663 end;
664
665 // if a palette destination or destination isn't a section, create a temp DIB
666 if (DstSection.dsBm.bmBitsPixel < 24)
667 or (DstSection.dsBm.bmBits = nil)
668 or (DstSection.dsBmih.biCompression <> BI_RGB)
669 then begin
670 // create temp dib
671 DstBmp := CreateDIBSection(hdcSrc, PBitmapInfo(@Info)^, DIB_RGB_COLORS, DstBytesPtr, 0, 0);
672 // copy destination
673 DC := CreateCompatibleDC(hdcDest);
674 OldBmp := SelectObject(DC, DstBmp);
675 BitBlt(DC, 0, 0, nWidthDest, nHeightDest, hdcDest, nXOriginDest, nYOriginDest, SRCCOPY);
676 SelectObject(DC, OldBmp);
677 DeleteDC(DC);
678 DstPixelBytes := 4;
679 DstRowStride := nWidthDest * DstPixelBytes;
680 CleanupDst := True;
681 end
682 else begin
683 DstBytesPtr := DstSection.dsBm.bmBits;
684 DstPixelBytes := DstSection.dsBm.bmBitsPixel shr 3;
685 DstRowStride := DstSection.dsBm.bmWidthBytes;
686 Inc(PByte(DstBytesPtr), nXOriginDest + nYOriginDest * DstRowStride);
687 CleanupDst := False;
688 end;
689
690 // blend image
691 SrcLinePtr := SrcBytesPtr;
692 Inc(SrcLinePtr, nXOriginSrc * SrcPixelBytes + nYOriginSrc * SrcRowStride);
693 DstLinePtr := DstBytesPtr;
694
695 SrcAlpha := nil;
696 if blendFunction.AlphaFormat = AC_SRC_ALPHA
697 then begin
698 if AlphaBytesPtr <> nil
699 then SrcAlpha := AlphaBytesPtr;
700
701 if SCA {blendFunction.SourceConstantAlpha} = 255
702 then begin
703 for y := 1 to nHeightDest do
704 begin
705 SrcRGBA := Pointer(SrcLinePtr);
706 if AlphaBytesPtr = nil
707 then SrcAlpha := @SrcRGBA^.Alpha;
708 DstRGBA := Pointer(DstLinePtr);
709 for x := 1 to nWidthDest do
710 begin
711 if SrcAlpha^ <> 0
712 then begin
713 NotAlpha := not SrcAlpha^;
714 DstRGBA^.Red := SrcRgba^.Red + (DstRGBA^.Red * NotAlpha) div 255;
715 DstRGBA^.Green := SrcRgba^.Green + (DstRGBA^.Green * NotAlpha) div 255;
716 DstRGBA^.Blue := SrcRgba^.Blue + (DstRGBA^.Blue * NotAlpha) div 255;
717 if DstPixelBytes = 4
718 then DstRGBA^.Alpha := SrcAlpha^ + (DstRGBA^.Alpha * NotAlpha) div 255;
719 end;
720 Inc(SrcRGBA);
721 Inc(SrcAlpha, 4);
722 Inc(PByte(DstRGBA), DstPixelBytes);
723 end;
724 Inc(SrcLinePtr, SrcRowStride);
725 Inc(DstLinePtr, DstRowStride);
726 end;
727 end
728 else begin
729 for y := 1 to nHeightDest do
730 begin
731 SrcRGBA := Pointer(SrcLinePtr);
732 if AlphaBytesPtr = nil
733 then SrcAlpha := @SrcRGBA^.Alpha;
734 DstRGBA := Pointer(DstLinePtr);
735 for x := 1 to nWidthDest do
736 begin
737 if SrcAlpha^ <> 0
738 then begin
739 NotAlpha := not SrcAlpha^;
740 DstRGBA^.Red := (SrcRgba^.Red * SCA + DstRGBA^.Red * NotAlpha) div 255;
741 DstRGBA^.Green := (SrcRgba^.Green * SCA + DstRGBA^.Green * NotAlpha) div 255;
742 DstRGBA^.Blue := (SrcRgba^.Blue * SCA + DstRGBA^.Blue * NotAlpha) div 255;
743 if DstPixelBytes = 4
744 then DstRGBA^.Alpha := (SrcAlpha^ * SCA + DstRGBA^.Alpha * NotAlpha) div 255;
745 end;
746 Inc(SrcRGBA);
747 Inc(SrcAlpha, 4);
748 Inc(PByte(DstRGBA), DstPixelBytes);
749 end;
750 Inc(SrcLinePtr, SrcRowStride);
751 Inc(DstLinePtr, DstRowStride);
752 end;
753 end;
754 end
755 else begin
756 // no source alpha
757 NotAlpha := not SCA;
758 for y := 1 to nHeightDest do
759 begin
760 SrcRGBA := Pointer(SrcLinePtr);
761 if AlphaBytesPtr = nil
762 then SrcAlpha := @SrcRGBA^.Alpha;
763 DstRGBA := Pointer(DstLinePtr);
764 for x := 1 to nWidthDest do
765 begin
766 DstRGBA^.Red := (SrcRGBA^.Red * SCA + DstRGBA^.Red * NotAlpha) div 255;
767 DstRGBA^.Green := (SrcRGBA^.Green * SCA + DstRGBA^.Green * NotAlpha) div 255;
768 DstRGBA^.Blue := (SrcRGBA^.Blue * SCA + DstRGBA^.Blue * NotAlpha) div 255;
769 if (DstPixelBytes = 4) and (SrcPixelBytes = 4)
770 then DstRGBA^.Alpha := (SrcAlpha^ * SCA + DstRGBA^.Alpha * NotAlpha) div 255;
771 Inc(PByte(SrcRGBA), SrcPixelBytes);
772 Inc(PByte(DstRGBA), DstPixelBytes);
773 Inc(SrcAlpha, 4);
774 end;
775 Inc(SrcLinePtr, SrcRowStride);
776 Inc(DstLinePtr, DstRowStride);
777 end;
778 end;
779
780 // Replace destination if needed and do cleanup
781 if CleanupDst
782 then begin
783 DC := CreateCompatibleDC(hdcDest);
784 OldBmp := SelectObject(DC, DstBmp);
785 BitBlt(hdcDest, nXOriginDest, nYOriginDest, nWidthDest, nHeightDest, DC, 0, 0, SRCCOPY);
786 SelectObject(DC, OldBmp);
787 DeleteDC(DC);
788 DeleteObject(DstBmp);
789 end;
790 if CleanupSrc
791 then DeleteObject(SrcBmp);
792 if CleanupSrcPtr
793 then FreeMem(SrcBytesPtr);
794 if CleanupAlpha
795 then DeleteObject(AlphaBmp);
796 end;
797
798 // win98 only supports dibsections, so if not a dib section,
799 // we draw ourselves
800 {var
801 AlphaBlend98: function(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest, nHeightDest: Integer; hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc: Integer; blendFunction: TBlendFunction): BOOL; stdcall;
802 }
803
804 function _AlphaBlend98(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest, nHeightDest: Integer; hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc: Integer; blendFunction: TBlendFunction): BOOL; stdcall;
805 begin
806 // we can check the bitmaptypes here and call AlphaBlend98, but for now, just call own implementation
807 Result := _AlphaBlend(hdcDest, nXOriginDest, nYOriginDest, nWidthDest, nHeightDest, hdcSrc, nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc, blendFunction);
808 end;
809
810 function _GradientFill(DC: HDC; p2: PTriVertex; p3: ULONG; p4: Pointer; p5, p6: ULONG): BOOL;
811 begin
812 Result := False;
813 end;
814
815 function _GetComboboxInfo(hwndCombo: HWND; pcbi: PComboboxInfo): BOOL; stdcall;
816 begin
817 Result := (pcbi <> nil) and (pcbi^.cbSize = SizeOf(TComboboxInfo));
818 if Result then
819 begin
820 pcbi^.hwndCombo := hwndCombo;
821 if (GetWindowLong(hwndCombo, GWL_STYLE) and CBS_SIMPLE) <> 0 then
822 begin
823 pcbi^.hwndList := GetTopWindow(hwndCombo);
824 pcbi^.hwndItem := GetWindow(pcbi^.hwndList, GW_HWNDNEXT);
825 end
826 else
827 begin
828 pcbi^.hwndItem := GetTopWindow(hwndCombo);
829 pcbi^.hwndList := 0;
830 end;
831 end;
832 end;
833
834 function _GetMenuBarInfo(hwnd: HWND; idObject: LONG; idItem: LONG; pmbi: PMENUBARINFO): BOOL; stdcall;
835 begin
836 Result := False;
837 end;
838
839 function _GetWindowInfo(hwnd: HWND; pwi: PWINDOWINFO): BOOL; stdcall;
840 begin
841 Result := False;
842 end;
843
844 function _SHGetStockIconInfo(siid: integer; uFlags: UINT; psii: PSHSTOCKICONINFO): HResult; stdcall;
845 begin
846 Result := E_NOTIMPL;
847 end;
848
849 function _SetLayout(dc: HDC; l: DWord): DWord; stdcall;
850 begin
851 Result := GDI_ERROR;
852 end;
853
854 function _SetLayeredWindowAttributes(HWND: hwnd; crKey: COLORREF; bAlpha: byte; dwFlags: DWORD): BOOL; stdcall;
855 begin
856 Result := False;
857 end;
858
859 function _UpdateLayeredWindow(hWnd: HWND; hdcDst: HDC; pptDst: PPoint; psize: PSize;
860 hdcSrc: HDC; pptSrc: PPoint; crKey: COLORREF; pblend: PBlendFunction; dwFlags: DWORD): BOOL; stdcall;
861 begin
862 Result := False;
863 end;
864
865 function _IsProcessDPIAware: BOOL; stdcall;
866 begin
867 Result := False;
868 end;
869
870 function _TaskDialogIndirect(const pTaskConfig: PTASKDIALOGCONFIG; pnButton: PInteger; pnRadioButton: PInteger; pfVerificationFlagChecked: PBOOL): HRESULT; stdcall;
871 begin
872 Result := E_NOTIMPL;
873 end;
874
875 function _TaskDialog(hwndParent: HWND; hInstance: HINST; pszWindowTitle: PCWSTR; pszMainInstruction: PCWSTR; pszContent: PCWSTR;
876 dwCommonButtons: TASKDIALOG_COMMON_BUTTON_FLAGS; pszIcon: PCWSTR; pnButton: PInteger): HRESULT; stdcall;
877 begin
878 Result := E_NOTIMPL;
879 end;
880
881 function _SHCreateItemFromParsingName(pszPath: PCWSTR; pbc: IBindCtx; const riid: REFIID; out ppv): HResult; stdcall;
882 begin
883 Result := E_NOTIMPL;
884 end;
885
886 function GetComCtlVersion: Cardinal;
887 begin
888 if (ComCtlVersion <> 0) then
889 Result := ComCtlVersion
890 else
891 Result := GetFileVersion(comctl32);
892 end;
893
894 function HasManifest: Boolean;
895 begin
896 Result := (GetComCtlVersion >= ComCtlVersionIE6);
897 end;
898
899 const
900 msimg32lib = 'msimg32.dll';
901 user32lib = 'user32.dll';
902 shell32lib = 'shell32.dll';
903 gdi32lib = 'gdi32.dll';
904 comctl32lib = 'comctl32.dll';
905
906 var
907 msimg32handle: THandle = 0;
908 user32handle: THandle = 0;
909 shell32handle: THandle = 0;
910 gdi32handle: THandle = 0;
911 comctl32handle: THandle = 0;
912
913 procedure Initialize;
914 var
915 p: Pointer;
916 begin
917 if WindowsVersion = wvUnknown then
918 UpdateWindowsVersion;
919 ComCtlVersion := GetComCtlVersion;
920
921 GetComboBoxInfo := nil;
922 GetMenuBarInfo := nil;
923 GetWindowInfo := nil;
924
925 // defaults
926 Pointer(GradientFill) := @_GradientFill;
927 // Detect win98 since aplhablend doesn't support all bitmap types
928 if WindowsVersion = wv98
929 then Pointer(AlphaBlend) := @_AlphaBlend98
930 else Pointer(AlphaBlend) := @_AlphaBlend;
931
932
933 msimg32handle := LoadLibrary(msimg32lib);
934 if msimg32handle <> 0
935 then begin
936 if WindowsVersion <> wv98
937 then begin
938 p := GetProcAddress(msimg32handle, 'AlphaBlend');
939 if p <> nil
940 then Pointer(AlphaBlend) := p;
941 end;
942
943 p := GetProcAddress(msimg32handle, 'GradientFill');
944 if p <> nil
945 then Pointer(GradientFill) := p;
946 end;
947
948 // Defaults
949 Pointer(GetComboboxInfo) := @_GetComboboxInfo;
950 Pointer(GetMenuBarInfo) := @_GetMenuBarInfo;
951 Pointer(GetWindowInfo) := @_GetWindowInfo;
952 Pointer(SetLayeredWindowAttributes) := @_SetLayeredWindowAttributes;
953 Pointer(UpdateLayeredWindow) := @_UpdateLayeredWindow;
954 Pointer(IsProcessDPIAware) := @_IsProcessDPIAware;
955
956 user32handle := LoadLibrary(user32lib);
957 if user32handle <> 0 then
958 begin
959 p := GetProcAddress(user32handle, 'GetComboBoxInfo');
960 if p <> nil
961 then Pointer(GetComboboxInfo) := p;
962
963 p := GetProcAddress(user32handle, 'GetMenuBarInfo');
964 if p <> nil
965 then Pointer(GetMenuBarInfo) := p;
966
967 p := GetProcAddress(user32handle, 'GetWindowInfo');
968 if p <> nil
969 then Pointer(GetWindowInfo) := p;
970
971 p := GetProcAddress(user32handle, 'SetLayeredWindowAttributes');
972 if p <> nil
973 then Pointer(SetLayeredWindowAttributes) := p;
974
975 p := GetProcAddress(user32handle, 'UpdateLayeredWindow');
976 if p <> nil
977 then Pointer(UpdateLayeredWindow) := p;
978
979 p := GetProcAddress(user32handle, 'IsProcessDPIAware');
980 if p <> nil
981 then Pointer(IsProcessDPIAware) := p;
982 end;
983
984 // Defaults
985 Pointer(SHGetStockIconInfo) := @_SHGetStockIconInfo;
986 Pointer(SHCreateItemFromParsingName) := @_SHCreateItemFromParsingName;
987
988 shell32handle := LoadLibrary(shell32lib);
989 if shell32handle <> 0 then
990 begin
991 p := GetProcAddress(shell32handle, 'SHGetStockIconInfo');
992 if p <> nil
993 then Pointer(SHGetStockIconInfo) := p;
994
995 p := GetProcAddress(shell32handle, 'SHCreateItemFromParsingName');
996 if p <> nil
997 then Pointer(SHCreateItemFromParsingName) := p;
998 end;
999
1000 // Defaults
1001 Pointer(SetLayout) := @_SetLayout;
1002
1003 gdi32handle := LoadLibrary(gdi32lib);
1004 if gdi32handle <> 0 then
1005 begin
1006 p := GetProcAddress(gdi32handle, 'SetLayout');
1007 if p <> nil
1008 then Pointer(SetLayout) := p;
1009 end;
1010
1011 // Defaults
1012 Pointer(TaskDialogIndirect) := @_TaskDialogIndirect;
1013 Pointer(TaskDialog) := @_TaskDialog;
1014
1015 comctl32handle := LoadLibrary(comctl32lib);
1016 if comctl32handle <> 0 then
1017 begin
1018 p := GetProcAddress(comctl32handle, 'TaskDialogIndirect');
1019 if p <> nil
1020 then Pointer(TaskDialogIndirect) := p;
1021
1022 p := GetProcAddress(comctl32handle, 'TaskDialog');
1023 if p <> nil
1024 then Pointer(TaskDialog) := p;
1025 end;
1026 end;
1027
1028 procedure Finalize;
1029 begin
1030 AlphaBlend := @_AlphaBlend;
1031 GetComboboxInfo := nil;
1032 GetMenuBarInfo := nil;
1033
1034 if msimg32handle <> 0
1035 then FreeLibrary(msimg32handle);
1036 msimg32handle := 0;
1037
1038 if user32handle <> 0 then
1039 FreeLibrary(user32handle);
1040 user32handle := 0;
1041
1042 if shell32handle <> 0 then
1043 FreeLibrary(shell32handle);
1044 shell32handle := 0;
1045
1046 if gdi32handle <> 0 then
1047 FreeLibrary(gdi32handle);
1048 gdi32handle := 0;
1049
1050 if comctl32handle <> 0 then
1051 FreeLibrary(comctl32handle);
1052 comctl32handle := 0;
1053 end;
1054
1055
1056 initialization
1057 Initialize;
1058
1059 finalization
1060 Finalize;
1061
1062 end.
1063