paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-24 12:49:02 +02:00
Code Issues Packages Projects Releases Wiki Activity
1259df9b51
lazarus/lcl/interfaces/customdrawn/customdrawn_winextra.pas

1060 lines
40 KiB
ObjectPascal
Raw Blame History

{
Extra Win32 code that's not in the RTL.
Copyright (C) 2001, 2002 Keith Bowes.
Modified by Marc Weustink
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
}
unit customdrawn_winextra;
{$mode objfpc}{$H+}
{$DEFINE WindowsUnicodeSupport}
{$DEFINE UseVistaDialogs}
{$IFDEF TRACE}
{$ASSERTIONS ON}
{$ENDIF}
{$PACKRECORDS C}
{$SMARTLINK ON}
interface
uses
InterfaceBase, Classes, LCLType, Windows, GraphType, SysUtils, ActiveX, ShlObj;
// from win32wsdialogs
type
TApplicationState = record
ActiveWindow: HWND;
FocusedWindow: HWND;
DisabledWindows: TList;
end;
type
tagMENUBARINFO = record
cbSize: DWORD;
rcBar: TRect;
hMenu: HMENU;
hwndMenu: HWND;
Flags: DWORD;
end;
MENUBARINFO = tagMENUBARINFO;
PMENUBARINFO = ^tagMENUBARINFO;
// Window information snapshot
tagWINDOWINFO = record
cbSize: DWORD;
rcWindow: TRect;
rcClient: TRect;
dwStyle: DWORD;
dwExStyle: DWORD;
dwWindowStatus: DWORD;
cxWindowBorders: UINT;
cyWindowBorders: UINT;
atomWindowType: ATOM;
wCreatorVersion: WORD;
end;
WINDOWINFO = tagWINDOWINFO;
PWINDOWINFO = ^tagWINDOWINFO;
// ===================== Task Dialog =========================
PFTASKDIALOGCALLBACK = function(hwnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM; lpRefData: LONG_PTR): HRESULT; stdcall;
// _TASKDIALOG_FLAGS enum
const
TDF_ENABLE_HYPERLINKS = $0001;
TDF_USE_HICON_MAIN = $0002;
TDF_USE_HICON_FOOTER = $0004;
TDF_ALLOW_DIALOG_CANCELLATION = $0008;
TDF_USE_COMMAND_LINKS = $0010;
TDF_USE_COMMAND_LINKS_NO_ICON = $0020;
TDF_EXPAND_FOOTER_AREA = $0040;
TDF_EXPANDED_BY_DEFAULT = $0080;
TDF_VERIFICATION_FLAG_CHECKED = $0100;
TDF_SHOW_PROGRESS_BAR = $0200;
TDF_SHOW_MARQUEE_PROGRESS_BAR = $0400;
TDF_CALLBACK_TIMER = $0800;
TDF_POSITION_RELATIVE_TO_WINDOW = $1000;
TDF_RTL_LAYOUT = $2000;
TDF_NO_DEFAULT_RADIO_BUTTON = $4000;
TDF_CAN_BE_MINIMIZED = $8000;
type
TASKDIALOG_FLAGS = Integer; // Note: _TASKDIALOG_FLAGS is an int
// _TASKDIALOG_MESSAGES enum
const
TDM_NAVIGATE_PAGE = WM_USER+101;
TDM_CLICK_BUTTON = WM_USER+102; // wParam = Button ID
TDM_SET_MARQUEE_PROGRESS_BAR = WM_USER+103; // wParam = 0 (nonMarque) wParam != 0 (Marquee)
TDM_SET_PROGRESS_BAR_STATE = WM_USER+104; // wParam = new progress state
TDM_SET_PROGRESS_BAR_RANGE = WM_USER+105; // lParam = MAKELPARAM(nMinRange, nMaxRange)
TDM_SET_PROGRESS_BAR_POS = WM_USER+106; // wParam = new position
TDM_SET_PROGRESS_BAR_MARQUEE = WM_USER+107; // wParam = 0 (stop marquee), wParam != 0 (start marquee), lparam = speed (milliseconds between repaints)
TDM_SET_ELEMENT_TEXT = WM_USER+108; // wParam = element (TASKDIALOG_ELEMENTS), lParam = new element text (LPCWSTR)
TDM_CLICK_RADIO_BUTTON = WM_USER+110; // wParam = Radio Button ID
TDM_ENABLE_BUTTON = WM_USER+111; // lParam = 0 (disable), lParam != 0 (enable), wParam = Button ID
TDM_ENABLE_RADIO_BUTTON = WM_USER+112; // lParam = 0 (disable), lParam != 0 (enable), wParam = Radio Button ID
TDM_CLICK_VERIFICATION = WM_USER+113; // wParam = 0 (unchecked), 1 (checked), lParam = 1 (set key focus)
TDM_UPDATE_ELEMENT_TEXT = WM_USER+114; // wParam = element (TASKDIALOG_ELEMENTS), lParam = new element text (LPCWSTR)
TDM_SET_BUTTON_ELEVATION_REQUIRED_STATE = WM_USER+115; // wParam = Button ID, lParam = 0 (elevation not required), lParam != 0 (elevation required)
TDM_UPDATE_ICON = WM_USER+116; // wParam = icon element (TASKDIALOG_ICON_ELEMENTS), lParam = new icon (hIcon if TDF_USE_HICON_* was set, PCWSTR otherwise)
// _TASKDIALOG_NOTIFICATIONS enum
const
TDN_CREATED = 0;
TDN_NAVIGATED = 1;
TDN_BUTTON_CLICKED = 2; // wParam = Button ID
TDN_HYPERLINK_CLICKED = 3; // lParam = (LPCWSTR)pszHREF
TDN_TIMER = 4; // wParam = Milliseconds since dialog created or timer reset
TDN_DESTROYED = 5;
TDN_RADIO_BUTTON_CLICKED = 6; // wParam = Radio Button ID
TDN_DIALOG_CONSTRUCTED = 7;
TDN_VERIFICATION_CLICKED = 8; // wParam = 1 if checkbox checked, 0 if not, lParam is unused and always 0
TDN_HELP = 9;
TDN_EXPANDO_BUTTON_CLICKED = 10; // wParam = 0 (dialog is now collapsed), wParam != 0 (dialog is now expanded)
type
_TASKDIALOG_BUTTON = packed record
nButtonID: Integer;
pszButtonText: PCWSTR;
end;
TASKDIALOG_BUTTON = _TASKDIALOG_BUTTON;
TTASKDIALOG_BUTTON = TASKDIALOG_BUTTON;
PTASKDIALOG_BUTTON = ^TASKDIALOG_BUTTON;
// _TASKDIALOG_ELEMENTS enum
const
TDE_CONTENT = 0;
TDE_EXPANDED_INFORMATION = 1;
TDE_FOOTER = 2;
TDE_MAIN_INSTRUCTION = 3;
// _TASKDIALOG_ICON_ELEMENTS enum
TDIE_ICON_MAIN = 0;
TDIE_ICON_FOOTER = 1;
TD_WARNING_ICON = MAKEINTRESOURCEW(Word(-1));
TD_ERROR_ICON = MAKEINTRESOURCEW(Word(-2));
TD_INFORMATION_ICON = MAKEINTRESOURCEW(Word(-3));
TD_SHIELD_ICON = MAKEINTRESOURCEW(Word(-4));
TD_SHIELD_GRADIENT_ICON = MAKEINTRESOURCEW(Word(-5));
TD_SHIELD_WARNING_ICON = MAKEINTRESOURCEW(Word(-6));
TD_SHIELD_ERROR_ICON = MAKEINTRESOURCEW(Word(-7));
TD_SHIELD_OK_ICON = MAKEINTRESOURCEW(Word(-8));
TD_SHIELD_GRAY_ICON = MAKEINTRESOURCEW(Word(-9));
// _TASKDIALOG_COMMON_BUTTON_FLAGS enum
TDCBF_OK_BUTTON = $0001; // selected control return value IDOK
TDCBF_YES_BUTTON = $0002; // selected control return value IDYES
TDCBF_NO_BUTTON = $0004; // selected control return value IDNO
TDCBF_CANCEL_BUTTON = $0008; // selected control return value IDCANCEL
TDCBF_RETRY_BUTTON = $0010; // selected control return value IDRETRY
TDCBF_CLOSE_BUTTON = $0020; // selected control return value IDCLOSE
type
TASKDIALOG_COMMON_BUTTON_FLAGS = Integer; // Note: _TASKDIALOG_COMMON_BUTTON_FLAGS is an int
_TASKDIALOGCONFIG = packed record
cbSize: UINT;
hwndParent: HWND;
hInstance: HINST; // used for MAKEINTRESOURCE() strings
dwFlags: TASKDIALOG_FLAGS; // TASKDIALOG_FLAGS (TDF_XXX) flags
dwCommonButtons: TASKDIALOG_COMMON_BUTTON_FLAGS; // TASKDIALOG_COMMON_BUTTON (TDCBF_XXX) flags
pszWindowTitle: PCWSTR; // string or MAKEINTRESOURCE()
case Boolean of
False: (hMainIcon: HICON);
True: (
pszMainIcon: PCWSTR;
pszMainInstruction: PCWSTR;
pszContent: PCWSTR;
cButtons: UINT;
pButtons: PTASKDIALOG_BUTTON;
nDefaultButton: Integer;
cRadioButtons: UINT;
pRadioButtons: PTASKDIALOG_BUTTON;
nDefaultRadioButton: Integer;
pszVerificationText: PCWSTR;
pszExpandedInformation: PCWSTR;
pszExpandedControlText: PCWSTR;
pszCollapsedControlText: PCWSTR;
case Boolean of
False: (hFooterIcon: HICON);
True: (
pszFooterIcon: PCWSTR;
pszFooter: PCWSTR;
pfCallback: PFTASKDIALOGCALLBACK;
lpCallbackData: LONG_PTR;
cxWidth: UINT; // width of the Task Dialog's client area in DLU's. If 0, Task Dialog will calculate the ideal width.
);
);
end;
TASKDIALOGCONFIG = _TASKDIALOGCONFIG;
PTASKDIALOGCONFIG = ^TASKDIALOGCONFIG;
TTASKDIALOGCONFIG = TASKDIALOGCONFIG;
// ==================== End TaskDialog =======================
// File dialogs
type
GETPROPERTYSTOREFLAGS = DWord;
SIATTRIBFLAGS = DWord;
CDCONTROLSTATEF = DWord;
_tagpropertykey = packed record
fmtid: TGUID;
pid: DWORD;
end;
PROPERTYKEY = _tagpropertykey;
REFPROPERTYKEY = ^PROPERTYKEY;
REFPROPVARIANT = ^TPROPVARIANT;
{$ifdef UseVistaDialogs}
IEnumShellItems = interface(IUnknown)
['{70629033-e363-4a28-a567-0db78006e6d7}']
function Next(celt: ULONG; out rgelt: IShellItem; var pceltFetched: ULONG): HResult; stdcall;
function Skip(celt: ULONG): HResult; stdcall;
function Reset: HResult; stdcall;
function Clone(out ppenum: IEnumShellItems): HResult; stdcall;
end;
IShellItemArray = interface(IUnknown)
['{b63ea76d-1f85-456f-a19c-48159efa858b}']
function BindToHandler(pbc: IBindCtx; const bhid: TGUID; const riid: REFIID; out ppvOut): HResult; stdcall;
function GetPropertyStore(flags: GETPROPERTYSTOREFLAGS; const riid: REFIID; out ppv): HResult; stdcall;
function GetPropertyDescriptionList(keyType: REFPROPERTYKEY; const riid: REFIID; out ppv): HResult; stdcall;
function GetAttributes(AttribFlags: SIATTRIBFLAGS; sfgaoMask: SFGAOF; var psfgaoAttribs: SFGAOF): HResult; stdcall;
function GetCount(var pdwNumItems: DWORD): HResult; stdcall;
function GetItemAt(dwIndex: DWORD; var ppsi: IShellItem): HResult; stdcall;
function EnumItems(var ppenumShellItems: IEnumShellItems): HResult; stdcall;
end;
IPropertyStore = interface(IUnknown)
['{886d8eeb-8cf2-4446-8d02-cdba1dbdcf99}']
function GetCount(out cProps: DWORD): HResult; stdcall;
function GetAt(iProp: DWORD; out pkey: PROPERTYKEY): HResult; stdcall;
function GetValue(key: REFPROPERTYKEY; out pv: PROPVARIANT): HResult; stdcall;
function SetValue(key: REFPROPERTYKEY; propvar: REFPROPVARIANT): HResult; stdcall;
function Commit: HResult; stdcall;
end;
IPropertyDescriptionList = interface(IUnknown)
['{1f9fc1d0-c39b-4b26-817f-011967d3440e}']
function GetCount(out pcElem: UINT): HResult; stdcall;
function GetAt(iElem: UINT; const riid: REFIID; out ppv): HResult; stdcall;
end;
IFileOperationProgressSink = interface(IUnknown)
['{04b0f1a7-9490-44bc-96e1-4296a31252e2}']
function StartOperations: HResult; stdcall;
function FinishOperations(hrResult: HResult): HResult; stdcall;
function PreRenameItem(dwFlags: DWORD; psiItem: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
function PostRenameItem(dwFlags: DWORD; psiItem: IShellItem; pszNewName: LPCWSTR; hrRename: HRESULT; psiNewlyCreated: IShellItem): HResult; stdcall;
function PreMoveItem(dwFlags: DWORD; psiItem: IShellItem; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
function PostMoveItem(dwFlags: DWORD; psiItem: IShellItem; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR; hrMove: HRESULT; psiNewlyCreated: IShellItem): HResult; stdcall;
function PreCopyItem(dwFlags: DWORD; psiItem: IShellItem; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
function PostCopyItem(dwFlags: DWORD; psiItem: IShellItem; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR; hrCopy: HRESULT; psiNewlyCreated: IShellItem): HResult; stdcall;
function PreDeleteItem(dwFlags: DWORD; psiItem: IShellItem): HResult; stdcall;
function PostDeleteItem(dwFlags: DWORD; psiItem: IShellItem; hrDelete: HRESULT; psiNewlyCreated: IShellItem): HResult; stdcall;
function PreNewItem(dwFlags: DWORD; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
function PostNewItem(dwFlags: DWORD; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR; pszTemplateName: LPCWSTR; dwFileAttributes: DWORD; hrNew: HRESULT; psiNewItem: IShellItem): HResult; stdcall;
function UpdateProgress(iWorkTotal: UINT; iWorkSoFar: UINT): HResult; stdcall;
function ResetTimer: HResult; stdcall;
function PauseTimer: HResult; stdcall;
function ResumeTimer: HResult; stdcall;
end;
IFileDialogCustomize = interface(IUnknown)
['{e6fdd21a-163f-4975-9c8c-a69f1ba37034}']
function EnableOpenDropDown(dwIDCtl: DWORD): HResult; stdcall;
function AddMenu(dwIDCtl: DWORD; pszLabel: LPCWSTR): HResult; stdcall;
function AddPushButton(dwIDCtl: DWORD; pszLabel: LPCWSTR): HResult; stdcall;
function AddComboBox(dwIDCtl: DWORD): HResult; stdcall;
function AddRadioButtonList(dwIDCtl: DWORD): HResult; stdcall;
function AddCheckButton(dwIDCtl: DWORD; pszLabel: LPCWSTR; bChecked: BOOL): HResult; stdcall;
function AddEditBox(dwIDCtl: DWORD; pszText: LPCWSTR): HResult; stdcall;
function AddSeparator(dwIDCtl: DWORD): HResult; stdcall;
function AddText(dwIDCtl: DWORD; pszText: LPCWSTR): HResult; stdcall;
function SetControlLabel(dwIDCtl: DWORD; pszLabel: LPCWSTR): HResult; stdcall;
function GetControlState(dwIDCtl: DWORD; out pdwState: CDCONTROLSTATEF): HResult; stdcall;
function SetControlState(dwIDCtl: DWORD; dwState: CDCONTROLSTATEF): HResult; stdcall;
function GetEditBoxText(dwIDCtl: DWORD; out ppszText: WCHAR): HResult; stdcall;
function SetEditBoxText(dwIDCtl: DWORD; pszText: LPCWSTR): HResult; stdcall;
function GetCheckButtonState(dwIDCtl: DWORD; out pbChecked: BOOL): HResult; stdcall;
function SetCheckButtonState(dwIDCtl: DWORD; bChecked: BOOL): HResult; stdcall;
function AddControlItem(dwIDCtl: DWORD; dwIDItem: DWORD; pszLabel: LPCWSTR): HResult; stdcall;
function RemoveControlItem(dwIDCtl: DWORD; dwIDItem: DWORD): HResult; stdcall;
function RemoveAllControlItems(dwIDCtl: DWORD): HResult; stdcall;
function GetControlItemState(dwIDCtl: DWORD; dwIDItem: DWORD; out pdwState: CDCONTROLSTATEF): HResult; stdcall;
function SetControlItemState(dwIDCtl: DWORD; dwIDItem: DWORD; dwState: CDCONTROLSTATEF): HResult; stdcall;
function GetSelectedControlItem(dwIDCtl: DWORD; out pdwIDItem: DWORD): HResult; stdcall;
function SetSelectedControlItem(dwIDCtl: DWORD; dwIDItem: DWORD): HResult; stdcall;
function StartVisualGroup(dwIDCtl: DWORD; pszLabel: LPCWSTR): HResult; stdcall;
function EndVisualGroup: HResult; stdcall;
function MakeProminent(dwIDCtl: DWORD): HResult; stdcall;
function SetControlItemText(dwIDCtl: DWORD; dwIDItem: DWORD; pszLabel: LPCWSTR): HResult; stdcall;
end;
IFileDialogControlEvents = interface(IUnknown)
['{36116642-D713-4b97-9B83-7484A9D00433}']
function OnItemSelected(pfdc: IFileDialogCustomize; dwIDCtl: DWORD; dwIDItem: DWORD): HResult; stdcall;
function OnButtonClicked(pfdc: IFileDialogCustomize; dwIDCtl: DWORD): HResult; stdcall;
function OnCheckButtonToggled(pfdc: IFileDialogCustomize; dwIDCtl: DWORD; bChecked: BOOL): HResult; stdcall;
function OnControlActivating(pfdc: IFileDialogCustomize; dwIDCtl: DWORD): HResult; stdcall;
end;
IFileOpenDialog = interface(IFileDialog)
['{d57c7288-d4ad-4768-be02-9d969532d960}']
function GetResults(var ppenum: IShellItemArray): HResult; stdcall;
function GetSelectedItems(var ppsai: IShellItemArray): HResult; stdcall;
end;
IFileSaveDialog = interface(IFileDialog)
['{84bccd23-5fde-4cdb-aea4-af64b83d78ab}']
function SetSaveAsItem(psi: IShellItem): HResult; stdcall;
function SetProperties(pStore: IPropertyStore): HResult; stdcall;
function SetCollectedProperties(pList: IPropertyDescriptionList; fAppendDefault: BOOL): HResult; stdcall;
function GetProperties(var ppStore: IPropertyStore): HResult; stdcall;
function ApplyProperties(psi: IShellItem; pStore: IPropertyStore; hwnd: HWND; pSink: IFileOperationProgressSink): HResult; stdcall;
end;
{$endif}
// AlphaBlend is only defined for win98&2k and up
// load dynamic and use ownfunction if not defined
var
AlphaBlend: function(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest, nHeightDest: Integer; hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc: Integer; blendFunction: TBlendFunction): BOOL; stdcall;
GradientFill: function(DC: HDC; p2: PTriVertex; p3: ULONG; p4: Pointer; p5, p6: ULONG): BOOL; stdcall;
GetComboBoxInfo: function(hwndCombo: HWND; pcbi: PComboboxInfo): BOOL; stdcall;
GetMenuBarInfo: function(hwnd: HWND; idObject: LONG; idItem: LONG; pmbi: PMENUBARINFO): BOOL; stdcall;
//GetWindowInfo: function(hwnd: HWND; pwi: PWINDOWINFO): BOOL; stdcall;
SetLayout: function(dc: HDC; l: DWord): DWord; stdcall;
SetLayeredWindowAttributes: function (HWND: hwnd; crKey: COLORREF; bAlpha: byte; dwFlags: DWORD): BOOL; stdcall;
UpdateLayeredWindow: function(hWnd: HWND; hdcDst: HDC; pptDst: PPoint; psize: PSize;
hdcSrc: HDC; pptSrc: PPoint; crKey: COLORREF; pblend: PBlendFunction; dwFlags: DWORD): BOOL; stdcall;
IsProcessDPIAware: function: BOOL; stdcall;
TaskDialogIndirect: function(const pTaskConfig: PTASKDIALOGCONFIG; pnButton: PInteger; pnRadioButton: PInteger; pfVerificationFlagChecked: PBOOL): HRESULT; stdcall;
TaskDialog: function(hwndParent: HWND; hInstance: HINST; pszWindowTitle: PCWSTR; pszMainInstruction: PCWSTR; pszContent: PCWSTR;
dwCommonButtons: TASKDIALOG_COMMON_BUTTON_FLAGS; pszIcon: PCWSTR; pnButton: PInteger): HRESULT; stdcall;
SHCreateItemFromParsingName: function(pszPath: PCWSTR; pbc: IBindCtx; const riid: REFIID; out ppv): HResult; stdcall;
const
// ComCtlVersions
ComCtlVersionIE3 = $00040046;
ComCtlVersionIE4 = $00040047;
ComCtlVersionIE401 = $00040048;
ComCtlVersionIE5 = $00050050;
ComCtlVersionIE501 = $00050051;
ComCtlVersionIE6 = $00060000;
type
SHSTOCKICONINFO = record
cbSize: DWORD;
hIcon: HICON;
iSysImageIndex: integer;
iIcon: integer;
szPath: array[0..MAX_PATH - 1] of WCHAR;
end;
TSHSTOCKICONINFO = SHSTOCKICONINFO;
PSHSTOCKICONINFO = ^SHSTOCKICONINFO;
var
SHGetStockIconInfo: function(siid: integer; uFlags: UINT; psii: PSHSTOCKICONINFO): HResult; stdcall;
const
SIID_SHIELD = 77;
type
//64bit safe Timer functions and callback
//todo: remove as soon the last supported fpc version has updated header (rev 22526)
TIMERPROC = procedure (hWnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
function SetTimer(hWnd:HWND; nIDEvent:UINT_PTR; uElapse:UINT; lpTimerFunc: TIMERPROC): UINT_PTR; stdcall; external 'user32' name 'SetTimer';
function KillTimer(hWnd:HWND; uIDEvent:UINT_PTR):WINBOOL; stdcall; external 'user32' name 'KillTimer';
function SaveApplicationState: TApplicationState;
procedure RestoreApplicationState(AState: TApplicationState);
function UTF8StringToPWideChar(const s: string) : PWideChar;
function UTF8StringToPAnsiChar(const s: string) : PAnsiChar;
implementation
uses
customdrawn_WinProc, forms;
function SaveApplicationState: TApplicationState;
begin
Result.ActiveWindow := Windows.GetActiveWindow;
Result.FocusedWindow := Windows.GetFocus;
Result.DisabledWindows := Screen.DisableForms(nil);
end;
procedure RestoreApplicationState(AState: TApplicationState);
begin
Screen.EnableForms(AState.DisabledWindows);
Windows.SetActiveWindow(AState.ActiveWindow);
Windows.SetFocus(AState.FocusedWindow);
end;
// The size of the OPENFILENAME record depends on the windows version
// In the initialization section the correct size is determined.
var
OpenFileNameSize: integer = 0;
// Returns a new PWideChar containing the string UTF8 string s as widechars
function UTF8StringToPWideChar(const s: string) : PWideChar;
begin
// a string of widechars will need at most twice the amount of bytes
// as the corresponding UTF8 string
Result := GetMem(length(s)*2+2);
Utf8ToUnicode(Result,length(s)+1,pchar(s),length(s)+1);
end;
// Returns a new PChar containing the string UTF8 string s as ansichars
function UTF8StringToPAnsiChar(const s: string) : PAnsiChar;
var
AnsiChars: string;
begin
AnsiChars:= Utf8ToAnsi(s);
Result := GetMem(length(AnsiChars)+1);
Move(PChar(AnsiChars)^, Result^, length(AnsiChars)+1);
end;
{$PACKRECORDS NORMAL}
function _AlphaBlend(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest, nHeightDest: Integer; hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc: Integer; blendFunction: TBlendFunction): BOOL; stdcall;
var
SCA: Byte absolute blendFunction.SourceConstantAlpha;
R: TRect;
DC, TmpDC: HDC;
OldBmp, OldTmpBmp, SrcBmp, DstBmp, TmpBmp, AlphaBmp: HBITMAP;
StretchSrc: Boolean;
SrcSection, DstSection: TDIBSection;
Info: record
Header: TBitmapInfoHeader;
Colors: array[0..3] of Cardinal; // reserve extra color for colormasks
end;
SrcBytesPtr, DstBytesPtr, TmpBytesPtr, AlphaBytesPtr: Pointer;
SrcLinePtr, DstLinePtr: PByte;
CleanupSrc, CleanupSrcPtr, CleanupDst, CleanupAlpha: Boolean;
SrcSize: PtrUInt;
SrcPixelBytes, DstPixelBytes: Byte;
SrcRowStride, DstRowStride: Integer;
SrcLineOrder: TRawImageLineOrder;
X, Y: Integer;
SrcRGBA, TmpRGBA, DstRGBA: PRGBAQuad;
SrcAlpha: PByte;
NotAlpha: Byte;
begin
if nXOriginSrc < 0 then Exit(False);
if nYOriginSrc < 0 then Exit(False);
if nWidthSrc < 0 then Exit(False);
if nHeightSrc < 0 then Exit(False);
if nWidthDest < 0 then Exit(False);
if nHeightDest < 0 then Exit(False);
if blendFunction.SourceConstantAlpha = 0
then Exit(True); // nothing to do
if (blendFunction.AlphaFormat = 0)
and (blendFunction.SourceConstantAlpha = 255)
then begin
// simple strechblt
Result := StretchBlt(hdcDest, nXOriginDest, nYOriginDest, nWidthDest, nHeightDest, hdcSrc, nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc, SRCCOPY);
Exit;
end;
// get source info, atleast bitmap, if possible also section
if GetObjectType(hdcSrc) <> OBJ_MEMDC then Exit(False);
SrcBmp := GetCurrentObject(hdcSrc, OBJ_BITMAP);
if GetObject(SrcBmp, SizeOf(SrcSection), @SrcSection) = 0 then Exit(False);
if nXOriginSrc + nWidthSrc > SrcSection.dsBm.bmWidth then Exit(False);
if nYOriginSrc + nHeightSrc > SrcSection.dsBm.bmHeight then Exit(False);
if (blendFunction.AlphaFormat = AC_SRC_ALPHA) and (SrcSection.dsBm.bmBitsPixel <> 32) then Exit(False); // invalid
// get destination info, atleast bitmap, if possible also section
if WindowsVersion in [wv95, wv98]
then begin
// under windows 98 GetObjectType() sometimes produce AV inside and
// as result our debugger stopes and show exception
// lazarus is not alone application with such problem under windows 98
// here is workaround for windows 9x
DstBmp := GetCurrentObject(hdcDest, OBJ_BITMAP);
DstSection.dsBm.bmBits := nil;
if (DstBmp <> 0)
and ((GetObject(DstBmp, SizeOf(DstSection), @DstSection) < SizeOf(TDIBSection)) or (DstSection.dsBm.bmBits = nil))
then DstBmp := 0;
end
else begin
if GetObjectType(hdcDest) = OBJ_MEMDC
then DstBmp := GetCurrentObject(hdcDest, OBJ_BITMAP)
else DstBmp := 0;
if (DstBmp <> 0) and (GetObject(DstBmp, SizeOf(DstSection), @DstSection) = 0)
then DstBmp := 0;
end;
if (DstBmp = 0)
then begin
// GetCurrentObject can only be used on memory devices,
// so fill in some values manually
DstSection.dsBm.bmWidth := GetDeviceCaps(hdcDest, HORZRES);
DstSection.dsBm.bmHeight := GetDeviceCaps(hdcDest, VERTRES);
DstSection.dsBm.bmBitsPixel := GetDeviceCaps(hdcDest, BITSPIXEL);
DstSection.dsBm.bmBits := nil;
end;
// docs doesn't require dest retangle inside dest.
// however if dest rect is outside the destination, we're done here
if nXOriginDest + nWidthDest < 0 then Exit(True);
if nYOriginDest + nHeightDest < 0 then Exit(True);
if nXOriginDest >= DstSection.dsBm.bmWidth then Exit(True);
if nYOriginDest >= DstSection.dsBm.bmHeight then Exit(True);
// get lineorder of source so we use the right direction
SrcLineOrder := GetBitmapOrder(SrcSection.dsBm, SrcBmp);
// setup info shared by alpha, source and destination bytes
FillChar(Info, sizeof(Info), 0);
Info.Header.biSize := sizeof(Windows.TBitmapInfoHeader);
Info.Header.biWidth := nWidthDest;
if SrcLineOrder = riloBottomToTop
then Info.Header.biHeight := nHeightDest
else Info.Header.biHeight := -nHeightDest;
Info.Header.biPlanes := 1;
Info.Header.biBitCount := 32;
Info.Header.biSizeImage := nWidthDest * nHeightDest * 4;
Info.Header.biCompression := BI_BITFIELDS;
// when 24bpp, CE only supports B8G8R8 encoding
Info.Colors[0] := $FF0000; {le-red}
Info.Colors[1] := $00FF00; {le-green}
Info.Colors[2] := $0000FF; {le-blue}
StretchSrc := (nWidthDest <> nWidthSrc) or (nHeightDest <> nHeightSrc);
if StretchSrc
then begin
// we need to strech the source
// create alphabmp
if blendFunction.AlphaFormat = AC_SRC_ALPHA
then begin
// create alpha source data
R := Classes.Rect(nXOriginSrc, nYOriginSrc, nXOriginSrc + nWidthSrc, nYOriginSrc + nHeightSrc);
if not GetBitmapBytes(SrcSection.dsBm, SrcBmp, R, rileDWordBoundary, SrcLineOrder, SrcBytesPtr, SrcSize) then Exit(False);
// set info to source size
Info.Header.biWidth := nWidthSrc;
if SrcLineOrder = riloBottomToTop
then Info.Header.biHeight := nHeightSrc
else Info.Header.biHeight := -nHeightSrc;
Info.Header.biSizeImage := nWidthSrc * nHeightSrc * 4;
// create temp bitmap to store orginal grayscale alpha
TmpBmp := CreateDIBSection(hdcSrc, PBitmapInfo(@Info)^, DIB_RGB_COLORS, TmpBytesPtr, 0, 0);
if TmpBmp = 0 then Exit(False);
if TmpBytesPtr = nil
then begin
FreeMem(SrcBytesPtr);
DeleteObject(TmpBmp);
Exit(False);
end;
// create grayscale image from alpha
TmpRGBA := TmpBytesPtr;
SrcRGBA := SrcBytesPtr;
while SrcSize > 0 do
begin
TmpRGBA^.Blue := SrcRGBA^.Alpha;
TmpRGBA^.Green := SrcRGBA^.Alpha;
TmpRGBA^.Red := SrcRGBA^.Alpha;
TmpRGBA^.Alpha := 255;
Inc(SrcRGBA);
Inc(TmpRGBA);
Dec(SrcSize, 4);
end;
// restore to destination size
Info.Header.biWidth := nWidthDest;
if SrcLineOrder = riloBottomToTop
then Info.Header.biHeight := nHeightDest
else Info.Header.biHeight := -nHeightDest;
Info.Header.biSizeImage := nWidthDest * nHeightDest * 4;
// create bitmap to store stretched grayscale alpha
AlphaBmp := CreateDIBSection(hdcSrc, PBitmapInfo(@Info)^, DIB_RGB_COLORS, AlphaBytesPtr, 0, 0);
if (AlphaBmp = 0) or (AlphaBytesPtr = nil)
then begin
FreeMem(SrcBytesPtr);
DeleteObject(TmpBmp);
DeleteObject(AlphaBmp);
Exit(False);
end;
// stretch grayscale alpha bitmap
DC := CreateCompatibleDC(hdcSrc);
OldBmp := SelectObject(DC, AlphaBmp);
TmpDC := CreateCompatibleDC(hdcSrc);
OldTmpBmp := SelectObject(TmpDC, TmpBmp);
StretchBlt(DC, 0, 0, nWidthDest, nHeightDest, TmpDC, 0, 0, nWidthSrc, nHeightSrc, SRCCOPY);
SelectObject(DC, OldBmp);
DeleteDC(DC);
SelectObject(TmpDC, OldTmpBmp);
DeleteDC(TmpDC);
DeleteObject(TmpBmp);
FreeMem(SrcBytesPtr);
// as long as AlphaBmp exists, AlphaBytesPtr is valid.
CleanupAlpha := True;
end
else begin
CleanupAlpha := False;
end;
// create new srcbmp
SrcBmp := CreateDIBSection(hdcSrc, PBitmapInfo(@Info)^, DIB_RGB_COLORS, SrcBytesPtr, 0, 0);
if (SrcBmp = 0) or (SrcBytesPtr = nil)
then begin
DeleteObject(AlphaBmp);
DeleteObject(SrcBmp);
Exit(False);
end;
SrcSize := Info.Header.biSizeImage;
CleanupSrc := True;
CleanupSrcPtr := False;
SrcPixelBytes := 4;
SrcRowStride := nWidthDest * SrcPixelBytes;
DC := CreateCompatibleDC(hdcSrc);
OldBmp := SelectObject(DC, SrcBmp);
StretchBlt(DC, 0, 0, nWidthDest, nHeightDest, hdcSrc, nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc, SRCCOPY);
SelectObject(DC, OldBmp);
DeleteDC(DC);
// adjust source size
nWidthSrc := nWidthDest;
nHeightSrc := nHeightDest;
nXOriginSrc := 0;
nYOriginSrc := 0;
end
else begin
// only get source data
SrcPixelBytes := SrcSection.dsBm.bmBitsPixel shr 3;
if SrcSection.dsBm.bmBits <> nil
then begin
// source is a dibsection :)
SrcBytesPtr := SrcSection.dsBm.bmBits;
SrcRowStride := SrcSection.dsBm.bmWidthBytes;
CleanupSrc := False;
CleanupSrcPtr := False;
end
else begin
R := Classes.Rect(nXOriginSrc, nYOriginSrc, nXOriginSrc + nWidthSrc, nYOriginSrc + nHeightSrc);
if not GetBitmapBytes(SrcSection.dsBm, SrcBmp, R, rileDWordBoundary, SrcLineOrder, SrcBytesPtr, SrcSize) then Exit;
SrcRowStride := nWidthSrc * SrcPixelBytes;
CleanupSrc := False;
CleanupSrcPtr := True;
nXOriginSrc := 0;
nYOriginSrc := 0;
end;
AlphaBytesPtr := nil;
CleanupAlpha := False;
end;
// if a palette destination or destination isn't a section, create a temp DIB
if (DstSection.dsBm.bmBitsPixel < 24)
or (DstSection.dsBm.bmBits = nil)
or (DstSection.dsBmih.biCompression <> BI_RGB)
then begin
// create temp dib
DstBmp := CreateDIBSection(hdcSrc, PBitmapInfo(@Info)^, DIB_RGB_COLORS, DstBytesPtr, 0, 0);
// copy destination
DC := CreateCompatibleDC(hdcDest);
OldBmp := SelectObject(DC, DstBmp);
BitBlt(DC, 0, 0, nWidthDest, nHeightDest, hdcDest, nXOriginDest, nYOriginDest, SRCCOPY);
SelectObject(DC, OldBmp);
DeleteDC(DC);
DstPixelBytes := 4;
DstRowStride := nWidthDest * DstPixelBytes;
CleanupDst := True;
end
else begin
DstBytesPtr := DstSection.dsBm.bmBits;
DstPixelBytes := DstSection.dsBm.bmBitsPixel shr 3;
DstRowStride := DstSection.dsBm.bmWidthBytes;
Inc(PByte(DstBytesPtr), nXOriginDest + nYOriginDest * DstRowStride);
CleanupDst := False;
end;
// blend image
SrcLinePtr := SrcBytesPtr;
Inc(SrcLinePtr, nXOriginSrc * SrcPixelBytes + nYOriginSrc * SrcRowStride);
DstLinePtr := DstBytesPtr;
if blendFunction.AlphaFormat = AC_SRC_ALPHA
then begin
if AlphaBytesPtr <> nil
then SrcAlpha := AlphaBytesPtr;
if SCA {blendFunction.SourceConstantAlpha} = 255
then begin
for y := 1 to nHeightDest do
begin
SrcRGBA := Pointer(SrcLinePtr);
if AlphaBytesPtr = nil
then SrcAlpha := @SrcRGBA^.Alpha;
DstRGBA := Pointer(DstLinePtr);
for x := 1 to nWidthDest do
begin
if SrcAlpha^ <> 0
then begin
NotAlpha := not SrcAlpha^;
DstRGBA^.Red := SrcRgba^.Red + (DstRGBA^.Red * NotAlpha) div 255;
DstRGBA^.Green := SrcRgba^.Green + (DstRGBA^.Green * NotAlpha) div 255;
DstRGBA^.Blue := SrcRgba^.Blue + (DstRGBA^.Blue * NotAlpha) div 255;
if DstPixelBytes = 4
then DstRGBA^.Alpha := SrcAlpha^ + (DstRGBA^.Alpha * NotAlpha) div 255;
end;
Inc(SrcRGBA);
Inc(SrcAlpha, 4);
Inc(PByte(DstRGBA), DstPixelBytes);
end;
Inc(SrcLinePtr, SrcRowStride);
Inc(DstLinePtr, DstRowStride);
end;
end
else begin
for y := 1 to nHeightDest do
begin
SrcRGBA := Pointer(SrcLinePtr);
if AlphaBytesPtr = nil
then SrcAlpha := @SrcRGBA^.Alpha;
DstRGBA := Pointer(DstLinePtr);
for x := 1 to nWidthDest do
begin
if SrcAlpha^ <> 0
then begin
NotAlpha := not SrcAlpha^;
DstRGBA^.Red := (SrcRgba^.Red * SCA + DstRGBA^.Red * NotAlpha) div 255;
DstRGBA^.Green := (SrcRgba^.Green * SCA + DstRGBA^.Green * NotAlpha) div 255;
DstRGBA^.Blue := (SrcRgba^.Blue * SCA + DstRGBA^.Blue * NotAlpha) div 255;
if DstPixelBytes = 4
then DstRGBA^.Alpha := (SrcAlpha^ * SCA + DstRGBA^.Alpha * NotAlpha) div 255;
end;
Inc(SrcRGBA);
Inc(SrcAlpha, 4);
Inc(PByte(DstRGBA), DstPixelBytes);
end;
Inc(SrcLinePtr, SrcRowStride);
Inc(DstLinePtr, DstRowStride);
end;
end;
end
else begin
// no source alpha
NotAlpha := not SCA;
for y := 1 to nHeightDest do
begin
SrcRGBA := Pointer(SrcLinePtr);
if AlphaBytesPtr = nil
then SrcAlpha := @SrcRGBA^.Alpha;
DstRGBA := Pointer(DstLinePtr);
for x := 1 to nWidthDest do
begin
DstRGBA^.Red := (SrcRGBA^.Red * SCA + DstRGBA^.Red * NotAlpha) div 255;
DstRGBA^.Green := (SrcRGBA^.Green * SCA + DstRGBA^.Green * NotAlpha) div 255;
DstRGBA^.Blue := (SrcRGBA^.Blue * SCA + DstRGBA^.Blue * NotAlpha) div 255;
if (DstPixelBytes = 4) and (SrcPixelBytes = 4)
then DstRGBA^.Alpha := (SrcAlpha^ * SCA + DstRGBA^.Alpha * NotAlpha) div 255;
Inc(PByte(SrcRGBA), SrcPixelBytes);
Inc(PByte(DstRGBA), DstPixelBytes);
Inc(SrcAlpha, 4);
end;
Inc(SrcLinePtr, SrcRowStride);
Inc(DstLinePtr, DstRowStride);
end;
end;
// Replace destination if needed and do cleanup
if CleanupDst
then begin
DC := CreateCompatibleDC(hdcDest);
OldBmp := SelectObject(DC, DstBmp);
BitBlt(hdcDest, nXOriginDest, nYOriginDest, nWidthDest, nHeightDest, DC, 0, 0, SRCCOPY);
SelectObject(DC, OldBmp);
DeleteDC(DC);
DeleteObject(DstBmp);
end;
if CleanupSrc
then DeleteObject(SrcBmp);
if CleanupSrcPtr
then FreeMem(SrcBytesPtr);
if CleanupAlpha
then DeleteObject(AlphaBmp);
end;
// win98 only supports dibsections, so if not a dib section,
// we draw ourselves
{var
AlphaBlend98: function(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest, nHeightDest: Integer; hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc: Integer; blendFunction: TBlendFunction): BOOL; stdcall;
}
function _AlphaBlend98(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest, nHeightDest: Integer; hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc: Integer; blendFunction: TBlendFunction): BOOL; stdcall;
begin
// we can check the bitmaptypes here and call AlphaBlend98, but for now, just call own implementation
Result := _AlphaBlend(hdcDest, nXOriginDest, nYOriginDest, nWidthDest, nHeightDest, hdcSrc, nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc, blendFunction);
end;
function _GradientFill(DC: HDC; p2: PTriVertex; p3: ULONG; p4: Pointer; p5, p6: ULONG): BOOL;
begin
Result := False;
end;
function _GetComboboxInfo(hwndCombo: HWND; pcbi: PComboboxInfo): BOOL; stdcall;
begin
Result := (pcbi <> nil) and (pcbi^.cbSize = SizeOf(TComboboxInfo));
if Result then
begin
pcbi^.hwndCombo := hwndCombo;
if (GetWindowLong(hwndCombo, GWL_STYLE) and CBS_SIMPLE) <> 0 then
begin
pcbi^.hwndList := GetTopWindow(hwndCombo);
pcbi^.hwndItem := GetWindow(pcbi^.hwndList, GW_HWNDNEXT);
end
else
begin
pcbi^.hwndItem := GetTopWindow(hwndCombo);
pcbi^.hwndList := 0;
end;
end;
end;
function _GetMenuBarInfo(hwnd: HWND; idObject: LONG; idItem: LONG; pmbi: PMENUBARINFO): BOOL; stdcall;
begin
Result := False;
end;
function _GetWindowInfo(hwnd: HWND; pwi: PWINDOWINFO): BOOL; stdcall;
begin
Result := False;
end;
function _SHGetStockIconInfo(siid: integer; uFlags: UINT; psii: PSHSTOCKICONINFO): HResult; stdcall;
begin
Result := E_NOTIMPL;
end;
function _SetLayout(dc: HDC; l: DWord): DWord; stdcall;
begin
Result := GDI_ERROR;
end;
function _SetLayeredWindowAttributes(HWND: hwnd; crKey: COLORREF; bAlpha: byte; dwFlags: DWORD): BOOL; stdcall;
begin
Result := False;
end;
function _UpdateLayeredWindow(hWnd: HWND; hdcDst: HDC; pptDst: PPoint; psize: PSize;
hdcSrc: HDC; pptSrc: PPoint; crKey: COLORREF; pblend: PBlendFunction; dwFlags: DWORD): BOOL; stdcall;
begin
Result := False;
end;
function _IsProcessDPIAware: BOOL; stdcall;
begin
Result := False;
end;
function _TaskDialogIndirect(const pTaskConfig: PTASKDIALOGCONFIG; pnButton: PInteger; pnRadioButton: PInteger; pfVerificationFlagChecked: PBOOL): HRESULT; stdcall;
begin
Result := E_NOTIMPL;
end;
function _TaskDialog(hwndParent: HWND; hInstance: HINST; pszWindowTitle: PCWSTR; pszMainInstruction: PCWSTR; pszContent: PCWSTR;
dwCommonButtons: TASKDIALOG_COMMON_BUTTON_FLAGS; pszIcon: PCWSTR; pnButton: PInteger): HRESULT; stdcall;
begin
Result := E_NOTIMPL;
end;
function _SHCreateItemFromParsingName(pszPath: PCWSTR; pbc: IBindCtx; const riid: REFIID; out ppv): HResult; stdcall;
begin
Result := E_NOTIMPL;
end;
const
msimg32lib = 'msimg32.dll';
user32lib = 'user32.dll';
shell32lib = 'shell32.dll';
gdi32lib = 'gdi32.dll';
comctl32lib = 'comctl32.dll';
var
msimg32handle: THandle = 0;
user32handle: THandle = 0;
shell32handle: THandle = 0;
gdi32handle: THandle = 0;
comctl32handle: THandle = 0;
procedure Initialize;
var
p: Pointer;
begin
if WindowsVersion = wvUnknown then
UpdateWindowsVersion;
GetComboBoxInfo := nil;
GetMenuBarInfo := nil;
//GetWindowInfo := nil;
// defaults
Pointer(GradientFill) := @_GradientFill;
// Detect win98 since aplhablend doesn't support all bitmap types
if WindowsVersion = wv98
then Pointer(AlphaBlend) := @_AlphaBlend98
else Pointer(AlphaBlend) := @_AlphaBlend;
msimg32handle := LoadLibrary(msimg32lib);
if msimg32handle <> 0
then begin
if WindowsVersion <> wv98
then begin
p := GetProcAddress(msimg32handle, 'AlphaBlend');
if p <> nil
then Pointer(AlphaBlend) := p;
end;
p := GetProcAddress(msimg32handle, 'GradientFill');
if p <> nil
then Pointer(GradientFill) := p;
end;
// Defaults
Pointer(GetComboboxInfo) := @_GetComboboxInfo;
Pointer(GetMenuBarInfo) := @_GetMenuBarInfo;
//Pointer(GetWindowInfo) := @_GetWindowInfo;
Pointer(SetLayeredWindowAttributes) := @_SetLayeredWindowAttributes;
Pointer(UpdateLayeredWindow) := @_UpdateLayeredWindow;
Pointer(IsProcessDPIAware) := @_IsProcessDPIAware;
user32handle := LoadLibrary(user32lib);
if user32handle <> 0 then
begin
p := GetProcAddress(user32handle, 'GetComboBoxInfo');
if p <> nil
then Pointer(GetComboboxInfo) := p;
p := GetProcAddress(user32handle, 'GetMenuBarInfo');
if p <> nil
then Pointer(GetMenuBarInfo) := p;
//p := GetProcAddress(user32handle, 'GetWindowInfo');
//if p <> nil
//then Pointer(GetWindowInfo) := p;
p := GetProcAddress(user32handle, 'SetLayeredWindowAttributes');
if p <> nil
then Pointer(SetLayeredWindowAttributes) := p;
p := GetProcAddress(user32handle, 'UpdateLayeredWindow');
if p <> nil
then Pointer(UpdateLayeredWindow) := p;
p := GetProcAddress(user32handle, 'IsProcessDPIAware');
if p <> nil
then Pointer(IsProcessDPIAware) := p;
end;
// Defaults
Pointer(SHGetStockIconInfo) := @_SHGetStockIconInfo;
Pointer(SHCreateItemFromParsingName) := @_SHCreateItemFromParsingName;
shell32handle := LoadLibrary(shell32lib);
if shell32handle <> 0 then
begin
p := GetProcAddress(shell32handle, 'SHGetStockIconInfo');
if p <> nil
then Pointer(SHGetStockIconInfo) := p;
p := GetProcAddress(shell32handle, 'SHCreateItemFromParsingName');
if p <> nil
then Pointer(SHCreateItemFromParsingName) := p;
end;
// Defaults
Pointer(SetLayout) := @_SetLayout;
gdi32handle := LoadLibrary(gdi32lib);
if gdi32handle <> 0 then
begin
p := GetProcAddress(gdi32handle, 'SetLayout');
if p <> nil
then Pointer(SetLayout) := p;
end;
// Defaults
Pointer(TaskDialogIndirect) := @_TaskDialogIndirect;
Pointer(TaskDialog) := @_TaskDialog;
comctl32handle := LoadLibrary(comctl32lib);
if comctl32handle <> 0 then
begin
p := GetProcAddress(comctl32handle, 'TaskDialogIndirect');
if p <> nil
then Pointer(TaskDialogIndirect) := p;
p := GetProcAddress(comctl32handle, 'TaskDialog');
if p <> nil
then Pointer(TaskDialog) := p;
end;
end;
procedure Finalize;
begin
AlphaBlend := @_AlphaBlend;
GetComboboxInfo := nil;
GetMenuBarInfo := nil;
if msimg32handle <> 0
then FreeLibrary(msimg32handle);
msimg32handle := 0;
if user32handle <> 0 then
FreeLibrary(user32handle);
user32handle := 0;
if shell32handle <> 0 then
FreeLibrary(shell32handle);
shell32handle := 0;
if gdi32handle <> 0 then
FreeLibrary(gdi32handle);
gdi32handle := 0;
if comctl32handle <> 0 then
FreeLibrary(comctl32handle);
comctl32handle := 0;
end;
initialization
Initialize;
finalization
Finalize;
end.
Reference in New Issue View Git Blame Copy Permalink