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