{ +-------------------------------------------------------------+ } { | | } { | GM-Software | } { | =========== | } { | | } { | Project: All Projects | } { | | } { | Description: Windows Common Controls. | } { | | } { | | } { | Copyright (C) - 2002 - Gerrit Moeller. | } { | | } { | Source code distributed under MIT license. | } { | | } { | See: https://www.gm-software.de | } { | | } { +-------------------------------------------------------------+ } {$IFDEF FPC} {$WARN 4055 off : Conversion between ordinals and pointers is not portable} {$ENDIF} {$INCLUDE GMCompilerSettings.inc} unit GMOsExCtrls; interface uses {$IFDEF JEDIAPI}jwaWinType, jwaWinUser,{$ELSE}Windows,{$ENDIF} // {$IFDEF FPC}CommCtrl, {$ELSE} GMCommCtrl, {$ENDIF} GMCommCtrl, GMMessages, GMStrDef, GMIntf, GMCommon, GMCollections, GMGdi, GMUICore, GMxCtrls, GMOsCtrls; type TLVImageList = (ilLVLargeIcons, ilLVSmallIcons, ilLVStateIcons); TTVImageList = (ilTVIcons, ilTVStateIcons); TTVExpandOperation = (eoExpand, eoExpandPartial, eoCollapse, eoCollapseReset, eoToggle); TGMTreeNodeState = (tnsFocused, tnsSelected, tnsCut, tnsDropHilited, tnsBold, tnsExpanded, tnsExpandedOnce, tnsExpandedPartial); TGMTreeNodeStates = set of TGMTreeNodeState; TGMTLVAttribute = (tlvShowHints, tlvAllowDrag); TGMTLVAttributes = set of TGMTLVAttribute; const {$IFDEF DELPHI5} {$EXTERNALSYM TTS_ALWAYSTIP} TTS_ALWAYSTIP = $01; {$EXTERNALSYM TTS_NOPREFIX} TTS_NOPREFIX = $02; { For IE >= 0x0500 } {$EXTERNALSYM TTS_NOANIMATE} TTS_NOANIMATE = $10; {$EXTERNALSYM TTS_NOFADE} TTS_NOFADE = $20; {$EXTERNALSYM TTS_BALLOON} TTS_BALLOON = $40; {$EXTERNALSYM TTS_CLOSE} TTS_CLOSE = $80; { For Windows >= Vista } {$EXTERNALSYM TTS_USEVISUALSTYLE} TTS_USEVISUALSTYLE = $100; // Use themed hyperlinks {$EXTERNALSYM TTI_NONE} TTI_NONE = 0; {$EXTERNALSYM TTI_INFO} TTI_INFO = 1; {$EXTERNALSYM TTI_WARNING} TTI_WARNING = 2; {$EXTERNALSYM TTI_ERROR} TTI_ERROR = 3; { For Windows >= Vista } {$EXTERNALSYM TTI_INFO_LARGE} TTI_INFO_LARGE = 4; {$EXTERNALSYM TTI_WARNING_LARGE} TTI_WARNING_LARGE = 5; {$EXTERNALSYM TTI_ERROR_LARGE} TTI_ERROR_LARGE = 6; { List View Extended Styles } {$EXTERNALSYM LVS_EX_GRIDLINES} LVS_EX_GRIDLINES = $00000001; {$EXTERNALSYM LVS_EX_SUBITEMIMAGES} LVS_EX_SUBITEMIMAGES = $00000002; {$EXTERNALSYM LVS_EX_CHECKBOXES} LVS_EX_CHECKBOXES = $00000004; {$EXTERNALSYM LVS_EX_TRACKSELECT} LVS_EX_TRACKSELECT = $00000008; {$EXTERNALSYM LVS_EX_HEADERDRAGDROP} LVS_EX_HEADERDRAGDROP = $00000010; {$EXTERNALSYM LVS_EX_FULLROWSELECT} LVS_EX_FULLROWSELECT = $00000020; // applies to report mode only {$EXTERNALSYM LVS_EX_ONECLICKACTIVATE} LVS_EX_ONECLICKACTIVATE = $00000040; {$EXTERNALSYM LVS_EX_TWOCLICKACTIVATE} LVS_EX_TWOCLICKACTIVATE = $00000080; {$EXTERNALSYM LVS_EX_FLATSB} LVS_EX_FLATSB = $00000100; {$EXTERNALSYM LVS_EX_REGIONAL} LVS_EX_REGIONAL = $00000200; {$EXTERNALSYM LVS_EX_INFOTIP} LVS_EX_INFOTIP = $00000400; // listview does InfoTips for you {$EXTERNALSYM LVS_EX_UNDERLINEHOT} LVS_EX_UNDERLINEHOT = $00000800; {$EXTERNALSYM LVS_EX_UNDERLINECOLD} LVS_EX_UNDERLINECOLD = $00001000; {$EXTERNALSYM LVS_EX_MULTIWORKAREAS} LVS_EX_MULTIWORKAREAS = $00002000; {$EXTERNALSYM LVS_EX_LABELTIP} LVS_EX_LABELTIP = $4000; // listview unfolds partly hidden labels if it does not have infotip text {$EXTERNALSYM LVM_SORTITEMSEX} LVM_SORTITEMSEX = LVM_FIRST + 81; {$EXTERNALSYM TTM_SETTITLEA} TTM_SETTITLEA = WM_USER + 32; { wParam = TTI_*, lParam = char* szTitle } {$EXTERNALSYM TTM_SETTITLEW} TTM_SETTITLEW = WM_USER + 33; { wParam = TTI_*, lParam = wchar* szTitle } {$EXTERNALSYM TTN_GETDISPINFOA} TTN_GETDISPINFOA = TTN_FIRST - 0; {$EXTERNALSYM TTN_NEEDTEXTA} TTN_NEEDTEXTA = TTN_GETDISPINFOA; {$EXTERNALSYM TTN_GETDISPINFOW} TTN_GETDISPINFOW = TTN_FIRST - 10; {$EXTERNALSYM TTN_NEEDTEXTW} TTN_NEEDTEXTW = TTN_GETDISPINFOW; {$EXTERNALSYM TTN_LINKCLICK} TTN_LINKCLICK = TTN_FIRST - 3; {$EXTERNALSYM UDM_SETPOS32} UDM_SETPOS32 = WM_USER + 113; {$EXTERNALSYM UDM_GETPOS32} UDM_GETPOS32 = WM_USER + 114; {$ENDIF} cDfltTreeNodeState = []; cUnkImgIdx = High(Word)-1; cImgIdxNone = -2; //cInvalidImgIdx = High(Word)-1; cNodeStateMask = $FF; cDfltScrollPos = 0; cTextCallback = #0; cDfltMaxHintWidth = 360; // 280; cDfltHintMaxShowTime = 0; cDfltShowDelayTimeMS = 0; cImmediateHintDelay = 10; cDfltHintStyle = WS_POPUP or TTS_BALLOON or TTS_ALWAYSTIP; cDfltHintIcon = TTI_INFO; cInvalidHintIcon = -1; cDfltEnabled = True; cDfltLVExStyle = LVS_EX_LABELTIP; cProgressHeight = 15; cTabSpace = 6; cTabOuterSpace = 2; cSimpleReportList = LVS_REPORT or LVS_SINGLESEL or LVS_SHAREIMAGELISTS or LVS_SHOWSELALWAYS; cPageTabDrawFlags = cDfltTextLabelDrawFlags; cDfltTVAttributes = [tlvShowHints]; UM_AFTERNODERCLICK = UM_USER + 11; //UM_CREATECILDHANDLE = UM_USER + 12; //cDfltImgListCreateFlags = ILC_MASK or ILC_COLOR24; <- Win2000 cDfltImgListCreateFlags = ILC_MASK or ILC_COLOR32; //cDragImgListCreateFlags = ILC_MASK or ILC_COLOR24; cInvalidInputDate = -999999999999999; cInputDateNone = cInvalidInputDate-1; type //{$IFDEF FPC} //PNMTVGetInfoTip = LPNMTVGetInfoTip; //PNMTTDispInfo = LPNMTTDispInfo; //{$ENDIF} TGMImageList = class(TGMRefCountedObj, IGMGetHandle) protected FHandle: HIMAGELIST; //FImageSize: TPoint; public constructor Create(const AImgSize: TPoint; const ACreateFlags: LongWord = cDfltImgListCreateFlags; const ARefLifeTime: Boolean = True); reintroduce; overload; constructor Create(const AResBmpName: PGMChar; const AInstance: THandle; const AImgWidth: LongInt = 0; const ACreateFlags: LongWord = cDfltImgListCreateFlags; const ATransparentColor: COLORREF = CLR_DEFAULT; //const CheckLoad: Boolean = True; const ARefLifeTime: Boolean = True); reintroduce; overload; constructor TakeOver(const AHandle: HImageList; const ARefLifeTime: Boolean = True); destructor Destroy; override; function GetHandle: THandle; stdcall; //property ImageSize: TPoint read FImageSize; <- use ImageList_GetIconSize instead! property Handle: HIMAGELIST read FHandle; end; //TGMImgListDragPainter = class(TGMDragPainter, IGMSetVisible) // protected // FImageList: IGMGetHandle; // FDragObj: TObject; // // procedure ExitDragState; override; // procedure DragToScreenPos(const AScreenPos: TPoint); override; // procedure WMMouseWheel(var Msg: TMessage); message WM_MOUSEWHEEL; // // public // constructor Create(const AParent: TObject; // const AImageList: IGMGetHandle; // const ADragOffs: TPoint; // const ADragData: IUnknown = nil; // const ADragImgIdx: LongInt = 0; // const ARefLifeTime: Boolean = True); reintroduce; overload; // // procedure SetVisible(const Value: Boolean; const Relayout: Boolean = True); virtual; //end; TGMImgListDragPainter = class(TGMTransparentDragPainter) public constructor Create(const AParent: TObject; const AImageList: IGMGetHandle; const ADragOffs: TPoint; const ADragData: IUnknown = nil; const ADragImgIdx: LongInt = 0; const ARefLifeTime: Boolean = True); reintroduce; overload; end; TGMImgListIconArea = class(TGMxImageAreaBase) protected FImageList: IGMGetHandle; FImageIndex: LongInt; procedure AssignImageSize; override; function InternalPaintArea(const ADC: HDC; const ARect: TRect): Boolean; override; public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AImageList: IGMGetHandle; const AImageIndex: LongInt; const AAttributes: TImgAttributes = []; const ABkgndColor: COLORREF = cDfltColor; const AHorizontalAlignment: TGMHorizontalAlignment = haCenter; const AVerticalAlignment: TGMVerticalAlignment = vaCenter; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; procedure SetImageIndex(const AImageIndex: LongInt; const ARepaint: Boolean = False; const AReLayout: Boolean = False); end; TGMImgLstCheckBoxArea = class; TGMImgLstCheckBoxImgArea = class(TGMUiArea) protected FCheckBoxArea: TGMImgLstCheckBoxArea; FImgList: IGMGetHandle; FImgIdxChecked, FImgIdxNotChecked: LongInt; FImgSize: TPoint; procedure SetupImgSize; public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AImgList: IGMGetHandle = nil; const AImgIdxNotChecked: LongInt = cInvalidItemIdx; const AImgIdxChecked: LongInt = cInvalidItemIdx; const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; function PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; override; function InternalCalcWidth(const NewSize: TPoint): LongInt; override; function InternalCalcHeight(const NewSize: TPoint): LongInt; override; end; {TGMCheckBoxTextArea = class(TGMxTextLabel) protected FCheckBoxArea: TGMImgLstCheckBoxArea; public function AreaFiller: IGMAreaFiller; override; function PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; override; end;} TGMImgLstCheckBoxArea = class(TGMSurroundingUiArea, IGMGetSetEnabled) protected FDisabled: Boolean; FMouseDown: Boolean; FChecked: Boolean; FTextLabel: TGMxLabel; FOnClick: TGMObjNotifyProc; procedure SetChecked(const Value: Boolean); procedure WMMouseEnter(var Msg: TWMMouse); message UM_MOUSEENTER; procedure WMMouseLeave(var Msg: TWMMouse); message UM_MOUSELEAVE; procedure WMLButtonDown(var Msg: TWMMouse); message WM_LBUTTONDOWN; procedure WMLButtonUp(var Msg: TWMMouse); message WM_LBUTTONUP; public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString = ''; const AImgList: IGMGetHandle = nil; const AImgIdxNotChecked: LongInt = cInvalidItemIdx; const AImgIdxChecked: LongInt = cInvalidItemIdx; const AOnClick: TGMObjNotifyProc = nil; const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; procedure Click; virtual; function AreaFiller: IGMAreaFiller; override; function PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; override; function GetEnabled: Boolean; override; procedure SetEnabled(const AEnabled: Boolean); stdcall; property Checked: Boolean read FChecked write SetChecked; property Enabled: Boolean read GetEnabled write SetEnabled; end; TBuildHIntTextFunc = function: TGMString of Object; TGMHintWindow = class(TGMWindow) protected FTitleResTextRef: RGMResTextRefData; FTitle: TGMString; FIcon: LongInt; FMaxShowTime: LongInt; FShowDelayTimeMS: LongInt; FMaxWidth: LongInt; FCallBackText: TGMString; procedure WMAppNotify(var Msg: TWMNotify); message WM_NOTIFY + WM_APP; function GetVisible: Boolean; override; procedure InternalSetVisible(const Value: Boolean); override; function HintAdded: Boolean; public OnBuildHintText: TBuildHIntTextFunc; OnWindowClosed: TGMObjNotifyProc; OnLinkClicked: TGMObjNotifyProc; constructor Create(const AParent: TGMWndObj; const ARect: TRect; const AAreaAlign: TGMAreaAlignRec; AText: TGMString = ''; ATitle: TGMString = ''; const AMaxShowTimeMS: LongInt = cDfltHintMaxShowTime; const AMaxWidth: LongInt = cDfltMaxHintWidth; const AIcon: LongInt = cDfltHintIcon; const AShowDelayTimeMS: LongInt = cDfltShowDelayTimeMS; const AWndStyle: DWORD = cDfltHintStyle; const AWndExStyle: DWORD = cDfltWndExStyle; const ARefLifeTime: Boolean = False); reintroduce; overload; //procedure SetVisible(const Value: Boolean; const Relayout: Boolean); override; function GetText: TGMString; override; procedure SetText(const AText: TGMString); override; procedure LanguageChanged(const ANewLanguage: LParam); override; //function ParticipateInLayouting: Boolean; override; //procedure SetText(const Value: TGMString); override; procedure SetTitleAndIcon(const ATitle: TGMString = ''; const AIcon: LongInt = cInvalidHintIcon); procedure SetShowing(const Value: Boolean); override; function BuildHintData(const IdOnly: Boolean = False): TToolInfo; virtual; procedure SetLayoutBounds(const Value: TRect; const Repaint: Boolean); override; function IsLayoutChild: Boolean; override; function RegisterWndClass: TGMString; override; procedure SurfaceOriginChanged; override; procedure InternalCreateHandle; override; function FillsComplete: Boolean; override; procedure AfterParentChanged; override; end; TGMHintToolBtnArea = class(TGMxToolBtnArea) protected procedure AssignImage; override; public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AOnClick: TGMObjNotifyProc = nil; const AText: TGMString = ''; const AImgIdx: LongInt = -1; const AImgList: IUnknown = nil; const AHintTitle: TGMString = ''; const AHintText: TGMString = ''; const ABkgndColor: COLORREF = cDfltColor; const ATextSide: TEdge = edgRight; const AHAlignment: TGMHorizontalAlignment = haCenter; // const AFrameColor: COLORREF = clDfltHoverFrameColor; //const AHooverColor: COLORREF = cDfltToolBtnHooverColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; // procedure SetHintData(const AHintTitle: TGMString = ''; const AHintText: TGMString = ''; const AIcon: LongInt = cInvalidHintIcon); end; TGMTrackingHintWindow = class(TGMHintWindow) protected FShowing: Boolean; //procedure WMClose(var Msg: TMessage); message WM_CLOSE; //procedure WMShowWindow(var Msg: TMessage); message WM_SHOWWINDOW; public constructor Create(const AParent: TGMWndObj; const ARect: TRect; const AAreaAlign: TGMAreaAlignRec; AText: TGMString = ''; ATitle: TGMString = ''; const AMaxWidth: LongInt = cDfltMaxHintWidth; const AIcon: LongInt = cDfltHintIcon; const AWndStyle: DWORD = cDfltHintStyle; const AWndExStyle: DWORD = cDfltWndExStyle; const ARefLifeTime: Boolean = False); reintroduce; overload; function BuildHintData(const IdOnly: Boolean = False): TToolInfo; override; function ParticipateInLayouting: Boolean; override; procedure ShowAt(const ScreenPos: TPoint); procedure Hide; end; TGMProgressBar = class(TGMNCWinControl) protected FMin, FMax, FPos: LongInt; function GetMin: LongInt; function GetMax: LongInt; function GetPos: LongInt; procedure SetMin(const AValue: LongInt); procedure SetMax(const AValue: LongInt); procedure SetPos(const AValue: LongInt); procedure UMHandleCreated(var Msg: TMessage); message UM_HANDLECREATED; procedure WMPaint(var Msg: TWMPaint); message WM_PAINT; public constructor Create(const ARefLifeTime: Boolean = False); override; {constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AWndStyle: DWORD = cDfltWndStyle; const AWndExStyle: DWORD = cDfltWndExStyle; const ABkgndColor: COLORREF = cDfltColor; const ARefLifeTime: Boolean = False); reintroduce; overload;} function RegisterWndClass: TGMString; override; procedure InternalCreateHandle; override; property Min: LongInt read GetMin write SetMin; property Max: LongInt read GetMax write SetMax; property Pos: LongInt read GetPos write SetPos; end; TGMCalendar = class(TGMOEMControl) public {constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AWndStyle: DWORD = cVisibleTabstop; const AWndExStyle: DWORD = cDfltWndExStyle; const ABkgndColor: COLORREF = cDfltColor; const ARefLifeTime: Boolean = False); reintroduce; overload;} //procedure InternalCreateHandle; override; function RegisterWndClass: TGMString; override; function CalculateWidth(const NewSize: TPoint): LongInt; override; function CalculateHeight(const NewSize: TPoint): LongInt; override; end; TGMDateTimeEdit = class(TGMNCWinControl) protected FInputFormat: TGMString; function GetValue: TDateTime; procedure SetValue(const AValue: TDateTime); procedure InternalCreateHandle; override; public constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString = cDfltWndText; const AWndStyle: DWORD = cDfltWndStyle; const AWndExStyle: DWORD = cDfltWndExStyle; const ABkgndColor: COLORREF = cDfltColor; const ARefLifeTime: Boolean = False); override; function RegisterWndClass: TGMString; override; procedure SetInputGMFormat(const AInputFormat: TGMString); procedure SetInputRange(const MinValue, MaxValue: TDateTime); property Value: TDateTime read GetValue write SetValue; end; TGMPageControl = class(TGMOEMControl, IGMLoadStoreData) protected FOnPageChanged: TGMObjNotifyProc; //function GetPage(const Idx: LongInt): TObject; function GetActivePageIdx: LongInt; procedure SetActivePageIdx(const Value: LongInt); function GetActivePage: TObject; procedure SetActivePage(const Value: TObject); procedure AdjustClientRect(var ARect: TRect); procedure WMAppNotify(var Msg: TWMNotify); message WM_NOTIFY + WM_APP; procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND; //procedure UMCreateChildHandle(var Msg: TMessage); message UM_CREATECILDHANDLE; //procedure AddPageTab(const PageIdx: Integer); procedure OnChildAreaAdded(const ASender, AChlidArea: TObject; const AIndex: PtrInt); procedure OnContainedAreaRemoved(const ASender, AChlidArea: TObject; const AIndex: PtrInt); public ClientAdjustRect: TRect; constructor Create(const ARefLifeTime: Boolean = False); override; procedure LoadData(const Source: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); stdcall; procedure StoreData(const Dest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); stdcall; procedure RemoveAllPages; function RegisterWndClass: TGMString; override; procedure InternalCreateHandle; override; function ClientAreaOrigin: TPoint; override; function ClientAreaSize: TPoint; override; procedure InternalSetVisible(const Value: Boolean); override; procedure ShowSelectedPage; //function PageCount: LongInt; //function AddPage(const Area: TObject; const ImgIdx: LongInt = cUnkImgIdx; const AddToOwned: Boolean = True): TObject; //procedure RemovePage(const Area: TObject); //property Pages[const Idx: LongInt]: TObject read GetPage; default; property ActivePageIdx: LongInt read GetActivePageIdx write SetActivePageIdx; property ActivePage: TObject read GetActivePage write SetActivePage; property OnPageChanged: TGMObjNotifyProc read FOnPageChanged write FOnPageChanged; end; TGMScrollButtons = class(TGMOEMControl) protected procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND; //procedure WMKeyDown(var Msg: TWMKeyDown); message WM_KEYDOWN; public constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AWndStyle: DWORD = cVisibleTabstop; const AWndExStyle: DWORD = cDfltWndExStyle; const ABkgndColor: COLORREF = cDfltColor; const ARefLifeTime: Boolean = False); reintroduce; overload; function RegisterWndClass: TGMString; override; end; TGMIntEdit = class(TGMUiArea, IGMGetSetEnabled) protected FEditor: TGMFramedEdit; FScrollBtns: TGMScrollButtons; FMinValue: LongInt; FMaxValue: LongInt; FEnabled: Boolean; procedure OnEditTextChange(const Sender: TObject); virtual; public OnAfterValueChange: TGMObjNotifyProc; constructor Create(const ARefLifeTime: Boolean = False); overload; override; constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AMinValue: LongInt; const AMaxValue: LongInt; const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; procedure CreateHandle; override; function PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; override; procedure Clear(const ANotify: Boolean = True); override; //function ExecuteOperation(const Operation: Integer; const Parameter: IUnknown): Boolean; override; function GetValue: LongInt; procedure SetValue(const AValue: LongInt); function GetEnabled: Boolean; override; procedure SetEnabled(const AEnabled: Boolean); stdcall; property Editor: TGMFramedEdit read FEditor; property ScrollBtns: TGMScrollButtons read FScrollBtns; property Value: LongInt read GetValue write SetValue; property Enabled: Boolean read GetEnabled write SetEnabled; property MinValue: LongInt read FMinValue; property MaxValue: LongInt read FMaxValue; end; TOnPosChangeProc = procedure(const ScrollCode, ScrollPos: SmallInt) of Object; TGMTrackBar = class(TGMNCWinControl) protected FMin: LongInt; FMax: LongInt; FPos: LongInt; FStartPos: LongInt; FOnPosChange: TOnPosChangeProc; function GetPosition: LongInt; function GetMinVal: LongInt; function GetMaxVal: LongInt; procedure SetPosition(const Value: LongInt); procedure SetMinVal(const Value: LongInt); procedure SetMaxVal(const Value: LongInt); procedure WMAppVScroll(var Msg: TWMScroll); message WM_VSCROLL + WM_APP; procedure WMAppHScroll(var Msg: TWMScroll); message WM_HSCROLL + WM_APP; public constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AMin: LongInt; const AMax: LongInt; const APos: LongInt; const AOnPosChange: TOnPosChangeProc; const AWndStyle: DWORD = cDfltWndStyle; const AWndExStyle: DWORD = cDfltWndExStyle; const ABkgndColor: COLORREF = cDfltColor; const ARefLifeTime: Boolean = False); reintroduce; overload; function RegisterWndClass: TGMString; override; procedure InternalCreateHandle; override; property Position: LongInt read GetPosition write SetPosition; property MinVal: LongInt read GetMinVal write SetMinVal; property MaxVal: LongInt read GetMaxVal write SetMaxVal; property StartPos: LongInt read FStartPos; end; TGMPageTabs = class; TGMPageTabArea = class(TGMUiArea, IGMLanguageChanged) protected FPageArea: TObject; FTitle: TGMString; FTitleResStrPtr: RGMResTextRefData; FImageIdx: LongInt; FPageTabs: TGMPageTabs; FCloseBtn: TGMxButtonArea; FHintWindow: TObject; procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR; procedure WMMouseEnter(var Msg: TWMMouse); message UM_MOUSEENTER; procedure WMMouseLeave(var Msg: TWMMouse); message UM_MOUSELEAVE; procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN; //procedure WMMouseMove(var Msg: TWMMouseMove); message WM_MOUSEMOVE; //procedure WMLButtonUp(var Msg: TWMLButtonUp); message WM_LBUTTONUP; procedure OnCloseBtnClick(const Sender: TObject); public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ATitle: TGMString; const APageArea: TObject; const AShowCloseBtn: Boolean = False; const AImageIdx: LongInt = cImgIdxNone; //const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; procedure AssignTitle; procedure LanguageChanged(const ANewLanguage: LParam); function IsActiveTab: Boolean; function InternalCalcWidth(const NewSize: TPoint): LongInt; override; function InternalCalcHeight(const NewSize: TPoint): LongInt; override; function CreateAreaRegion(const ABoundingRect: TRect; const ARegionKind: TGMAreaRegionKind): IGMGetHandle; override; function PaintsComplete: Boolean; override; function PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; override; function FontHandle: THandle; override; function FontColor: COLORREF; override; function MouseIsOverTab: Boolean; property PageArea: TObject read FPageArea; property PageTabs: TGMPageTabs read FPageTabs; end; TGMPageTabsChevronBtn = class(TGMxChevronBtnBase) protected FPageTabs: TGMPageTabs; //FPopup: TGMxChevronPopup; public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); override; function Direction: TGM2DDirection; override; //procedure Click; override; property PageTabs: TGMPageTabs read FPageTabs; //property Popup: TGMxChevronPopup read FPopup; end; TGMBoundingTabsArea = class(TGMSurroundingUiArea) public procedure LayoutContainedAreas(const ARepaint: Boolean); override; // : TPoint; function FontColor: COLORREF; override; function BkgndColor: COLORREF; override; function HBkgndBrush: THandle; override; function PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; override; end; TGMPageTabs = class(TGMSurroundingUiArea) protected FImageList: IGMGetHandle; FActivePageIdx: LongInt; FTabsArea: TGMUiAreaBase; FChevronBtn: TGMUiAreaBase; function GetPage(const AIndex: LongInt): TObject; function GetActivePage: TObject; procedure SetActivePage(const AValue: TObject); procedure InternalSetActivePageIdx(const AValue: LongInt); procedure SetActivePageIdx(const AValue: LongInt); procedure OnContainedAreasCountChanged(const ASender: TObject; const AOldCount, ANewCount: PtrInt); public OnAfterPageChanged: TGMObjNotifyProc; OnAfterPageCountChanged: TGMCountChangedProc; constructor Create(const ARefLifeTime: Boolean = False); overload; override; constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; //const APaddSpace: TPoint; const AImageList: IGMGetHandle = nil; const ABkgndColor: COLORREF = clWhite; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; destructor Destroy; override; function AddPage(const APageArea: TObject; ATitle: TGMString = ''; const AShowCloseBtn: Boolean = False; AImgIdx: LongInt = cUnkImgIdx; const AActivatePage: Boolean = False; const AOwnArea: Boolean = True): TObject; procedure ShowActivePage; function FindPage(const AClass: TClass; const ATitle: TGMString; out Page): Boolean; function PaintArea(const ADC: HDC; const ARSurface: TRect): Boolean; override; function RootForRelayout: TObject; override; procedure RemovePage(const APageArea: TObject); function PageCount: LongInt; function FontColor: COLORREF; override; function BkgndColor: COLORREF; override; function HBkgndBrush: THandle; override; property ImageList: IGMGetHandle read FImageList write FImageList; property ActivePageIdx: LongInt read FActivePageIdx write SetActivePageIdx; property ActivePage: TObject read GetActivePage write SetActivePage; property TabsArea: TGMUiAreaBase read FTabsArea; property ChevronBtn: TGMUiAreaBase read FChevronBtn; property Pages[const Index: LongInt]: TObject read GetPage; default; end; TGMTLViewBase = class(TGMNCWinControl) protected function GetSelectedItem: PtrInt; virtual; abstract; procedure SetSelectedItem(const Value: PtrInt); virtual; abstract; function ItemAtPoint(const Point: TPoint): PtrInt; virtual; abstract; function CreateDragImage(const Item: PtrInt; var DragPoint: TPoint): THandle; virtual; abstract; public constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString = cDfltWndText; const AWndStyle: DWORD = cDfltWndStyle; const AWndExStyle: DWORD = cDfltWndExStyle; // <- New extened Style const ABkgndColor: COLORREF = clrWindow; // <- different default color! const ARefLifeTime: Boolean = False); override; procedure UpdateWndStyle(const Mask, Flags: DWORD); virtual; property SelectedItem: PtrInt read GetSelectedItem write SetSelectedItem; end; TGMListView = class(TGMTLViewBase) protected FLVExStyle: DWORD; //procedure WMAppNotify(var Msg: TWMNotify); message WM_NOTIFY + WM_APP; procedure WMMouseEnter(var Msg: TMessage); message UM_MOUSEENTER; procedure WMMouseLeave(var Msg: TMessage); message UM_MOUSELEAVE; procedure WMAppNotify(var Msg: TWMNotify); message WM_NOTIFY + WM_APP; function GetItemCount: LongInt; function GetSelectedItem: PtrInt; override; procedure SetSelectedItem(const AValue: PtrInt); override; function GetItemChecked(const AItemIdx: LongInt): Boolean; procedure SetItemChecked(const AItemIdx: LongInt; const AValue: Boolean); function GetItemText(const AItemIdx, ASubItemIdx: LongInt): TGMString; procedure SetItemText(const AItemIdx, ASubItemIdx: LongInt; const Value: TGMString); function GetImageList(const AItemIdx: TLVImageList): THandle; procedure SetImageList(const AItemIdx: TLVImageList; const Value: THandle); function GetItemData(const AItemIdx: LongInt): Pointer; procedure SetItemData(const AItemIdx: LongInt; const Value: Pointer); function ItemAtPoint(const Point: TPoint): PtrInt; override; function CreateDragImage(const AItem: PtrInt; var ADragPoint: TPoint): THandle; override; public Attributes: TGMTLVAttributes; constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AWndStyle: DWORD = cDfltWndStyle; const AWndExStyle: DWORD = cDfltWndExStyle; const ALVExStyle: DWORD = cDfltLVExStyle; const ABkgndColor: COLORREF = clrWindow; const ARefLifeTime: Boolean = False); reintroduce; overload; function RegisterWndClass: TGMString; override; procedure InternalCreateHandle; override; procedure CreateColumns(const AListColumns: array of TGMColumnDescRec); function AddRow(const AValues: array of TGMString; const AImageIndex: Integer = cUnkImgIdx; const AData: Pointer = nil): Integer; procedure ClearSelection; function StartTitleEdit(const AItemIdx: LongInt): HWnd; // function CreateDragImgBmp(const AItemIdx: LongInt; const ATransparentColor: COLORREF): IGMGetHandle; function GetLVItem(const AItemIdx, ASubItemIdx, AMask: LongInt): TLVItem; procedure SetLVItem(const AItemIdx: TLVItem); procedure ScrollToItem(const AItemIdx: LongInt; const AllowPartial: Boolean); procedure SortItemsByText(const AColIdx: LongInt); function HitTestInfo(const ClientPoint: TPoint): TLVHitTestInfo; procedure DeleteItem(const AItemIdx: LongInt); property ItemCount: LongInt read GetItemCount; property ItemChecked[const AItemIdx: LongInt]: Boolean read GetItemChecked write SetItemChecked; property ItemText[const AItemIdx, Col: LongInt]: TGMString read GetItemText write SetItemText; property ImageList[const AItemIdx: TLVImageList]: THandle read GetImageList write SetImageList; property ItemData[const AItemIdx: LongInt]: Pointer read GetItemData write SetItemData; end; TGMTreeView = class; TGMWccTvNode = class; IGMWccTvNode = interface(IGMTreeable) ['{BB01D2AD-0D3D-4654-A964-B8E6C03283B4}'] //function ClassType: TClass; //function GetHandle: HTreeItem; function DataClassName: AnsiString; function GetOwner: TGMTreeView; //function GetTitle: TGMString; //procedure SetTitle(const Value: TGMString); function GetImageIdx: Integer; procedure SetImageIdx(const Value: Integer); function GetSelectedImgIdx: Integer; procedure SetSelectedImgIdx(const Value: Integer); function GetStateImgIdx: Integer; procedure SetStateImgIdx(const Value: Integer); function GetOverlayImgIdx: Integer; procedure SetOverlayImgIdx(const Value: Integer); function GetHasChildren: Boolean; procedure SetHasChildren(const Value: Boolean); function GetState: TGMTreeNodeStates; procedure SetState(const Value: TGMTreeNodeStates); function DoBeforeDraw(const PData: PNMTVCustomDraw): LRESULT; function DoAfterDraw(const PData: PNMTVCustomDraw): LRESULT; function OnBeforeExpandOrCollapse(const AOperation: TTVExpandOperation): Boolean; procedure OnAfterExpandOrCollapse(const AOperation: TTVExpandOperation); function Obj: TGMWccTvNode; procedure FreeDataObj; function StartTitleEdit: HWnd; function AbsoluteIndex: LongInt; function ChildIndex: LongInt; function RootNode: IGMWccTvNode; function MakeVisible: Boolean; function Delete: Boolean; function BuildHintText: TGMString; procedure Select; procedure DeleteChildren; function Expand(const Operation: TTVExpandOperation; const Recurse: Boolean = False): Boolean; procedure MoveTo(const Parent: IGMTreeable; const InsertAfter: HTreeItem = nil; const ACryptCtrlData: PGMCryptCtrlData = nil); //property Handle: HTreeItem read GetHandle; property Owner: TGMTreeView read GetOwner; //property Title: TGMString read GetTitle write SetTitle; property ImageIdx: Integer read GetImageIdx write SetImageIdx; property SelectedImgIdx: Integer read GetSelectedImgIdx write SetSelectedImgIdx; property StateImgIdx: Integer read GetStateImgIdx write SetStateImgIdx; property OverlayIdx: Integer read GetOverlayImgIdx write SetOverlayImgIdx; property HasChildren: Boolean read GetHasChildren write SetHasChildren; property State: TGMTreeNodeStates read GetState write SetState; end; PGMWccTreeNodeArray = ^TIGMWccTreeNodeArray; TIGMWccTreeNodeArray = array of IGMWccTvNode; TGMWccTreeNodeData = class(TGMRefCountedObj, IGMLoadStoreData) // IGMGetHint protected FOwner: TGMTreeView; FTreeItem: HTreeItem; public constructor Create(const AOwner: TGMTreeView; const ATreeItem: HTreeItem; const ARefLifeTime: Boolean = False); reintroduce; overload; virtual; function TreeNode: IGMWccTvNode; procedure LoadData(const Source: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); virtual; stdcall; procedure StoreData(const Dest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); virtual; stdcall; property Owner: TGMTreeView read FOwner; property TreeItem: HTreeItem read FTreeItem; // function GetHint: TGMString; virtual; stdcall; end; TGMWccTreeNodeDataClass = class of TGMWccTreeNodeData; TGMWccTvNode = class(TGMRefCountedObj, IGMGetHandle, IGMGetDataObject, IGMSetDataObject, IGMTreeable, IGMWccTvNode, IGMLoadStoreData, IGMGetText, IGMGetSetText) protected FHandle: HTreeItem; FOwner: TGMTreeView; // function VisitCountAbsIdx(const ANode: IGMTreeable; const AParameter: Pointer = nil): Boolean; // function VisitExpandNode(const Node: IGMTreeable; const Parameter: Pointer = nil): Boolean; public function GetHandle: THandle; stdcall; function GetOwner: TGMTreeView; function DataClassName: AnsiString; function GetDataObject: TObject; stdcall; procedure SetDataObject(const AValue: TObject); virtual; stdcall; function GetTVItem(const AMask: UINT): TTVItem; procedure SetTVItem(const AValue: TTVItem); //function GetTitle: TGMString; //procedure SetTitle(const Value: TGMString); function GetText: TGMString; virtual; stdcall; procedure SetText(const AValue: TGMString); virtual; stdcall; function GetImageIdx: Integer; procedure SetImageIdx(const AValue: Integer); function GetSelectedImgIdx: Integer; procedure SetSelectedImgIdx(const AValue: Integer); function GetStateImgIdx: Integer; procedure SetStateImgIdx(const AValue: Integer); function GetOverlayImgIdx: Integer; procedure SetOverlayImgIdx(const AValue: Integer); function GetHasChildren: Boolean; procedure SetHasChildren(const AValue: Boolean); function GetState: TGMTreeNodeStates; procedure SetState(const Value: TGMTreeNodeStates); function DoBeforeDraw(const PData: PNMTVCustomDraw): LRESULT; virtual; function DoAfterDraw(const PData: PNMTVCustomDraw): LRESULT; virtual; function OnBeforeExpandOrCollapse(const AOperation: TTVExpandOperation): Boolean; virtual; procedure OnAfterExpandOrCollapse(const AOperation: TTVExpandOperation); virtual; procedure FreeDataObj; virtual; function StartTitleEdit: HWnd; function AbsoluteIndex: LongInt; function ChildIndex: LongInt; function RootNode: IGMWccTvNode; function Parent: IGMTreeable; function FirstChild: IGMTreeable; function NextSibling: IGMTreeable; function PrevSibling: IGMTreeable; function MakeVisible: Boolean; function Delete: Boolean; virtual; function BuildHintText: TGMString; virtual; procedure Select; procedure DeleteChildren; function Expand(const AOperation: TTVExpandOperation; const Recurse: Boolean = False): Boolean; procedure MoveTo(const AParent: IGMTreeable; const InsertAfter: HTreeItem = nil; const ACryptCtrlData: PGMCryptCtrlData = nil); procedure LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); virtual; stdcall; procedure StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); virtual; stdcall; constructor Create(const AHandle: HTreeItem; const AOwner: TGMTreeView; const ARefLifeTime: Boolean = True); reintroduce; virtual; function Obj: TGMWccTvNode; property Handle: THandle read GetHandle; property Owner: TGMTreeView read GetOwner; //property Title: TGMString read GetTitle write SetTitle; property Text: TGMString read GetText write SetText; property ImageIdx: Integer read GetImageIdx write SetImageIdx; property SelectedImgIdx: Integer read GetSelectedImgIdx write SetSelectedImgIdx; property StateImgIdx: Integer read GetStateImgIdx write SetStateImgIdx; property OverlayImgIdx: Integer read GetOverlayImgIdx write SetOverlayImgIdx; property HasChildren: Boolean read GetHasChildren write SetHasChildren; property DataObject: TObject read GetDataObject write SetDataObject; property State: TGMTreeNodeStates read GetState write SetState; end; TGMTreeNodeClass = class of TGMWccTvNode; TGMTreeNodeStrFunc = function (const ANode: IUnknown): TGMString; TTVClickFunc = function (const Sender: TGMTreeView; const PData: PNMHdr): Integer of object; TTVDispInfoFunc = function(const Sender: TGMTreeView; const PData: PTVDispInfo): Integer of object; TTVNotifyFunc = function(const Sender: TGMTreeView; const PData: PNMTreeView): Integer of object; TTVItemHintFunc = function(const Sender: TGMTreeView; const PData: PNMTVGetInfoTip): Integer of object; TTVItemDrawFunc = function (const Sender: TGMTreeView; const PData: PNMTVCustomDraw): Integer of object; TGMTreeNodeCompareFunc = function (const ItemA, ItemB: LongInt; const ACustomData: Pointer): LongInt of object; TGMTreeView = class(TGMTLViewBase, IGMLoadStoreData, IGMCreateTreeNodeWithDataObj, IGMCreateNewTreeNode, IGMGetTreeNodeFromRaw) protected FTempNodeRef: IUnknown; // FTreeNodeCreateClass: TGMTreeNodeClass; FRClickTargetNode: IGMWccTvNode; FMultiSelect: Boolean; FSelectedNodeCount: PtrInt; // FPaintDragImg: Boolean; function GetImageList(const AIndex: TTVImageList): THandle; procedure SetImageList(const AIndex: TTVImageList; const AValue: THandle); //procedure SetAttributes(const Value: TTVAttributes); function GetSelectedNode: IGMWccTvNode; procedure SetSelectedNode(const AValue: IGMWccTvNode); function GetDropTargetNode: IGMWccTvNode; procedure SetDropTargetNode(const AValue: IGMWccTvNode); function GetSelectedItem: PtrInt; override; procedure SetSelectedItem(const AValue: PtrInt); override; procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN; procedure WMAppNotify(var AMsg: TWMNotify); message WM_NOTIFY + WM_APP; procedure WMDestroy(var AMsg: TWMDestroy); message WM_DESTROY; procedure UMAfterNodeRClick(var AMsg: TMessage); message UM_AFTERNODERCLICK; procedure UMQueryDrop(var AMsg: TGMDragMessageRec); message UM_DRAG_QUERYDROP; procedure UMDragControl(var AMsg: TMessage); message UM_DRAG_CONTROL; procedure UMDragDropped(var AMsg: TMessage); message UM_DRAG_DROPPED; procedure WMChar(var Msg: TWMChar); message WM_CHAR; function ItemAtPoint(const APoint: TPoint): PtrInt; override; function CreateDragImage(const AItem: PtrInt; var ADragPoint: TPoint): THandle; override; procedure DoAfterLoad(const ANode: IGMTreeable); virtual; public Attributes: TGMTLVAttributes; constructor Create(const ARefLifeTime: Boolean); override; function RegisterWndClass: TGMString; override; function TreeNodeCreateClass: TGMTreeNodeClass; virtual; //procedure InternalCreateHandle; override; //procedure WindowProc(var AMsg: TMessage); override; procedure LoadSubNodes(const ASource: IGMValueStorage; const AParentNode: IGMTreeable; const AInsterAfter: HTreeItem = nil; const ACryptCtrlData: PGMCryptCtrlData = nil); function GetTreeNodeFromRaw(const ANode: Pointer): IGMTreeable; stdcall; //procedure StoreNode(const ADest: IGMValueStorage; ANode: IGMTreeable; var ANodeIdx: LongInt; const AStoreSiblings: Boolean = True); procedure LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); virtual; stdcall; procedure StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); virtual; stdcall; procedure StoreUIState(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData = nil); virtual; stdcall; procedure UnselectOtherNodes; procedure GetSelectedNodes(var ANodes: TIGMWccTreeNodeArray); function CreateDataObjFromClass(const ANode: IUnknown; const AClass: TClass; const AClassName: TGMString): TObject; virtual; function CreateTreeNodeWithDataObj(const ASource: IGMValueStorage; const AParentNode: IGMTreeable; const AParameter: IUnknown = nil): IGMTreeable; // stdcall; function CreateNewTreeNode(const AParentNode: IGMTreeable; const ATitle: TGMString; const AImgIdx, ASelectedImgIdx: Integer; const ADataObj: TObject = nil; const AParameter: IUnknown = nil): IGMTreeable; stdcall; function SelectedNodeCount: PtrInt; function CreateNodeWrapper(const AHTreeNode: HTreeItem; const ARefLifeTime: Boolean = True): IGMWccTvNode; function HitTestInfo(const AClientPoint: TPoint): TTVHitTestInfo; function SelectedHasDataClass(const ADataClass: TClass): Boolean; // function AssignTextBkColor(const ANode: IGMWccTvNode): Boolean; procedure ExecContextMenu(const ANode: IGMTreeable); virtual; procedure RemoveAllNodes(const ANotify: Boolean = True); //function CompareItems(const ItemA, ItemB: LongInt; const ACustomData: Pointer): LongInt; virtual; procedure SortSubNodes(const AParentNode: IGMTreeable; const ACompareFunc: TGMTreeNodeCompareFunc; const ACustomData: Pointer = nil); virtual; function EndTitleEdit(const ACancelChanges: BOOL): BOOL; function RootNode: IGMWccTvNode; // function IsAbsNodeIdx(const ANode: IGMTreeable; const AParameter: Pointer = nil): Boolean; function NodeAtAboluteIndex(const AAbsoluteIndex: LongInt): IGMTreeable; function NodeAtPoint(const APoint: TPoint): IGMWccTvNode; function NodeCount: LongInt; function InsertNode(const ANewNode: TTVItem; const AParent: IGMTreeable = nil; const ADataObj: TObject = nil; const AInsertAfter: HTreeItem = nil): IGMWccTvNode; virtual; // function FindParentNode(const AStartNode: IGMTreeable; const ADataClass: TClass; const ANodeTitle: TGMString = ''): IGMTreeable; // function IsNodeMatch(const Node: IGMTreeable; const Parameter: Pointer = nil): Boolean; // FindNode continues iteration until DecideFunc returns true // function FindNode(const StartNode: IGMTreeable; // const DecideFunc: TGMNodeVisitFunc; // const Recurse: Boolean = True; // const Parameter: Pointer = nil): IGMTreeable; overload; // function FindNode(const StartNode: IGMTreeable; // const DataClass: TClass; // const NodeTitle: TGMString = ''; // const Recurse: Boolean = True): IGMTreeable; // procedure VisitNodes(const StartNode: IGMTreeable; // const VisitFunc: TGMNodeVisitFunc; // const Recurse: Boolean = True; // const Parameter: TObject = nil); function CommandTargetNode: IGMWccTvNode; property SelectedNode: IGMWccTvNode read GetSelectedNode write SetSelectedNode; property DropTargetNode: IGMWccTvNode read GetDropTargetNode write SetDropTargetNode; //property ContextSelectedNode: IGMWccTvNode read FContextSelectedNode; // property TreeNodeCreateClass: TGMTreeNodeClass read FTreeNodeCreateClass write FTreeNodeCreateClass; property ImageList[const Idx: TTVImageList]: THandle read GetImageList write SetImageList; //property Attributes: TGMTVAttributes read FAttributes write FAttributes; end; function TCItemRec(const mask: UINT = 0; const Text: TGMString = ''; const ImgIdx: LongInt = cUnkImgIdx; // <- allow -1 here! const State: Integer = -1; StateMask: Integer = -1; const lParam: LPARAM = -1): TTCItem; function LVItemRec(const iItem, iSubItem: LongInt; const mask: UINT = 0; const Text: TGMString = ''; const ImgIdx: LongInt = cUnkImgIdx; // <- allow -1 here! const State: Integer = -1; StateMask: Integer = -1; const lParam: LPARAM = -1): TLVItem; function TVItemRec(const hItem: HTreeItem; const mask: UINT = 0; const Text: PGMChar = nil; const ImgIdx: LongInt = cUnkImgIdx; // <- allow -1 here! const SelIdx: LongInt = cUnkImgIdx; // <- allow -1 here! const Children: LongInt = -1; const State: Integer = -1; StateMask: Integer = -1; const lParam: LPARAM = -1): TTVItem; function GMImgListIconSize(const HImgList: THandle): TPoint; procedure GMDrawImgListIcon(const ADC: HDC; const AImgList: IGMGetHandle; const AImgIdx: PtrInt; // LongInt; const ARect: TRect; const ADisabled: Boolean = False); //function GMCompareWccNodes(const Node1, Node2: IUnknown): TGMCompareResult; function GMIsSameWccNode(const ANode1, ANode2: IUnknown): Boolean; function TreeNodeStatesToInt(const Value: TGMTreeNodeStates): Integer; function TreeNodeStatesFromInt(const Value: Integer): TGMTreeNodeStates; function GMSearchPathNode(const StartNode: IGMTreeable; const Path: TGMString; const GetNodePathFunc: TGMTreeNodeStrFunc): IGMTreeable; procedure GMSetAreaHintData(const AArea: TObject; const AHintTitle, AHintText: TGMString; const AIcon: LongInt = cInvalidHintIcon); procedure GMInternalExpandSubTreeOnce(const ARootNode: IGMTreeable; const AExpandOperation: TTVExpandOperation = eoExpand; const AExpandSiblings: Boolean = False; const ARecurse: Boolean = True); function GMExpandWccTvNode(const ANode: IUnknown; const AExpandOperation: TTVExpandOperation; const ARecurse: Boolean = False): Boolean; const //cStrAttributes = 'Attributes'; cStrTitle = 'Title'; cStrState = 'State'; cStrImageIndex = 'ImageIdx'; cStrSelectedImgIdx = 'SelectedImgIdx'; cStrStateImgIdx = 'StateImgIdx'; cStrOverlayImgIdx = 'OverlayImgIdx'; cStrDataClassName = 'DataClassName'; cStrVScrollPos = 'VScrollPos'; cStrHScrollPos = 'HScrollPos'; cStrSelectedNodeIdx = 'SelectedNodeIdx'; cStrUnknownPageTitle = '?'; cLVImageList: array [TLVImageList] of DWORD = (LVSIL_NORMAL, LVSIL_SMALL, LVSIL_STATE); cTVImageList: array [TTVImageList] of DWORD = (TVSIL_NORMAL, TVSIL_STATE); cTVExpandOperation: array [TTVExpandOperation] of PtrUInt = (TVE_EXPAND, TVE_EXPAND or TVE_EXPANDPARTIAL, TVE_COLLAPSE, TVE_COLLAPSE or TVE_COLLAPSERESET, TVE_TOGGLE); cTVItemStates: array [TGMTreeNodeState] of PtrUInt = (TVIS_FOCUSED, TVIS_SELECTED, TVIS_CUT, TVIS_DROPHILITED, TVIS_BOLD, TVIS_EXPANDED, TVIS_EXPANDEDONCE, TVIS_EXPANDPARTIAL); implementation uses Sysutils, GMPrsStg, GMClassReg {$IFDEF JEDIAPI}, jwaWinBase, jwaWinGdi{$ENDIF}; const cPageTabCloseBtnSpace: TPoint = (X: 2; Y: 3); cPageTabCloseBtnSize: TPoint = (X: 15; Y: 14); resourcestring RStrComCtl32InitError = 'Failed to initialize ComCtl32 DLL: %d'; var vMSCtl32DllInitialized: LongWord = 0; //vTreeNodeDataClasses: array of TGMWccTreeNodeDataClass = nil; type PGMLVSortData = ^TGMLVSortData; TGMLVSortData = record ListView: TGMListView; ColIdx: Integer; end; PGMTVSortData = ^TGMTVSortData; TGMTVSortData = record //TreeView: TGMTreeView; CompareFunc: TGMTreeNodeCompareFunc; CustomData: Pointer; end; { ------------------------- } { ---- Global Routines ---- } { ------------------------- } function InitCommonControlsEx(var ICC: TInitCommonControlsEx): BOOL stdcall; external 'comctl32.dll'; procedure GMInitComCtl32Dll(const AControlClass: LongWord); var icc: TInitCommonControlsEx; begin //if AControlClass and vMSCtl32DllInitialized <> 0 then Exit; if AControlClass and not vMSCtl32DllInitialized = 0 then Exit; icc.dwSize := SizeOf(icc); icc.dwICC := AControlClass; if not InitCommonControlsEx(icc) then raise Exception.Create(GMFormat(RStrComCtl32InitError, [AControlClass])); vMSCtl32DllInitialized := vMSCtl32DllInitialized or AControlClass; end; function TCItemRec(const mask: UINT; const Text: TGMString; const ImgIdx: LongInt; const State: Integer; StateMask: Integer; const lParam: LPARAM): TTCItem; begin //FillByte(Result, SizeOf(Result), 0); Result := Default(TTCItem); if Text <> '' then begin Result.pszText := PGMChar(Text); Result.mask := Result.mask or TCIF_TEXT; end; if ImgIdx <> cUnkImgIdx then begin Result.iImage := ImgIdx; Result.mask := Result.mask or TCIF_IMAGE; end; if lParam <> -1 then begin Result.lParam := lParam; Result.mask := Result.mask or TCIF_PARAM; end; end; function LVItemRec(const iItem, iSubItem: LongInt; const mask: UINT; const Text: TGMString; const ImgIdx: LongInt; const State: Integer; StateMask: Integer; const lParam: LPARAM): TLVItem; begin //FillByte(Result, SizeOf(Result), 0); Result := Default(TLVItem); Result.iItem := iItem; Result.iSubItem := iSubItem; Result.mask := mask; if Text <> '' then begin Result.pszText := PGMChar(Text); Result.mask := Result.mask or LVIF_TEXT; end; if ImgIdx <> cUnkImgIdx then // <- allow -1 here! begin Result.iImage := ImgIdx; Result.mask := Result.mask or LVIF_IMAGE; end; if State <> -1 then begin Result.state := State; if StateMask = -1 then StateMask := State; Result.stateMask := StateMask; Result.mask := Result.mask or LVIF_STATE; end; if lParam <> -1 then begin Result.lParam := lParam; Result.mask := Result.mask or LVIF_PARAM; end; end; function TVItemRec(const hItem: HTreeItem; const mask: UINT; const Text: PGMChar; const ImgIdx: LongInt; const SelIdx: LongInt; const Children: LongInt; const State: Integer; StateMask: Integer; const lParam: LPARAM): TTVItem; const CHandleFlag: array [Boolean] of DWORD = (0, TVIF_HANDLE); begin //FillByte(Result, SizeOf(Result), 0); Result := Default(TTVItem); Result.hItem := hItem; Result.mask := mask or CHandleFlag[hItem <> nil]; if Text <> nil then begin Result.pszText := Text; Result.mask := Result.mask or TVIF_TEXT; end; if Children >= 0 then begin Result.cChildren := Children; Result.mask := Result.mask or TVIF_CHILDREN; end; if ImgIdx <> cUnkImgIdx then begin Result.iImage := ImgIdx; Result.mask := Result.mask or TVIF_IMAGE; end; if SelIdx <> cUnkImgIdx then begin Result.iSelectedImage := SelIdx; Result.mask := Result.mask or TVIF_SELECTEDIMAGE; end; if State <> -1 then begin Result.state := State; if StateMask = -1 then StateMask := State; Result.stateMask := StateMask; Result.mask := Result.mask or TVIF_STATE; end; if lParam <> -1 then begin Result.lParam := lParam; Result.mask := Result.mask or TVIF_PARAM; end; end; function GMImgListIconSize(const HImgList: THandle): TPoint; {$IFDEF FPC}{$push}{$WARN 5060 off : Function result variable does not seem to be initialized}{$ENDIF} begin Result := Default(TPoint); ImageList_GetIconSize(HImgList, Result.x, Result.y); end; {$IFDEF FPC}{$pop}{$ENDIF} {function GMAsTVNode(const ANode: IUnknown): IGMWccTvNode; begin GMcheckQueryInterface(ANode, IGMWccTvNode, Result, 'GMAsTVNode'); end;} procedure GMDrawImgListIcon(const ADC: HDC; const AImgList: IGMGetHandle; const AImgIdx: PtrInt; // LongInt; const ARect: TRect; const ADisabled: Boolean = False); var Icon: HIcon; FreeIcon: Boolean; begin if (AImgList = nil) or (AImgIdx = cImgIdxNone) or (ADC = 0) then Exit; FreeIcon := False; if AImgIdx > cImgIdxHigh then Icon := LoadIcon(0, MakeIntResource(AImgIdx)) else begin Icon := ImageList_GetIcon(AImgList.Handle, AImgIdx, ILD_NORMAL); FreeIcon := True; end; if Icon <> 0 then try GMDrawIcon(ADC, Icon, ARect, ADisabled); finally if FreeIcon then DestroyIcon(Icon); end; end; function ListViewItemTextCompareFunc(Item1, Item2, Param: LPARAM): Integer; stdcall; begin with PGMLVSortData(Param)^ do Result := CompareText(ListView.ItemText[Item1, ColIdx], ListView.ItemText[Item2, ColIdx]); end; function GMIsSameWccNode(const ANode1, ANode2: IUnknown): Boolean; var Handle1, Handle2: IGMGetHandle; begin Result := ((ANode1 = nil) and (ANode2 = nil)) or ((ANode1 <> nil) and (ANode2 <> nil) and GMQueryInterface(ANode1, IGMGetHandle, Handle1) and GMQueryInterface(ANode2, IGMGetHandle, Handle2) and (Handle1.Handle = Handle2.Handle)); end; //function GMCompareWccNodes(const Node1, Node2: IUnknown): TGMCompareResult; //begin //end; function TreeNodeStatesToInt(const Value: TGMTreeNodeStates): Integer; var i: TGMTreeNodeState; begin Result := 0; for i:=Low(i) to High(i) do if i in Value then Result := Result or (1 shl Ord(i)); end; function TreeNodeStatesFromInt(const Value: Integer): TGMTreeNodeStates; var i: TGMTreeNodeState; begin Result := []; for i:=Low(i) to High(i) do if Value and (1 shl Ord(i)) <> 0 then Include(Result, i); end; function ExpandOperationFromFlags(const AExpandFlags: Cardinal): TTVExpandOperation; begin case AExpandFlags of TVE_EXPAND: Result := eoExpand; TVE_EXPAND or TVE_EXPANDPARTIAL: Result := eoExpandPartial; TVE_COLLAPSE: Result := eoCollapse; TVE_COLLAPSE or TVE_COLLAPSERESET: Result := eoCollapseReset; TVE_TOGGLE: Result := eoToggle; else Result := eoExpand; end; end; function DoNodeExpandOnce(const ANode: IGMTreeable; const AParameter: Pointer = nil): Boolean; var tvNode: IGMWccTvNode; begin if GMQueryInterface(ANode, IGMWccTvNode, tvNode) then tvNode.OnBeforeExpandOrCollapse(TTVExpandOperation(AParameter)); Result := True; end; procedure GMInternalExpandSubTreeOnce(const ARootNode: IGMTreeable; const AExpandOperation: TTVExpandOperation; const AExpandSiblings, ARecurse: Boolean); begin if ARootNode = nil then Exit; if AExpandSiblings then GMVisitNodesRootFirst(ARootNode, DoNodeExpandOnce, ARecurse, Pointer(AExpandOperation)) else if DoNodeExpandOnce(ARootNode, Pointer(AExpandOperation)) then GMVisitNodesRootFirst(ARootNode.FirstChild, DoNodeExpandOnce, ARecurse, Pointer(AExpandOperation)); end; function GMSearchPathNode(const StartNode: IGMTreeable; const Path: TGMString; const GetNodePathFunc: TGMTreeNodeStrFunc): IGMTreeable; function SearchNode(const ANode: IGMTreeable; const Level, DirLevel: LongInt): IGMTreeable; var Node: IGMTreeable; TVNode: IGMWccTvNode; NodePath: TGMString; Dir, NodeDir: TGMString; // title begin Result := nil; Node := ANode; Dir := GMNThWord(Path, DirLevel, cDirSep); while GMQueryInterface(Node, IGMWccTvNode, TVNode) do // Node <> nil begin //GMcheckQueryInterface(Node, IGMWccTvNode, TVNode, 'GMSearchPathNode'); NodePath := GetNodePathFunc(Node); NodeDir := GMNThWord(NodePath, DirLevel, cDirSep); //title := GMGetIntfText(TVNode); if GMIsPrefixStr(NodePath, Path) and GMSameText(Dir, NodeDir) then begin if Length(Path) = Length(NodePath) then begin Result := Node; Exit; end else begin if TVNode.Expand(eoExpand, False) then Result := SearchNode(Node.FirstChild, Level+1, DirLevel+1); Exit; end; end else Node := Node.NextSibling; end; if (Result <> nil) or (Level >= 2) then Exit; Node := ANode; while GMQueryInterface(Node, IGMWccTvNode, TVNode) do // Node <> nil begin //GMcheckQueryInterface(Node, IGMWccTvNode, TreeViewNode, 'GMSearchPathNode'); //if not Node.Expand(eoExpand, False) then Exit; if TVNode.Expand(eoExpand, False) then begin Result := SearchNode(Node.FirstChild, Level+1, DirLevel); if Result <> nil then Exit else if Level > 0 then TVNode.Expand(eoCollapse, False); end; Node := Node.NextSibling; end; end; begin //if not Assigned(GetNodePathFunc) then begin Result := nil; Exit; end; Result := SearchNode(StartNode, 0, 1); //if Result = nil then Result := SearchNode(StartNode.FirstChild, 0); end; procedure GMSetAreaHintData(const AArea: TObject; const AHintTitle, AHintText: TGMString; const AIcon: LongInt); var i: LongInt; begin if AArea is TGMUiAreaBase then for i:=0 to TGMUiAreaBase(AArea).ContainedAreas.Count-1 do with TGMUiAreaBase(AArea) do if ContainedAreas[i] is TGMHintWindow then begin if Length(AHintText) > 0 then TGMHintWindow(ContainedAreas[i]).SetText(AHintText); if Length(AHintTitle) > 0 then TGMHintWindow(ContainedAreas[i]).SetTitleAndIcon(AHintTitle); Break; end; end; function GMExpandWccTvNode(const ANode: IUnknown; const AExpandOperation: TTVExpandOperation; const ARecurse: Boolean = False): Boolean; var tvNode: IGMWccTvNode; begin if GMQueryInterface(ANode, IGMWccTvNode, tvNode) then Result := tvNode.Expand(AExpandOperation, AREcurse) else Result := False; end; { ---------------------- } { ---- TGMImageList ---- } { ---------------------- } constructor TGMImageList.Create(const AImgSize: TPoint; const ACreateFlags: LongWord; const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); GMInitComCtl32Dll(ICC_TAB_CLASSES); // ICC_WIN95_CLASSES ? FHandle := ImageList_Create(AImgSize.x, AImgSize.y, ACreateFlags, 1, 0); // ILC_MASK or ILC_COLOR24 end; constructor TGMImageList.Create(const AResBmpName: PGMChar; const AInstance: THandle; const AImgWidth: LongInt; const ACreateFlags: LongWord; const ATransparentColor: COLORREF; const ARefLifeTime: Boolean); var Bmp: IGMGetHandle; W: LongInt; FImageSize: TPoint; // BmpSize: TPoint; begin inherited Create(ARefLifeTime); Bmp := TGMGdiBitmap.CreateFromRes(0, AResBmpName, AInstance, {$IFDEF DEBUG}True{$ELSE}False{$ENDIF}, True); if Bmp.Handle = 0 then Exit; GMInitComCtl32Dll(ICC_TAB_CLASSES); // ICC_WIN95_CLASSES ? FImageSize := GMBitmapSize(Bmp.Handle); if AImgWidth > 0 then W := AImgWidth else W := FImageSize.y; FHandle := ImageList_Create(W, FImageSize.y, ACreateFlags, FImageSize.x div W, 0); //FImageSize.x := W; if (FHandle = 0) or (Bmp.Handle = 0) then Exit; ImageList_AddMasked(FHandle, Bmp.Handle, ATransparentColor); end; constructor TGMImageList.TakeOver(const AHandle: HImageList; const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); FHandle := AHandle; end; destructor TGMImageList.Destroy; begin if FHandle <> 0 then begin ImageList_Destroy(FHandle); FHandle := 0; end; inherited Destroy; end; function TGMImageList.GetHandle: THandle; begin Result := FHandle; end; { ------------------------------- } { ---- TGMImgListDragPainter ---- } { ------------------------------- } //constructor TGMImgListDragPainter.Create(const AParent: TObject; // const AImageList: IGMGetHandle; const ADragOffs: TPoint; // const ADragData: IUnknown; const ADragImgIdx: Integer; // const ARefLifeTime: Boolean); ////var MousePos: TPoint; PrntWnd: HWnd; //begin // inherited Create(AParent, ADragData, ARefLifeTime); // ADragOffs, // FImageList := AImageList; // Assert(FImageList <> nil); // // //ImageList_BeginDrag(0, 0, 0, 0); // <- try to clear position of previous drag, seems to be remebered by windows // ImageList_DragShowNolock(False); // ImageList_BeginDrag(FImageList.Handle, 0, ADragOffs.x, ADragOffs.y); // ImageList_DragShowNolock(True); // DragToScreenPos(GMMousePosition); // ////if GMFindAllocatedParentHandle(Self, PrntWnd) then //// begin //// MousePos := GMMousePosition; //// ScreenToClient(PrntWnd, MousePos); //// //MousePos := GMScreenToClient(Self, GMMousePosition); //// //GMCallObjWindowProc(Self, WM_MOUSEMOVE, 0, MakeLongInt(MousePos.x, MousePos.y)); //// //GMPostObjMessage(Self, WM_MOUSEMOVE, 0, MakeLongInt(MousePos.x, MousePos.y)); //// //// /// hier! //// SendMessage(PrntWnd, WM_MOUSEMOVE, 0, MakeLongInt(MousePos.x, MousePos.y)); //// //// end; // // ImageList_DragShowNolock(True); //end; // //procedure TGMImgListDragPainter.DragToScreenPos(const AScreenPos: TPoint); //begin // ImageList_DragMove(AScreenPos.x, AScreenPos.y); //end; // //procedure TGMImgListDragPainter.ExitDragState; //begin // ImageList_EndDrag; // inherited; //end; // //procedure TGMImgListDragPainter.SetVisible(const Value, Relayout: Boolean); //begin // ImageList_DragShowNolock(Value); //end; // //procedure TGMImgListDragPainter.WMMouseWheel(var Msg: TMessage); //begin // ImageList_DragShowNolock(False); // try // inherited; // finally // ImageList_DragShowNolock(True); // end; //end; constructor TGMImgListDragPainter.Create(const AParent: TObject; const AImageList: IGMGetHandle; const ADragOffs: TPoint; const ADragData: IUnknown; const ADragImgIdx: Integer; const ARefLifeTime: Boolean); const cColorTransprnt = 1234567; var bmp, bmpDC, brush, imgLst: IGMGetHandle; imgSz: TPoint; // trnspCol: COLORREF; // imgInfo: TImageInfo; // n: Integer;// begin //trnspCol := GMRGBColor(1234567); imgLst := AImageList; // <- for proper release if directly cretaed if (AImageList <> nil) and (ImageList_GetImageCount(AImageList.Handle) > 0) then begin ImageList_GetIconSize(AImageList.Handle, imgSz.x, imgSz.y); bmp := TGMGdiBitmap.CreateCompatibleBmp(0, 0, imgSz); bmpDC := TGMGdiCompatibleDC.Create(bmp.Handle); brush := TGMGdiBrush.Create(0, cColorTransprnt); FillRect(bmpDC.Handle, GMRect(cNullPoint, imgSz), brush.Handle); brush := nil; // FillByte(imgInfo, SizeOf(imgInfo), 0); // ImageList_GetImageInfo(AImageList.Handle, 0, imgInfo); // SetTextColor(bmpDC.Handle, 0); ImageList_Draw(AImageList.Handle, 0, bmpDC.Handle, 0, 0, ILD_NORMAL); // ILD_IMAGE // ILD_NORMAL // ImageList_DrawEx(AImageList.GetHandle, 0, bmpDC.Handle, 0, 0, imgSz.x, imgSz.y, cColorTransprnt, 0, ILD_NORMAL); bmpDC := nil; end; inherited Create(AParent, bmp, cColorTransprnt, ADragOffs, ADragData, ARefLifeTime); end; { ---------------------------- } { ---- TGMImgListIconArea ---- } { ---------------------------- } constructor TGMImgListIconArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AImageList: IGMGetHandle; const AImageIndex: Integer; const AAttributes: TImgAttributes; const ABkgndColor: COLORREF; const AHorizontalAlignment: TGMHorizontalAlignment; const AVerticalAlignment: TGMVerticalAlignment; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, AAttributes, ABkgndColor, AHorizontalAlignment, AVerticalAlignment, AVisible, ARefLifeTime); FImageList := AImageList; FImageIndex := AImageIndex; end; procedure TGMImgListIconArea.AssignImageSize; begin if FImageList <> nil then ImageList_GetIconSize(FImageList.Handle, FImageSize.x, FImageSize.y); //if (FImageCollection <> nil) and (FImageIndex >= 0) then FImageSize := FImageCollection.Obj.ImageDescs[FImageIndex].Size; end; function TGMImgListIconArea.InternalPaintArea(const ADC: HDC; const ARect: TRect): Boolean; begin //if FImageCollection <> nil then FImageCollection.Obj.DrawImage(FImageIndex, ADC, ARect); if FImageList <> nil then ImageList_Draw(FImageList.Handle, FImageIndex, ADC, ARect.Left, ARect.Top, ILD_NORMAL); Result := True; end; procedure TGMImgListIconArea.SetImageIndex(const AImageIndex: LongInt; const ARepaint: Boolean = False; const AReLayout: Boolean = False); begin if FImageIndex = AImageIndex then Exit; FImageIndex := AImageIndex; if AReLayout then GMReLayoutContainedAreas(Parent, ARepaint) else if ARepaint then ScheduleRepaint; end; { ---------------------------------- } { ---- TGMImgLstCheckBoxImgArea ---- } { ---------------------------------- } constructor TGMImgLstCheckBoxImgArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AImgList: IGMGetHandle; const AImgIdxNotChecked, AImgIdxChecked: Integer; const ABkgndColor: COLORREF; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, ABkgndColor, AVisible, ARefLifeTime); GMFindParentObj(AParent, TGMImgLstCheckBoxArea, FCheckBoxArea); FImgList := AImgList; if AImgIdxNotChecked >= 0 then FImgIdxNotChecked := AImgIdxNotChecked else FImgIdxNotChecked := 0; if AImgIdxChecked >= 0 then FImgIdxChecked := AImgIdxChecked else FImgIdxChecked := FImgIdxNotChecked + 1; end; procedure TGMImgLstCheckBoxImgArea.SetupImgSize; begin if (FImgList <> nil) and ((FImgSize.x = 0) or (FImgSize.y = 0)) then ImageList_GetIconSize(FImgList.Handle, FImgSize.x, FImgSize.y); end; function TGMImgLstCheckBoxImgArea.InternalCalcHeight(const NewSize: TPoint): LongInt; begin SetupImgSize; Result := FImgSize.y; end; function TGMImgLstCheckBoxImgArea.InternalCalcWidth(const NewSize: TPoint): LongInt; begin SetupImgSize; Result := FImgSize.x; end; function TGMImgLstCheckBoxImgArea.PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; var ImgIdx: LongInt; begin Result := inherited PaintArea(ADC, RSurface); if FImgList = nil then Exit; ImgIdx := 0; if FCheckBoxArea <> nil then case FCheckBoxArea.Checked of True: ImgIdx := FImgIdxChecked; False: ImgIdx := FImgIdxNotChecked; end; ImageList_Draw(FImgList.Handle, ImgIdx, ADC, RSurface.Left, RSurface.Top, ILD_NORMAL); end; { ----------------------------- } { ---- TGMCheckBoxTextArea ---- } { ----------------------------- } {function TGMCheckBoxTextArea.AreaFiller: IGMAreaFiller; begin if FCheckBoxArea = nil then GMFindParentObj(Parent, TGMImgLstCheckBoxArea, FCheckBoxArea); if (FCheckBoxArea = nil) or not FCheckBoxArea.MouseInside then Result := inherited AreaFiller else Result := GMToolBtnFiller; end; function TGMCheckBoxTextArea.PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; begin if FCheckBoxArea = nil then GMFindParentObj(Parent, TGMImgLstCheckBoxArea, FCheckBoxArea); Result := inherited PaintArea(ADC, RSurface); if (FCheckBoxArea <> nil) and FCheckBoxArea.MouseInside then GMDrawRoundFrame(ADC, RSurface, clDfltHoverFrameColor, CLR_INVALID); end;} { ------------------------------- } { ---- TGMImgLstCheckBoxArea ---- } { ------------------------------- } constructor TGMImgLstCheckBoxArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString; const AImgList: IGMGetHandle; const AImgIdxNotChecked, AImgIdxChecked: Integer; const AOnClick: TGMObjNotifyProc; const ABkgndColor: COLORREF; const AVisible, ARefLifeTime: Boolean); const cChkBoxMessages: array [0..2] of TGMWndMsg = (WM_MOUSEMOVE, WM_LBUTTONDOWN, WM_LBUTTONUP); begin inherited Create(AParent, APosition, AAreaAlign, ABkgndColor, AVisible, ARefLifeTime); FOnClick := AOnClick; GMAddDispatchToParentMessages(OwnArea(TGMImgLstCheckBoxImgArea.Create(Self, cNullRect, cTopLeftX, AImgList, AImgIdxNotChecked, AImgIdxChecked, clrTransparent)), cChkBoxMessages); FTextLabel := OwnArea(TGMxLabel.Create(Self, GMRect(cCtlSpace, 2, 0, 0), cTopAligned, cNullRect, AText, clrTransparent, 0, cDfltFontColor, cDfltTextLabelDrawFlags or DT_WORD_ELLIPSIS, haLeft, vaTop)) as TGMxLabel; GMAddDispatchToParentMessages(FTextLabel, cChkBoxMessages); FPaddSpace := GMPoint(0, 1); end; procedure TGMImgLstCheckBoxArea.SetChecked(const Value: Boolean); begin if Value = FChecked then Exit; FChecked := Value; ScheduleRepaint; end; function TGMImgLstCheckBoxArea.AreaFiller: IGMAreaFiller; begin if not MouseInside then Result := inherited AreaFiller else Result := GMToolBtnFiller; end; function TGMImgLstCheckBoxArea.PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; begin Result := inherited PaintArea(ADC, RSurface); if MouseInside then GMDrawRoundFrame(ADC, RSurface, GMFrameColorFromBkgndColor(BkgndColor), CLR_INVALID); // clDfltHoverFrameColor end; procedure TGMImgLstCheckBoxArea.WMMouseEnter(var Msg: TWMMouse); begin inherited; ScheduleRepaint; end; procedure TGMImgLstCheckBoxArea.WMMouseLeave(var Msg: TWMMouse); begin inherited; ScheduleRepaint; end; procedure TGMImgLstCheckBoxArea.Click; begin FChecked := not FChecked; if Assigned(FOnClick) then FOnClick(Self); SendMessage(GetFocus, WM_CANCELMODE, 0, 0); end; function TGMImgLstCheckBoxArea.GetEnabled: Boolean; begin Result := not FDisabled; end; procedure TGMImgLstCheckBoxArea.SetEnabled(const AEnabled: Boolean); begin if AEnabled = not FDisabled then Exit; FDisabled := not AEnabled; if FTextLabel <> nil then FTextLabel.SetEnabled(AEnabled); ScheduleRepaint; end; procedure TGMImgLstCheckBoxArea.WMLButtonDown(var Msg: TWMMouse); begin inherited; if not Enabled then Exit; FMouseDown := True; ScheduleRepaint; GMCaptureMouseInput(Self); end; procedure TGMImgLstCheckBoxArea.WMLButtonUp(var Msg: TWMMouse); var MouseDn: Boolean; begin MouseDn := FMouseDown; FMouseDown := False; {if Enabled then} GMReleaseMouseCapture; inherited; if Enabled and MouseDn then begin ScheduleRepaint; if MouseInside then Click; end; end; { ----------------------- } { ---- TGMHintWindow ---- } { ----------------------- } constructor TGMHintWindow.Create(const AParent: TGMWndObj; const ARect: TRect; const AAreaAlign: TGMAreaAlignRec; AText, ATitle: TGMString; const AMaxShowTimeMS, AMaxWidth, AIcon: Integer; const AShowDelayTimeMS: LongInt; const AWndStyle, AWndExStyle: DWORD; const ARefLifeTime: Boolean); begin if AText = '' then begin AText := ATitle; ATitle := ''; end; inherited Create(AParent, ARect, AAreaAlign, AWndStyle, AWndExStyle, AText, 0, clrInfoBkgnd, ARefLifeTime); if AText <> cTextCallback then Text := GMTerminateStr(Text); // <- do this AFTER resolving the TExt in inherited constructor! FTitle := GMStripRight(GMResolveTextResData(ATitle, FTitleResTextRef), '.' + cWhiteSpace); FMaxShowTime := AMaxShowTimeMS; FShowDelayTimeMS := AShowDelayTimeMS; FMaxWidth := AMaxWidth; FIcon := AIcon; end; function TGMHintWindow.IsLayoutChild: Boolean; begin // Being a layout child automatically creates our handle. // LayoutBounds will be the area sensitive to the popup hint. Result := True; end; function TGMHintWindow.FillsComplete: Boolean; begin Result := False; // <- let parent fill us! We dont occupy any visible area! end; {function TGMHintWindow.ParticipateInLayouting: Boolean; begin Result := True; // <- we want to be layouted, even when not visible! end;} function TGMHintWindow.GetVisible: Boolean; //var PIParent: IGMUiArea; begin // we are always visible, meaning that our showing always changes with our parent. // Needed for correct hint add/Remove when moving from ToolBar to popup and back. // Sideffect -> We are always layouted! No need to override ParticipateInLayouting Result := True; {if (Parent <> nil) and Parent.GetInterface(IGMUiArea, PIParent) then Result := PIParent.Visible else Result := False;} end; function TGMHintWindow.GetText: TGMString; begin Result := FCreateData.Text; end; procedure TGMHintWindow.SetShowing(const Value: Boolean); begin InternalSetVisible(Value); end; procedure TGMHintWindow.SetText(const AText: TGMString); var HintData: TToolInfo; begin if AText = Text then Exit; // (Length(AText) <= 0) or inherited SetText(AText); HintData := BuildHintData; if HandleAllocated then begin SendMessage(FHandle, TTM_UPDATETIPTEXT, 0, LPARAM(@HintData)); if FMaxShowTime = cDfltHintMaxShowTime then SendMessage(FHandle, TTM_SETDELAYTIME, TTDT_AUTOPOP, GMCalcHintShowTimeMS(AText)) end; end; procedure TGMHintWindow.LanguageChanged(const ANewLanguage: LParam); begin inherited; if FTitleResTextRef.ResStringPtr <> nil then SetTitleAndIcon(GMBuildTextFromResRef(FTitleResTextRef, '')); end; procedure TGMHintWindow.SetTitleAndIcon(const ATitle: TGMString; const AIcon: Integer); begin FTitle := ATitle; // <- Allow setting to empty string for programatically hidden hint windows if AIcon >= 0 then FIcon := AIcon; if HandleAllocated then SendMessage(FHandle, TTM_SETTITLE, FIcon, LPARAM(PGMChar(FTitle))); end; function TGMHintWindow.HintAdded: Boolean; var HintData: TToolInfo; begin HintData := BuildHintData(True); Result := SendMessage(FHandle, TTM_GETTOOLINFO, 0, LPARAM(@HintData)) <> 0; end; procedure TGMHintWindow.AfterParentChanged; var HintData: TToolInfo; HWndPrnt: HWnd; begin if not HandleAllocated or not GMFindAllocatedParentHandle(Parent, HWndPrnt) then Exit; if HintAdded then begin HintData := BuildHintData; SendMessage(FHandle, TTM_DELTOOL, 0, LPARAM(@HintData)); end; FCreateData.ParentWnd := HWndPrnt; // NOTE: No call to inherited here! HintData := BuildHintData; SendMessage(FHandle, TTM_ADDTOOL, 0, LPARAM(@HintData)); end; procedure TGMHintWindow.InternalSetVisible(const Value: Boolean); const cToolMsg: array [Boolean] of LongInt = (TTM_DELTOOL, TTM_ADDTOOL); var HintData: TToolInfo; begin if not HandleAllocated then Exit; if Value = HintAdded then Exit; HintData := BuildHintData; SendMessage(FHandle, cToolMsg[Value], 0, LPARAM(@HintData)); end; procedure TGMHintWindow.SurfaceOriginChanged; var HintData: TToolInfo; begin if not HandleAllocated then Exit; HintData := BuildHintData; SendMessage(FHandle, TTM_NEWTOOLRECT, 0, LPARAM(@HintData)); end; procedure TGMHintWindow.WMAppNotify(var Msg: TWMNotify); begin inherited; case Integer(Msg.NMHdr.code) of TTN_GETDISPINFO: if Assigned(OnBuildHintText) then begin FCallBackText := GMTerminateStr(OnBuildHintText); if FMaxShowTime = cDfltHintMaxShowTime then SendMessage(FHandle, TTM_SETDELAYTIME, TTDT_AUTOPOP, GMCalcHintShowTimeMS(FCallBackText)); PNMTTDispInfo(Msg.NMHdr)^.lpszText := PGMChar(FCallBackText); end; TTN_POP: if Assigned(OnWindowClosed) then OnWindowClosed(Self); TTN_LINKCLICK: if Assigned(OnLinkClicked) then OnLinkClicked(Self); end; FPassMessageToOriginalHandler := False; end; function TGMHintWindow.BuildHintData(const IdOnly: Boolean): TToolInfo; begin //FillByte(Result, SizeOf(Result), 0); Result := Default(TToolInfo); Result.cbSize := SizeOf(Result); Result.uId := 1; Result.hwnd := FCreateData.ParentWnd; // <- layouting is done relative to parent window, // so use parent window handle instead of our window handle here! // Note: parent will receive WM_NOTIFY GMMessages then. if IdOnly then Exit; Result.uFlags := TTF_SUBCLASS; // TTF_IDISHWND or TTF_CENTERTIP or TTF_TRANSPARENT Result.Rect := CalculateSurfaceRect(FLayoutBounds); if FCreateData.Text = cTextCallback then Result.lpszText := LPSTR_TEXTCALLBACK else Result.lpszText := PGMChar(FCreateData.Text); end; procedure TGMHintWindow.SetLayoutBounds(const Value: TRect; const Repaint: Boolean); begin //inherited SetLayoutBounds(Value, Repaint); <- Dont call inherited here: would move showing hint window to top-left screen corner! FLayoutBounds := Value; SurfaceOriginChanged; end; function TGMHintWindow.RegisterWndClass: TGMString; begin GMInitComCtl32Dll(ICC_TAB_CLASSES or ICC_BAR_CLASSES); Result := TOOLTIPS_CLASS; end; procedure TGMHintWindow.InternalCreateHandle; var HintData: TToolInfo; PIParent: IGMUiArea; begin // No Call to inherited here! //if HandleAllocated then Exit; CreateParentHandle; // <- recursively create all parent handles with FCreateData do FHandle := CreateWindowEx(WndExStyle, PGMChar(RegisterWndClass), nil, WndStyle or WS_POPUP, 0, 0, 0, 0, ParentWnd, Menu, {$IFNDEF FPC}SysInit.{$ELSE}System.{$ENDIF}HInstance, nil); GMAPICheckObj('CreateWindowEx', '', GetLastError, FHandle <> 0, Self); FOrgWndPtrData := SetWindowLongPtr(FHandle, cWndObjPtrData, PtrInt(Self)); // // HWND_TOPMOST flips modal dlg window of other threads to back when hint is shown // //SetWindowPos(Handle, HWND_TOPMOST,0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); HintData := BuildHintData; SendMessage(FHandle, TTM_SETTIPBKCOLOR, GMRGBColor(BkgndColor), 0); SendMessage(FHandle, TTM_SETTIPTEXTCOLOR, GMRGBColor(clrInfoText), 0); if FTitle <> '' then SendMessage(FHandle, TTM_SETTITLE, FIcon mod 4, LPARAM(PGMChar(FTitle))); if FMaxShowTime = cDfltHintMaxShowTime then SendMessage(FHandle, TTM_SETDELAYTIME, TTDT_AUTOPOP, GMCalcHintShowTimeMS(Text)) else if FMaxShowTime > 0 then SendMessage(FHandle, TTM_SETDELAYTIME, TTDT_AUTOPOP, FMaxShowTime); if FShowDelayTimeMS > 0 then SendMessage(FHandle, TTM_SETDELAYTIME, TTDT_INITIAL, FShowDelayTimeMS); if FMaxWidth > 0 then SendMessage(FHandle, TTM_SETMAXTIPWIDTH, 0, FMaxWidth); if (Parent <> nil) and Parent.GetInterface(IGMUiArea, PIParent) and PIParent.Visible then SendMessage(FHandle, TTM_ADDTOOL, 0, LPARAM(@HintData)); // Subclassing the hintwindow would need relay parent GMMessages to it. // This in turn needs to subclass the parent window too. // Since WM_NOTIFY GMMessages are send via GMCallObjWndProc subclassing is not relly needed here. //FOrgWndProc := Pointer(SetWindowLongPtr(FHandle, GWL_WNDPROC, PtrInt(@GMStdWndProc))); end; { ---------------------------- } { ---- TGMHintToolBtnArea ---- } { ---------------------------- } constructor TGMHintToolBtnArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AOnClick: TGMObjNotifyProc; const AText: TGMString; const AImgIdx: Integer; const AImgList: IUnknown; const AHintTitle, AHintText: TGMString; const ABkgndColor: COLORREF; // , AFrameColor const ATextSide: TEdge; const AHAlignment: TGMHorizontalAlignment; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, AOnClick, AText, AImgIdx, AImgList, ABkgndColor, ATextSide, AHAlignment, clrWindowText, AVisible, ARefLifeTime); if (AHintTitle <> '') or (AHintText <> '') then OwnArea(TGMHintWindow.Create(-Int64(Self), cNullRect, cClientAligned, AHintText, AHintTitle)); end; procedure TGMHintToolBtnArea.AssignImage; var himgList: IGMGetHandle; begin // NOTE: dont call queryinterface when FImageIdx >= cImgIdxHigh it may contain an invalid memory location -> see inherited method! if (FIcon = 0) and (FImageIdx <= cImgIdxHigh) and GMQueryInterface(FImageList, IGMGetHandle, himgList) then begin FIcon := ImageList_GetIcon(himgList.Handle, FImageIdx, ILD_NORMAL); // ILD_TRANSPARENT ImageList_GetIconSize(himgList.Handle, FImageSize.x, FImageSize.y); FFreeIcon := True; end else inherited; end; { ------------------------------- } { ---- TGMTrackingHintWindow ---- } { ------------------------------- } constructor TGMTrackingHintWindow.Create(const AParent: TGMWndObj; const ARect: TRect; const AAreaAlign: TGMAreaAlignRec; AText, ATitle: TGMString; const AMaxWidth, AIcon: Integer; const AWndStyle, AWndExStyle: DWORD; const ARefLifeTime: Boolean); begin inherited Create(AParent, ARect, AAreaAlign, AText, ATitle, 0, AMaxWidth, AIcon, 0, AWndStyle, AWndExStyle, ARefLifeTime); end; {procedure TGMTrackingHintWindow.WMClose(var Msg: TMessage); begin inherited; end;} {procedure TGMTrackingHintWindow.WMShowWindow(var Msg: TMessage); begin inherited; end;} function TGMTrackingHintWindow.BuildHintData(const IdOnly: Boolean): TToolInfo; begin Result := inherited BuildHintData(IdOnly); if not IdOnly then Result.uFlags := TTF_TRACK; end; function TGMTrackingHintWindow.ParticipateInLayouting: Boolean; begin Result := False; end; procedure TGMTrackingHintWindow.ShowAt(const ScreenPos: TPoint); var HintData: TToolInfo; begin //if not HandleAllocated then Exit; GMSendObjMessage(Self, TTM_TRACKPOSITION, 0, MakeLong(ScreenPos.x, ScreenPos.y)); if not FShowing then begin HintData := BuildHintData(True); GMSendObjMessage(Self, TTM_TRACKACTIVATE, 1, LPARAM(@HintData)); FShowing := True; end; end; procedure TGMTrackingHintWindow.Hide; var HintData: TToolInfo; begin if FShowing then begin HintData := BuildHintData(True); GMSendObjMessage(Self, TTM_TRACKACTIVATE, 0, LPARAM(@HintData)); FShowing := False; end; end; { ------------------------ } { ---- TGMProgressBar ---- } { ------------------------ } constructor TGMProgressBar.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); FMax := 100; end; {constructor TGMProgressBar.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AWndStyle, AWndExStyle: DWORD; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, '', AWndStyle, AWndExStyle, ABkgndColor, ARefLifeTime); end;} function TGMProgressBar.RegisterWndClass: TGMString; begin GMInitComCtl32Dll(ICC_PROGRESS_CLASS); Result := PROGRESS_CLASS; end; procedure TGMProgressBar.InternalCreateHandle; begin //if HandleAllocated then begin inherited CreateHandle; Exit; end else inherited CreateHandle; inherited; SendMessage(FHandle, PBM_SETBKCOLOR, 0, LPARAM(GMRGBColor(BkgndColor))); Min := FMin; Max := FMax; Pos := FPos; //SendMessage(Handle, PBM_SETBARCOLOR, 0, LPARAM(GMRGBColor(BkgndColor))); end; procedure TGMProgressBar.UMHandleCreated(var Msg: TMessage); begin if Visible then GMPaintWndFrame(-Int64(Self)); FPassMessageToOriginalHandler := False; end; function TGMProgressBar.GetMax: LongInt; begin //if not HandleAllocated then Result := 0 else Result := SendMessage(FHandle, PBM_GETRANGE, 0, 0); Result := FMax; end; function TGMProgressBar.GetMin: LongInt; begin //if not HandleAllocated then Result := 0 else Result := SendMessage(FHandle, PBM_GETRANGE, 1, 0); Result := FMin; end; function TGMProgressBar.GetPos: LongInt; begin //if not HandleAllocated then Result := 0 else Result := SendMessage(FHandle, PBM_GETPOS, 0, 0); Result := FPos; end; procedure TGMProgressBar.SetMax(const AValue: LongInt); begin if not HandleAllocated then begin FMax := GMCommon.Max(FMin+1, AValue); FPos := GMBoundedInt(FPos, FMin, FMax); end else begin SendMessage(FHandle, PBM_SETRANGE32, FMin, AValue); FMax := SendMessage(FHandle, PBM_GETRANGE, 0, 0); end; end; procedure TGMProgressBar.SetMin(const AValue: LongInt); begin if not HandleAllocated then begin FMin := GMCommon.Min(FMax-1, AValue); FPos := GMBoundedInt(FPos, FMin, FMax); end else begin SendMessage(FHandle, PBM_SETRANGE32, AValue, FMax); FMin := SendMessage(FHandle, PBM_GETRANGE, 1, 0); end; end; procedure TGMProgressBar.SetPos(const AValue: LongInt); begin //if not HandleAllocated then FPos := GMBoundedInt(AValue, FMin, FMax) else // begin // SendMessage(FHandle, PBM_SETPOS, AValue, 0); // FPos := SendMessage(FHandle, PBM_GETPOS, 0, 0); // end; if HandleAllocated then SendMessage(FHandle, PBM_SETPOS, AValue, 0); FPos := GMBoundedInt(AValue, FMin, FMax); end; procedure TGMProgressBar.WMPaint(var Msg: TWMPaint); var windowDC: IGMGetHandle; font: IUnknown; percxentTxt: TGMString; range: LongInt; q: double; rDraw: Trect; textSize: TPoint; begin FPassMessageToOriginalHandler := False; // <- dont call FOrgWndProc again Msg.Result := CallWindowProc(FOrgWndProc, FHandle, Msg.Msg, Msg.DC, Msg.Unused); // <- call WM_Paint of windows control windowDC := TGMWindowDC.Create(FHandle); font := TGMGdiFont.Create(windowDC.Handle, dfUIFont, True); SetBkMode(windowDC.Handle, TRANSPARENT); range := Max - Min; if range = 0 then q := 0 else q := (Pos - Min) * 100 / range; percxentTxt := GMFormat('%.1f %%', [q]); GetTextExtentPoint32(windowDC.Handle, PGMChar(percxentTxt), Length(percxentTxt), TSize(textSize)); rDraw := GMCenterExtentInRect(textSize, PaintingRect); TextOut(windowDC.Handle, rDraw.Left, rDraw.Top, PGMChar(percxentTxt), Length(percxentTxt)); end; //procedure TGMProgressBar.WMPaint(var Msg: TWMPaint); //var DC: HDC; PS: TPaintStruct; txt: TGMstring; //begin //try // // // // There will be no painting possible after EndPaint. Whoever gets the ADC first must pass it on. // // Handlers must be prepared for ADC = 0. Chained Handlers must be called before EndPaint. // // // Msg.Result := CallWindowProc(FOrgWndProc, FHandle, Msg.Msg, Msg.DC, Msg.Unused); // // // // DC := Msg.DC; // if DC = 0 then DC := BeginPaint(Handle, PS); // GMAPICheckObj('BeginPaint', '', GetLastError, DC <> 0, Self); // try // inherited; // txt := 'Hallo'; // TextOut(DC, 0, 0, PGMChar(txt), Length(txt)); // //if PS.fErase then Exit; //// if not Paint(DC) and (FOrgWndProc <> nil) then {Msg.Result :=} CallWindowProc(FOrgWndProc, FHandle, Msg.Msg, WPARAM(DC), 0); // finally // if Msg.DC = 0 then EndPaint(Handle, PS); //// Msg.Result := 0; // <- we handled it // end; //except // GMTraceException(GMExceptObject); // <- Never raise exceptions while painting! //end; //FPassMessageToOriginalHandler := False; // <- dont call FOrgWndProc in WindowProc after EndPaint //end; { --------------------- } { ---- TGMCalendar ---- } { --------------------- } {constructor TGMCalendar.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AWndStyle, AWndExStyle: DWORD; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, '', AWndStyle, AWndExStyle, ABkgndColor, ARefLifeTime); end;} function TGMCalendar.RegisterWndClass: TGMString; begin GMInitComCtl32Dll(ICC_DATE_CLASSES); Result := MONTHCAL_CLASS; end; function TGMCalendar.CalculateHeight(const NewSize: TPoint): LongInt; var R: TRect; begin if not HandleAllocated or (SendMessage(FHandle, MCM_GETMINREQRECT, 0, LPARAM(@R)) = 0) then Result := inherited CalculateHeight(NewSize) else Result := GMRectSize(R).y; end; function TGMCalendar.CalculateWidth(const NewSize: TPoint): LongInt; var R: TRect; begin if not HandleAllocated or (SendMessage(FHandle, MCM_GETMINREQRECT, 0, LPARAM(@R)) = 0) then Result := inherited CalculateHeight(NewSize) else Result := GMRectSize(R).x; end; { ------------------------- } { ---- TGMDateTimeEdit ---- } { ------------------------- } constructor TGMDateTimeEdit.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString; const AWndStyle, AWndExStyle: DWORD; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, '', AWndStyle, AWndExStyle, ABkgndColor, ARefLifeTime); FInputFormat := AText; end; procedure TGMDateTimeEdit.InternalCreateHandle; begin inherited InternalCreateHandle; if FInputFormat <> '' then GMSendObjMessage(Self, DTM_SETFORMAT, 0, LPARAM(PGMChar(FInputFormat))); end; function TGMDateTimeEdit.RegisterWndClass: TGMString; begin GMInitComCtl32Dll(ICC_DATE_CLASSES); Result := DATETIMEPICK_CLASS; end; procedure TGMDateTimeEdit.SetInputGMFormat(const AInputFormat: TGMString); // See: http://msdn.microsoft.com/en-us/library/aa921603.aspx for help on input format Strings begin if AInputFormat = FInputFormat then Exit; GMSendObjMessage(Self, DTM_SETFORMAT, 0, LPARAM(PGMChar(AInputFormat))); FInputFormat := AInputFormat; end; procedure TGMDateTimeEdit.SetInputRange(const MinValue, MaxValue: TDateTime); type TTimeRange = (trMin, trMax); var TimeRange: array [TTimeRange] of TSystemTime; Flags: LongInt; begin FillByte(TimeRange, SizeOf(TimeRange), 0); Flags := 0; if MinValue <> cInvalidInputDate then begin Flags := Flags or GDTR_MIN; DateTimeToSystemTime(MinValue, TimeRange[trMin]); end; if MaxValue <> cInvalidInputDate then begin Flags := Flags or GDTR_MAX; DateTimeToSystemTime(MaxValue, TimeRange[trMax]); end; if Flags <> 0 then GMSendObjMessage(Self, DTM_SETRANGE, Flags, LPARAM(@TimeRange)); end; function TGMDateTimeEdit.GetValue: TDateTime; var SysTime: TSystemTime; begin if not HandleAllocated then Result := cInvalidInputDate else begin if GMSendObjMessage(Self, DTM_GETSYSTEMTIME, 0, LPARAM(@SysTime)) = GDT_NONE then Result := cInputDateNone else Result := SystemTimeToDateTime(SysTime); end; end; procedure TGMDateTimeEdit.SetValue(const AValue: TDateTime); var SysTime: TSystemTime; begin if AValue = cInputDateNone then begin FillByte(SysTime, SizeOf(SysTime), 0); GMSendObjMessage(Self, DTM_SETSYSTEMTIME, GDT_NONE, LPARAM(@SysTime)); end else begin DateTimeToSystemTime(AValue, SysTime); GMSendObjMessage(Self, DTM_SETSYSTEMTIME, GDT_VALID, LPARAM(@SysTime)); end; end; { ------------------------ } { ---- TGMPageControl ---- } { ------------------------ } constructor TGMPageControl.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); ContainedAreas.OnAfterAddItem := OnChildAreaAdded; ContainedAreas.OnBeforeRemoveItem := OnContainedAreaRemoved; end; procedure TGMPageControl.OnChildAreaAdded(const ASender, AChlidArea: TObject; const AIndex: PtrInt); var NewPage: TTCItem; Title: TGMString; begin if not HandleAllocated or (AChlidArea = nil) then Exit; Title := GMGetObjText(AChlidArea); if Title = '' then Title := GMGetObjName(AChlidArea); NewPage := TCItemRec(0, Title, GMAskInteger(AChlidArea, Ord(ivImageIndex), cUnkImgIdx)); SendMessage(FHandle, TCM_INSERTITEM, AIndex, LPARAM(@NewPage)); LayoutContainedAreas(False); //PostMessage(FHandle, UM_CREATECILDHANDLE, WPARAM(AChlidArea), 0); end; procedure TGMPageControl.OnContainedAreaRemoved(const ASender, AChlidArea: TObject; const AIndex: PtrInt); begin if not HandleAllocated then Exit; SendMessage(FHandle, TCM_DELETEITEM, AIndex, 0); //LayoutContainedAreas(False); end; function TGMPageControl.RegisterWndClass: TGMString; begin GMInitComCtl32Dll(ICC_TAB_CLASSES); Result := WC_TABCONTROL; end; //procedure TGMPageControl.UMCreateChildHandle(var Msg: TMessage); //var PIHandle: IGMGetHandle; //begin // if (Msg.WParam <> 0) and TObject(Msg.WParam).GetInterface(IGMGetHandle, PIHandle) then PIHandle.Handle; //end; //procedure TGMPageControl.AddPageTab(const PageIdx: Integer); //var NewPage: TTCItem; //begin // if not HandleAllocated then Exit; // NewPage := TCItemRec(0, GMGetObjText(ContainedAreas.Last), GMAskInteger(ContainedAreas.Last, Ord(ivImageIndex), cUnkImgIdx)); // SendMessage(FHandle, TCM_INSERTITEM, PageIdx, LPARAM(@NewPage)); // LayoutContainedAreas(False); //end; //function TGMPageControl.AddPage(const Area: TObject; const ImgIdx: LongInt; const AddToOwned: Boolean): TObject; //begin // Result := Area; // SetLength(FPages, Length(FPages)+1); // FPages[High(FPages)].Page := Area; // FPages[High(FPages)].ImgIdx := ImgIdx; // if AddToOwned and (Area <> nil) then OwnArea(Area); // if not HandleAllocated then Exit; // AddPageTab(High(FPages), ImgIdx); // SelectedPageIdx := High(FPages); //end; // //procedure TGMPageControl.RemovePage(const Area: TObject); //var i, PageIdx: LongInt; //begin // PageIdx := -1; // for i:=Low(FPages) to High(FPages) do if FPages[i].Page = Area then begin PageIdx := i; Break; end; // if PageIdx < 0 then Exit; // for i:=PageIdx to High(FPages)-1 do FPages[i] := FPages[i+1]; // SetLength(FPages, Length(FPages)-1); // // ContainedAreas.Remove(Area); // OwnedAreas.Remove(Area); // // if HandleAllocated then SendMessage(FHandle, TCM_DELETEITEM, PageIdx, 0); // LayoutContainedAreas(True); //end; procedure TGMPageControl.InternalCreateHandle; var i: Integer; begin //if HandleAllocated then begin inherited CreateHandle; Exit; end else inherited CreateHandle; inherited; //if FImageList <> 0 then GMSendObjMessage(Self, TCM_SETIMAGELIST, 0, LPARAM(FImageList)); for i:=0 to ContainedAreas.Count-1 do OnChildAreaAdded(Self, ContainedAreas[i], i); // AddPageTab(i); end; procedure TGMPageControl.RemoveAllPages; var i: Integer; begin for i:=0 to ContainedAreas.Count-1 do OwnedAreas.RemoveByKey(GMObjAsIntf(ContainedAreas[i])); // <- will free page, wich eill in turn remove it from ContainedAreas //for i:=Low(FPages) to High(FPages) do OwnedAreas.Remove(FPages[i].Page); // <- will free page! //SetLength(FPages, 0); //ContainedAreas.Clear; //OwnedAreas.Clear; //if HandleAllocated then SendMessage(FHandle, TCM_DELETEALLITEMS, 0, 0); end; procedure TGMPageControl.LoadData(const Source: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); var i: Integer; PILoad: IGMLoadStoreData; begin for i:=0 to ContainedAreas.Count-1 do if GMGetInterface(ContainedAreas[i], IGMLoadStoreData, PILoad) then PILoad.LoadData(Source, ACryptCtrlData); end; procedure TGMPageControl.StoreData(const Dest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); var i: Integer; PIStore: IGMLoadStoreData; begin for i:=0 to ContainedAreas.Count-1 do if GMGetInterface(ContainedAreas[i], IGMLoadStoreData, PIStore) then PIStore.StoreData(Dest, ACryptCtrlData); end; procedure TGMPageControl.InternalSetVisible(const Value: Boolean); begin inherited; ShowSelectedPage; end; procedure TGMPageControl.ShowSelectedPage; var i: Integer; PIArea: IGMUiArea; // PIHandle: IGMGetHandle; begin for i:=0 to ContainedAreas.Count-1 do if GMGetInterface(ContainedAreas[i], IGMUiArea, PIArea) then PIArea.SetVisible(i = ActivePageIdx); if Assigned(OnPageChanged) then OnPageChanged(Self); end; function TGMPageControl.GetActivePageIdx: LongInt; begin if not HandleAllocated then Result := -1 else Result := SendMessage(FHandle, TCM_GETCURSEL, 0, 0); end; procedure TGMPageControl.SetActivePageIdx(const Value: Integer); begin if {(Length(FPages) = 0) or} not HandleAllocated then Exit; SendMessage(FHandle, TCM_SETCURSEL, GMBoundedInt(Value, -1, ContainedAreas.Count-1), 0); ShowSelectedPage; end; function TGMPageControl.GetActivePage: TObject; begin if ContainedAreas.IsEmpty then Result := nil else Result := ContainedAreas[ActivePageIdx]; end; procedure TGMPageControl.SetActivePage(const Value: TObject); var i: Integer; begin if Value = nil then ActivePageIdx := -1 else //for i:=Low(FPages) to High(FPages) do if FPages[i].Page = Value then begin SelectedPageIdx := i; Break; end; for i:=0 to ContainedAreas.Count-1 do if ContainedAreas[i] = Value then begin ActivePageIdx := i; Break; end; end; {function TGMPageControl.GetPage(const Idx: LongInt): TObject; begin Result := FPages[Idx].Page; end; function TGMPageControl.PageCount: LongInt; begin Result := Length(FPages); end;} procedure TGMPageControl.AdjustClientRect(var ARect: TRect); begin if not HandleAllocated then Exit; TabCtrl_AdjustRect(FHandle, False, {$IFNDEF XYZ}@{$ENDIF}ARect); with ClientAdjustRect do ARect := GMRect(ARect.Left + Left, ARect.Top + Top, ARect.Right + Right, ARect.Bottom + Bottom); end; function TGMPageControl.ClientAreaOrigin: TPoint; var R: TRect; begin if not HandleAllocated then Result := inherited ClientAreaOrigin else begin GetClientRect(FHandle, R); AdjustClientRect(R); Result := R.TopLeft; end; end; function TGMPageControl.ClientAreaSize: TPoint; var R: TRect; begin if not HandleAllocated then Result := inherited ClientAreaSize else begin GetClientRect(FHandle, R); AdjustClientRect(R); Result := GMRectSize(R); end; end; procedure TGMPageControl.WMAppNotify(var Msg: TWMNotify); begin inherited; case Integer(Msg.NMHdr.code) of TCN_SELCHANGE: ShowSelectedPage; end; end; procedure TGMPageControl.WMEraseBkgnd(var Msg: TWMEraseBkgnd); var R: TRect; DCState: LongInt; // DCState: IUnknown; begin //DCState := TGMGdiDCStateKeeper.Create(Msg.ADC); //if not (SelectedPage is TGMWindow) then begin inherited; Exit; end; DCState := SaveDC(Msg.DC); try GetClientRect(FHandle, R); AdjustClientRect(R); ExcludeClipRect(Msg.DC, R.Left, R.Top, R.Right, R.Bottom); CallWindowProc(FOrgWndProc, FHandle, Msg.Msg, WPARAM(Msg.DC), Msg.Unused); finally RestoreDC(Msg.DC, DCState); end; FPassMessageToOriginalHandler := False; // <- do this after CallWindowProc Msg.Result := 1; // <- do this after CallWindowProc end; { -------------------------- } { ---- TGMScrollButtons ---- } { -------------------------- } constructor TGMScrollButtons.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AWndStyle, AWndExStyle: DWORD; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, '', AWndStyle, AWndExStyle, ABkgndColor, ARefLifeTime); end; function TGMScrollButtons.RegisterWndClass: TGMString; begin GMInitComCtl32Dll(ICC_UPDOWN_CLASS); Result := UPDOWN_CLASS; end; procedure TGMScrollButtons.WMEraseBkgnd(var Msg: TWMEraseBkgnd); begin FPassMessageToOriginalHandler := False; end; { -------------------- } { ---- TGMIntEdit ---- } { -------------------- } constructor TGMIntEdit.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); FEnabled := cDfltEnabled; end; constructor TGMIntEdit.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AMinValue: LongInt; const AMaxValue: LongInt; const ABkgndColor: COLORREF; const AVisible: Boolean; const ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, ABkgndColor, AVisible, ARefLifeTime); FEditor := OwnArea(TGMFramedEdit.Create(-Int64(Self), cNullRect, cClientAligned, '', cVisibleTabstop or ES_NUMBER or ES_RIGHT)) as TGMFramedEdit; FEditor.OnBeforeTextChange := OnEditTextChange; FScrollBtns := OwnArea(TGMScrollButtons.Create(-Int64(Self), GMRect(-GetSystemMetrics(SM_CXVSCROLL), 0, 0, 0), cRightAligned, WS_VISIBLE or UDS_SETBUDDYINT or UDS_ARROWKEYS or UDS_HOTTRACK or UDS_NOTHOUSANDS)) as TGMScrollButtons; FMinValue := AMinValue; FMaxValue := AMaxValue; FEditor.Text := GMIntToStr(AMinValue); end; procedure TGMIntEdit.CreateHandle; begin if FEditor.HandleAllocated then inherited CreateHandle else begin inherited CreateHandle; GMSendObjMessage(FEditor, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, MakeLongInt(2, 3)); GMSendObjMessage(FScrollBtns, UDM_SETBUDDY, FEditor.Handle, 0); GMSendObjMessage(FScrollBtns, UDM_SETRANGE32, FMinValue, FMaxValue); //GMSendObjMessage(FScrollBtns, UDM_SETPOS32, 0, Value); end; end; function TGMIntEdit.PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; var Pen: IUnknown; Y: LongInt; begin Pen := TGMGdiPen.Create(ADC, clWhite); // BkgndColor Y := (RSurface.Top + RSurface.Bottom) div 2; MoveToEx(ADC, RSurface.Right - GMRectSize(FScrollBtns.LayoutBounds).x, Y, nil); LineTo(ADC, RSurface.Right, Y); Result := inherited PaintArea(ADC, RSurface); end; procedure TGMIntEdit.Clear(const ANotify: Boolean); begin inherited Clear(ANotify); Value := 0; end; //function TGMIntEdit.ExecuteOperation(const Operation: Integer; const Parameter: IUnknown): Boolean; //begin // case Operation of // Ord(opClear): begin Value := 0; Result := True; end; // else Result := inherited ExecuteOperation(Operation, Parameter); // end; //end; function TGMIntEdit.GetValue: LongInt; begin Result := GMStrToInt(GMMakeDezInt(FEditor.Text)); end; procedure TGMIntEdit.SetValue(const AValue: LongInt); begin if FScrollBtns.HandleAllocated then SendMessage(FScrollBtns.FHandle, UDM_SETPOS32, 0, AValue); //else FEditor.Text := IntToStr(AValue); // <- will set FCreateData.Text if not HandleAllocated end; function TGMIntEdit.GetEnabled: Boolean; begin Result := FEnabled; end; procedure TGMIntEdit.SetEnabled(const AEnabled: Boolean); stdcall; begin //if AEnabled = FEnabled then Exit; FEnabled := AEnabled; FEditor.SetEnabled(AEnabled); FScrollBtns.SetEnabled(AEnabled); //GMEnableWindow(FEdit, FEnabled); //GMEnableWindow(FScrollBtns, FEnabled); end; procedure TGMIntEdit.OnEditTextChange(const Sender: TObject); begin GMSendObjMessage(FScrollBtns, UDM_SETPOS32, 0, Value); if Assigned(OnAfterValueChange) then OnAfterValueChange(Self); end; { --------------------- } { ---- TGMTrackBar ---- } { --------------------- } constructor TGMTrackBar.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AMin, AMax, APos: LongInt; const AOnPosChange: TOnPosChangeProc; const AWndStyle, AWndExStyle: DWORD; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, '', AWndStyle, AWndExStyle, ABkgndColor, ARefLifeTime); FOnPosChange := AOnPosChange; FMin := AMin; FMax := AMax; FPos := APos; FStartPos := APos; end; procedure TGMTrackBar.InternalCreateHandle; begin //if HandleAllocated then begin inherited CreateHandle; Exit; end else inherited CreateHandle; inherited; SendMessage(FHandle, TBM_SETRANGE, 1, MakeLongInt(FMin, FMax)); SendMessage(FHandle, TBM_SETPOS, 1, FPos); end; function TGMTrackBar.GetPosition: LongInt; begin Result := SendMessage(FHandle, TBM_GETPOS, 0, 0); end; function TGMTrackBar.GetMinVal: LongInt; begin Result := SendMessage(FHandle, TBM_GETRANGEMIN, 0, 0); end; function TGMTrackBar.GetMaxVal: LongInt; begin Result := SendMessage(FHandle, TBM_GETRANGEMAX, 0, 0); end; procedure TGMTrackBar.SetMinVal(const Value: Integer); begin SendMessage(FHandle, TBM_SETRANGEMIN, 1, Value); end; procedure TGMTrackBar.SetMaxVal(const Value: Integer); begin SendMessage(FHandle, TBM_SETRANGEMAX, 1, Value); end; procedure TGMTrackBar.SetPosition(const Value: Integer); begin SendMessage(FHandle, TBM_SETPOS, 1, Value); end; function TGMTrackBar.RegisterWndClass: TGMString; begin GMInitComCtl32Dll(ICC_BAR_CLASSES); Result := TRACKBAR_CLASS; end; procedure TGMTrackBar.WMAppHScroll(var Msg: TWMScroll); begin if Assigned(FOnPosChange) then FOnPosChange(Msg.ScrollCode, SendMessage(FHandle, TBM_GETPOS, 0, 0)); // Msg.Pos end; procedure TGMTrackBar.WMAppVScroll(var Msg: TWMScroll); begin if Assigned(FOnPosChange) then FOnPosChange(Msg.ScrollCode, SendMessage(FHandle, TBM_GETPOS, 0, 0)); // Msg.Pos end; { ------------------------ } { ---- TGMPageTabArea ---- } { ------------------------ } constructor TGMPageTabArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ATitle: TGMString; const APageArea: TObject; const AShowCloseBtn: Boolean; const AImageIdx: Integer; //const ABkgndColor: COLORREF; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, clrTransparent, AVisible, ARefLifeTime); FPageArea := APageArea; FTitle := ATitle; AssignTitle; if AImageIdx = cUnkImgIdx then FImageIdx := GMAskInteger(APageArea, Ord(ivImageIndex), cImgIdxNone) else FImageIdx := AImageIdx; GMCheckFindParentObj(Self, TGMPageTabs, FPageTabs); if AShowCloseBtn then FCloseBtn := OwnArea(TGMxCloseBtnArea.Create(Self, GMRect(-cPageTabCloseBtnSize.x, cPageTabCloseBtnSpace.y, cPageTabCloseBtnSpace.x, cPageTabCloseBtnSize.y), cTopRightCorner, OnCloseBtnClick)) as TGMxButtonArea; end; procedure TGMPageTabArea.AssignTitle; var PIHint: IGMGetHint; begin if Length(FTitle) <= 0 then begin FTitle := GMGetObjText(PageArea); if Length(FTitle) <= 0 then FTitle := GMGetObjName(PageArea); if Length(FTitle) <= 0 then FTitle := cStrUnknownPageTitle; end; FTitle := GMResolveTextResData(FTitle, FTitleResStrPtr); if (FHintWindow = nil) and (PageArea <> nil) and (PageArea.GetInterface(IGMGetHint, PIHint)) and (PIHint.Hint <> '') then FHintWindow := OwnArea(TGMHintWindow.Create(-Int64(Self), cNullRect, cClientaligned, PIHint.Hint, FTitle)); end; procedure TGMPageTabArea.LanguageChanged(const ANewLanguage: LParam); begin FTitle := GMBuildTextFromResRef(FTitleResStrPtr, FTitle); AssignTitle; end; function TGMPageTabArea.InternalCalcWidth(const NewSize: TPoint): LongInt; var Font: IUnknown; ImgSz: TPoint; MemDC: IGMGetHandle; begin //AssignTitle; //threadSync := TGMCriticalSectionLock.Create(UICalcMemDC); MemDC := TGMGdiCompatibleDC.Create(0, 0, True); Font := TGMGdiObjSelector.Create(MemDC.Handle, FontHandle); Result := GMMultiLineTextSize(MemDC.Handle, FTitle, GMRect(0, 0, NewSize.x, NewSize.y), cPageTabDrawFlags).x + (2 * cTabSpace); if (PageTabs.FImageList <> nil) and GMIsInRange(FImageIdx, 0, ImageList_GetImageCount(PageTabs.FImageList.Handle)) and ImageList_GetIconSize(PageTabs.FImageList.Handle, ImgSz.x, ImgSz.y) then Inc(Result, ImgSz.x + cTabSpace); if FCloseBtn <> nil then Inc(Result, cPageTabCloseBtnSize.x + cPageTabCloseBtnSpace.x - 2); // FCloseBtn.CalculateWidth(cNullPoint) end; function TGMPageTabArea.InternalCalcHeight(const NewSize: TPoint): LongInt; const cInActiveDec: array [Boolean] of LongInt = (-2, 0); var Font: IUnknown; MemDC: IGMGetHandle; //y: LongInt; begin //AssignTitle; //threadSync := TGMCriticalSectionLock.Create(UICalcMemDC); MemDC := TGMGdiCompatibleDC.Create(0, 0, True); Font := TGMGdiObjSelector.Create(MemDC.Handle, FontHandle); //y := GMMultiLineTextSize(MemDC.Handle, FTitle, GMRect(0, 0, NewSize.x, NewSize.y), cPageTabDrawFlags).y; Result := GMMultiLineTextSize(MemDC.Handle, FTitle, GMRect(0, 0, NewSize.x, NewSize.y), cPageTabDrawFlags).y + 10 + cInActiveDec[IsActiveTab or MouseIsOverTab]; end; {function TGMPageTabArea.MouseInside: Boolean; begin Result := inherited MouseInside or ((FCloseBtn <> nil) and FCloseBtn.MouseInside); end;} procedure TGMPageTabArea.OnCloseBtnClick(const Sender: TObject); begin PageTabs.RemovePage(PageArea); end; function TGMPageTabArea.MouseIsOverTab: Boolean; begin Result := MouseInside or ((FCloseBtn <> nil) and FCloseBtn.MouseInside); end; procedure TGMPageTabArea.WMSetCursor(var Msg: TWMSetCursor); begin inherited; SetCursor(LoadCursor(0, Pointer(IDC_HAND))); Msg.Result := 1; end; procedure TGMPageTabArea.WMMouseEnter(var Msg: TWMMouse); begin inherited; //ScheduleRepaint; GMRelayoutContainedAreas(Parent); end; procedure TGMPageTabArea.WMMouseLeave(var Msg: TWMMouse); begin inherited; //ScheduleRepaint; GMRelayoutContainedAreas(Parent); end; function TGMPageTabArea.IsActiveTab: Boolean; begin //with PageTabs do // not TabArea.ContainedAreas.IsEmpty Result := //(PageTabs <> nil) and (PageTabs.TabsArea <> nil) and PageTabs.TabsArea.ContainedAreas.IsValidIndex(PageTabs.ActivePageIdx) and (PageTabs.TabsArea.ContainedAreas[PageTabs.ActivePageIdx] = Self); end; function TGMPageTabArea.FontHandle: THandle; begin if IsActiveTab or MouseIsOverTab then Result := GMBoldUIFont else Result := inherited FontHandle; end; function TGMPageTabArea.FontColor: COLORREF; begin if not MouseIsOverTab then Result := inherited FontColor else if IsActiveTab then Result := clBlue else Result := clrOrange; end; function TGMPageTabArea.PaintsComplete: Boolean; begin Result := True; end; procedure TGMPageTabArea.WMLButtonDown(var Msg: TWMLButtonDown); begin inherited; PageTabs.ActivePageIdx := PageTabs.TabsArea.ContainedAreas.IndexOfObj(Self); end; {procedure TGMPageTabArea.WMLButtonUp(var Msg: TWMLButtonUp); begin inherited; end; procedure TGMPageTabArea.WMMouseMove(var Msg: TWMMouseMove); begin inherited; end;} function TGMPageTabArea.CreateAreaRegion(const ABoundingRect: TRect; const ARegionKind: TGMAreaRegionKind): IGMGetHandle; var Points: array [0..5] of TPoint; begin with ABoundingRect do begin Points[0] := GMPoint(Left, Bottom); Points[1] := GMPoint(Left, Top+2); Points[2] := GMPoint(Left+2, Top); Points[3] := GMPoint(Right-2, Top); Points[4] := GMPoint(Right, Top+2); Points[5] := GMPoint(Right, Bottom); end; Result := TGMGdiRegion.CreatePolygon(0, Points); end; function TGMPageTabArea.PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; //const cShrinkY = 2; var FrameColor: COLORREF; RTab: TRect; Pen: IGMGetHandle; FillColor: COLORREF; ActiveTab: Boolean; ImgSz: TPoint; begin Result := inherited PaintArea(ADC, RSurface); ActiveTab := IsActiveTab; if ActiveTab then FillColor := clrGlassBlue else FillColor := GMRGBColor(cDfltColor); FrameColor := GMFrameColorFromBkgndColor(FillColor); Pen := TGMGdiPen.Create(ADC, FrameColor); RTab := RSurface; MoveToEx(ADC, RTab.Left, RTab.Bottom-1, nil); LineTo(ADC, RTab.Left, RTab.Top+1); MoveToEx(ADC, RTab.Left+2, RTab.Top, nil); LineTo(ADC, RTab.Right-2, RTab.Top); MoveToEx(ADC, RTab.Right-1, RTab.Top+2, nil); LineTo(ADC, RTab.Right-1, RTab.Bottom); if not ActiveTab then begin Pen := nil; if MouseIsOverTab then Pen := TGMGdiPen.Create(ADC, clRed) else Pen := TGMGdiPen.Create(ADC, FrameColor); // clDfltHoverFrameColor MoveToEx(ADC, RTab.Left, RTab.Bottom-1, nil); LineTo(ADC, RTab.Right, RTab.Bottom-1); Dec(RTab.Bottom); end; with RTab do RTab := GMRect(Left+1, Top+1, Right-1, Bottom); if MouseIsOverTab then FillColor := GMChangeColorLightness(FillColor, 100); GMGlassFillRectSimple(ADC, RTab, FillColor); Pen := nil; Pen := TGMGdiPen.Create(ADC, FrameColor); MoveToEx(ADC, RSurface.Left, RSurface.Top+2, nil); LineTo(ADC, RSurface.Left+2, RSurface.Top); MoveToEx(ADC, RSurface.Right-3, RSurface.Top, nil); LineTo(ADC, RSurface.Right-1, RSurface.Top+2); if (PageTabs.FImageList <> nil) and GMIsInRange(FImageIdx, 0, ImageList_GetImageCount(PageTabs.FImageList.Handle)) and ImageList_GetIconSize(PageTabs.FImageList.Handle, ImgSz.x, ImgSz.y) then begin ImageList_Draw(PageTabs.FImageList.Handle, FImageIdx, ADC, RTab.Left + cTabSpace, RTab.Top + (RTab.Bottom - RTab.Top - ImgSz.y + 1) div 2, ILD_NORMAL); Inc(RTab.Left, ImgSz.x + cTabSpace); end; if FCloseBtn <> nil then Dec(RTab.Right, cPageTabCloseBtnSize.x); // FCloseBtn.CalculateWidth(cNullPoint) GMDrawText(ADC, FTitle, RTab, haCenter, vaCenter, cPageTabDrawFlags or DT_WORD_ELLIPSIS); end; { ------------------------------- } { ---- TGMPageTabsChevronBtn ---- } { ------------------------------- } constructor TGMPageTabsChevronBtn.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ABkgndColor: COLORREF; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, ABkgndColor, AVisible, ARefLifeTime); GMcheckfindParentObj(Self, TGMPageTabs, FPageTabs); end; function TGMPageTabsChevronBtn.Direction: TGM2DDirection; begin Result := d2dHorizontal; end; { ----------------------------- } { ---- TGMBoundingTabsArea ---- } { ----------------------------- } function TGMBoundingTabsArea.HBkgndBrush: THandle; begin Result := GMDitheredBrush; end; function TGMBoundingTabsArea.PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; var Pen: IGMGetHandle; begin Result := inherited PaintArea(ADC, RSurface); Pen := TGMGdiPen.Create(ADC, GMFrameColorFromBkgndColor(BkgndColor)); // clDfltHoverFrameColor MoveToEx(ADC, RSurface.Left, RSurface.Bottom-1, nil); LineTo(ADC, RSurface.Right, RSurface.Bottom-1); end; function TGMBoundingTabsArea.FontColor: COLORREF; begin Result := cDitherGray; // GMChangeColorLightness(clSilver, 120); clSilver; clDkGray end; function TGMBoundingTabsArea.BkgndColor: COLORREF; begin Result := clWhite; // inherited BkgndColor;clSilver; end; procedure TGMBoundingTabsArea.LayoutContainedAreas(const ARepaint: Boolean); // : TPoint; const cTabReCalcSz: TPoint = (x: 2; y: 2); var i, wAll: LongInt; area: IGMUiArea; begin wAll := 0; for i:=0 to ContainedAreas.Count-1 do if GMGetInterface(ContainedAreas[i], IGMUiArea, area) then Inc(wAll, area.CalculateWidth(cTabReCalcSz)); // GMRectSize(area.LayoutBounds).x if wAll > GMRectSize(LayoutBounds).x then begin for i:=0 to ContainedAreas.Count-1 do if GMGetInterface(ContainedAreas[i], IGMUiArea, area) then begin area.EdgeSpace[edgRight] := MulDiv(area.CalculateWidth(cTabReCalcSz), cQAlignDivisor, wAll); area.EdgeAlign[edgRight] := ealAligned; area.AutoCalcSize[d2dHorizontal] := False; end; end else for i:=0 to ContainedAreas.Count-1 do if GMGetInterface(ContainedAreas[i], IGMUiArea, area) then begin area.EdgeSpace[edgRight] := 0; area.EdgeAlign[edgRight] := ealFixed; area.AutoCalcSize[d2dHorizontal] := True; end; inherited LayoutContainedAreas(ARepaint); end; { --------------------- } { ---- TGMPageTabs ---- } { --------------------- } constructor TGMPageTabs.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); //FChevronBtn := OwnArea(TGMPageTabsChevronBtn.Create(Self, GMRect(-cChevronBtnWidth, cTabOuterSpace, 0, 0), cRightAligned, BkgndColor)) as TGMPageTabsChevronBtn; FTabsArea := OwnArea(TGMBoundingTabsArea.Create(Self, GMRect(cTabOuterSpace, 0, cTabOuterSpace, 0), cBottomAligned, cNullPoint, BkgndColor)) as TGMUiAreaBase; TabsArea.ContainedAreas.OnAfterCountChanged := OnContainedAreasCountChanged; FActivePageIdx := -1; end; constructor TGMPageTabs.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; //const APaddSpace: TPoint; const AImageList: IGMGetHandle; const ABkgndColor: COLORREF; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, GMPoint(0, cTabOuterSpace), ABkgndColor, AVisible, ARefLifeTime); FImageList := AImageList; end; destructor TGMPageTabs.Destroy; begin TabsArea.ContainedAreas.OnAfterCountChanged := nil; // <- avoid notification which would call RePaint inherited; end; procedure TGMPageTabs.OnContainedAreasCountChanged(const ASender: TObject; const AOldCount, ANewCount: PtrInt); begin if AOldCount > ANewCount then InternalSetActivePageIdx(FActivePageIdx); if Assigned(OnAfterPageCountChanged) then OnAfterPageCountChanged(Self, AOldCount, ANewCount); end; function TGMPageTabs.RootForRelayout: TObject; begin Result := Self; end; function TGMPageTabs.PageCount: LongInt; begin Result := TabsArea.ContainedAreas.Count; end; function TGMPageTabs.GetPage(const AIndex: Integer): TObject; begin Result := (TabsArea.ContainedAreas[AIndex] as TGMPageTabArea).PageArea; end; procedure TGMPageTabs.ShowActivePage; var i: LongInt; PIArea: IGMUiArea; begin for i:=0 to PageCount-1 do //if (TabsArea.ContainedAreas[i] is TGMPageTabArea) and (TGMPageTabArea(TabsArea.ContainedAreas[i]).PageArea <> nil) and // TGMPageTabArea(TabsArea.ContainedAreas[i]).PageArea.GetInterface(IGMUiArea, PIArea) then if (Pages[i] <> nil) and Pages[i].GetInterface(IGMUiArea, PIArea) then PIArea.SetVisible((i = ActivePageIdx) and Visible); end; function TGMPageTabs.AddPage(const APageArea: TObject; ATitle: TGMString; const AShowCloseBtn: Boolean; AImgIdx: Integer; const AActivatePage: Boolean; const AOwnArea: Boolean): TObject; //const cLeftSpace: array [Boolean] of LongInt = (0, cTabOuterSpace); var NewTab: TGMUiAreaBase; RTab: TRect; begin Result := APageArea; RTab := cNullRect; // GMRect(cLeftSpace[PageCount = 0], cTabOuterSpace, 0, 0); //if PageCount = 0 then Inc(RTab.Left, cTabOuterSpace); NewTab := TabsArea.OwnArea(TGMPageTabArea.Create(TabsArea, RTab, cBottomLeftX, ATitle, APageArea, AShowCloseBtn, AImgIdx{, BkgndColor})) as TGMUiAreaBase; if AOwnArea then NewTab.OwnArea(APageArea); if GMParentHandleAllocated(NewTab) then NewTab.CreateHandle; LayoutContainedAreas(True); if AActivatePage then SetActivePageIdx(PageCount-1) else ShowActivePage; end; function TGMPageTabs.PaintArea(const ADC: HDC; const ARSurface: TRect): Boolean; var Pen: IGMGetHandle; begin Result := inherited PaintArea(ADC, ARSurface); Pen := TGMGdiPen.Create(ADC, GMFrameColorFromBkgndColor(BkgndColor)); // clDfltHoverFrameColor MoveToEx(ADC, ARSurface.Left, ARSurface.Bottom-1, nil); LineTo(ADC, ARSurface.Right, ARSurface.Bottom-1); end; procedure TGMPageTabs.SetActivePageIdx(const AValue: Integer); begin if GMBoundedInt(AValue, -1, PageCount-1, False) <> FActivePageIdx then InternalSetActivePageIdx(AValue); end; procedure TGMPageTabs.InternalSetActivePageIdx(const AValue: Integer); begin FActivePageIdx := GMBoundedInt(AValue, -1, PageCount-1, False);; LayoutContainedAreasIfNeeded(False); ShowActivePage; if Assigned(OnAfterPageChanged) then OnAfterPageChanged(Self); ScheduleRepaint; end; function TGMPageTabs.FindPage(const AClass: TClass; const ATitle: TGMString; out Page): Boolean; var i: LongInt; begin Result := False; for i:=0 to PageCount-1 do if ((AClass = nil) or (Pages[i] is AClass)) and ((ATitle = '') or GMSameText(GMGetObjText(Pages[i]), ATitle)) then begin TObject(Page) := TGMPageTabArea(TabsArea.ContainedAreas[i]).PageArea; Result := True; Break; end; end; function TGMPageTabs.GetActivePage: TObject; begin if not GMIsInRange(ActivePageIdx, 0, TabsArea.ContainedAreas.Count-1) then Result := nil else Result := (TabsArea.ContainedAreas[ActivePageIdx] as TGMPageTabArea).PageArea; end; procedure TGMPageTabs.SetActivePage(const AValue: TObject); var i: LongInt; begin if AValue = nil then ActivePageIdx := -1 else for i:=0 to TabsArea.ContainedAreas.Count-1 do if (TabsArea.ContainedAreas[i] is TGMPageTabArea) and (TGMPageTabArea(TabsArea.ContainedAreas[i]).PageArea = AValue) then begin ActivePageIdx := i; Break; end; end; procedure TGMPageTabs.RemovePage(const APageArea: TObject); var i: LongInt; begin for i:=TabsArea.ContainedAreas.Count-1 downto 0 do if (TabsArea.ContainedAreas[i] is TGMPageTabArea) and (TGMPageTabArea(TabsArea.ContainedAreas[i]).PageArea = APageArea) then begin TabsArea.OwnedAreas.RemoveByIdx(TabsArea.OwnedAreas.IndexOfObj(TabsArea.ContainedAreas[i])); //LayoutContainedAreas(True); GMReLayoutContainedAreas(Self); Break; end; //TabsArea.OwnedAreas.RemoveByKey(GMObjAsIntf(TabsArea.ContainedAreas[i])); // <- remove the Tab, it will in turn remove the page if the tab is the owner of the page end; function TGMPageTabs.FontColor: COLORREF; begin Result := cDitherGray; // GMChangeColorLightness(clSilver, 120); clSilver; clDkGray end; function TGMPageTabs.BkgndColor: COLORREF; begin Result := clWhite; // inherited BkgndColor;clSilver; end; function TGMPageTabs.HBkgndBrush: THandle; begin Result := GMDitheredBrush; end; { ----------------------- } { ---- TGMTLViewBase ---- } { ----------------------- } constructor TGMTLViewBase.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString; const AWndStyle, AWndExStyle: DWORD; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, AText, AWndStyle, AWndExStyle, ABkgndColor, ARefLifeTime); //GMSetupFrame(Frame, frsLowered, frsLowered); end; procedure TGMTLViewBase.UpdateWndStyle(const Mask, Flags: DWORD); //var CurrentStyle: DWORD; begin WndStyle := WndStyle and not Mask or Flags; //if not HandleAllocated then Exit; //CurrentStyle := DWORD(GetWindowLong(Handle, GWL_STYLE)); //if CurrentStyle and Mask = Flags and Mask then Exit; //SetWindowLong(Handle, GWL_STYLE, CurrentStyle and not Mask or Flags);} end; { ------------------------------------------ } { ---- ListView global Helper routiines ---- } { ------------------------------------------ } //function ListView_InsertColumn(wnd: hwnd; iCol: LongInt; const pcol: TLVColumn): LongInt; //begin // Result := SendMessage(wnd, LVM_INSERTCOLUMN, iCol, LPARAM(@pcol)); //end; // //function ListView_InsertItem(wnd: hwnd; const pitem: TLVItem): LongInt; //begin // Result:=SendMessage(wnd, {$IFDEF UNICODE}LVM_INSERTITEMW{$ELSE}LVM_INSERTITEMA{$ENDIF}, 0, LPARAM(@pitem)); //end; // //function ListView_SetItem(wnd: hwnd; const pitem: TLVItem): BOOL; //begin // Result := BOOL(SendMessage(wnd, {$IFDEF UNICODE}LVM_SETITEMW{$ELSE}LVM_SETITEMA{$ENDIF}, 0, LPARAM(@pitem))); //end; // //function ListView_GetItem(wnd: hwnd; var pitem: TLVItem):BOOL; //begin // Result := BOOL(SendMessage(wnd, {$IFDEF UNICODE}LVM_GETITEMW{$ELSE}LVM_GETITEMA{$ENDIF}, 0, LPARAM(@pitem))); //end; // //procedure ListView_SetItemText(hwndLV:hwnd; i: WPARAM; iSubItem: LongInt; pszText: PGMChar); //var _ms_lvi : TLVItem; //begin // _ms_lvi.iSubItem := iSubItem; // _ms_lvi.pszText := pszText; // SendMessage(hwndLV, {$IFDEF UNICODE}LVM_SETITEMTEXTW{$ELSE}LVM_SETITEMTEXTA{$ENDIF}, i, LPARAM(@_ms_lvi)); //end; { --------------------- } { ---- TGMListView ---- } { --------------------- } constructor TGMListView.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AWndStyle: DWORD; const AWndExStyle: DWORD; const ALVExStyle: DWORD; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, '', AWndStyle, AWndExStyle, ABkgndColor, ARefLifeTime); FLVExStyle := ALVExStyle; end; function TGMListView.RegisterWndClass: TGMString; begin GMInitComCtl32Dll(ICC_LISTVIEW_CLASSES); Result := WC_LISTVIEW; end; procedure TGMListView.WMMouseEnter(var Msg: TMessage); begin // prevent MS ListView Control item select when entered inherited; FPassMessageToOriginalHandler := False; end; procedure TGMListView.WMMouseLeave(var Msg: TMessage); begin inherited; FPassMessageToOriginalHandler := False; end; procedure TGMListView.InternalCreateHandle; begin //if HandleAllocated then begin inherited CreateHandle; Exit; end else inherited CreateHandle; inherited; {ToDo: CS_HREDRAW or CS_VREDRAW ?} ListView_SetExtendedListViewStyle(FHandle, FLVExStyle); ListView_SetBkColor(FHandle, GMRGBColor(BkgndColor)); ListView_SetTextBkColor(FHandle, GMRGBColor(BkgndColor)); end; //function TGMListView.CreateDragImgBmp(const AItemIdx: LongInt; const ATransparentColor: COLORREF): IGMGetHandle; //var bmpDC, brush: IGMGetHandle; imgSz: TPoint; rItem: TRect; wndDc: HDC; clntSz: TPoint; //begin //ListView_GetItemRect(FHandle, AItemIdx, rItem, LVIR_BOUNDS); //imgSz := GMRectSize(rItem); //clntSz := ClientAreaSize; //if imgSz.x > clntSz.x then imgSz.x := clntSz.x; // //Result := TGMGdiBitmap.CreateCompatibleBmp(0, 0, imgSz); //bmpDC := TGMGdiCompatibleDC.Create(Result.Handle); // //wndDc := GetDC(FHandle); //if wndDc = 0 then Exit; //BitBlt(bmpDc.Handle, 0, 0, imgSz.x, imgSz.y, wndDC, rItem.Left, rItem.Top, SRCCOPY); //ReleaseDC(FHandle, wndDC); // ////brush := TGMGdiBrush.Create(0, trnspCol); ////FillRect(bmpDC.Handle, GMRect(cNullPoint, imgSz), brush.Handle); ////brush := nil; // //end; procedure TGMListView.WMAppNotify(var Msg: TWMNotify); var RItem: TRect; ptDummy: TPoint; //bmp: IGMGetHandle; begin // inherited; case Integer(Msg.NMHdr.code) of LVN_BEGINDRAG: if tlvAllowDrag in Attributes then begin //GMSendObjMessage(Self, WM_LBUTTONUP, 0, MakeLongInt(PNMTreeView(Msg.NMHdr).ptDrag.x, PNMTreeView(Msg.NMHdr).ptDrag.y)); //GMProcessAllMessages; RItem := cNullRect; ptDummy := cNullPoint; ListView_GetItemRect(FHandle, PNMListView(Msg.NMHdr).iItem, RItem, LVIR_SELECTBOUNDS); //ImgList := TGMImageList.TakeOver(TreeView_CreateDragImage(FHandle, PNMTreeView(Msg.NMHdr).itemNew.hItem)); //vGMDragPainter := TGMImgListDragPainter.Create(Self, ImgList, PNMTreeView(Msg.NMHdr).ptDrag, True); // bmp := CreateDragImgBmp(PNMListView(Msg.NMHdr).iItem, clRed); // with PNMListView(Msg.NMHdr)^ do // vGMDragPainter := TGMTransparentDragPainter.Create(Self, bmp, clRed, GMPoint(ptAction.x - RItem.Left, ptAction.y - RItem.Top), Self, True); with PNMListView(Msg.NMHdr)^ do vGMDragPainter := TGMImgListDragPainter.Create(Self, TGMImageList.TakeOver(ListView_CreateDragImage(FHandle, PNMListView(Msg.NMHdr).iItem, ptDummy)), GMPoint(ptAction.x - RItem.Left, ptAction.y - RItem.Top), Self, 0, True); end; end; FPassMessageToOriginalHandler := False; end; procedure TGMListView.CreateColumns(const AListColumns: array of TGMColumnDescRec); const cLVAlignment: array [TGMDfltHorizontalAlignment] of LongWord = (LVCFMT_LEFT, LVCFMT_LEFT, LVCFMT_CENTER, LVCFMT_RIGHT); var i: Integer; newCol: TLVColumn; // align: TGMHorizontalAlignment; begin //if not HandleAllocated then Exit; FillByte(newCol, SizeOf(newCol), 0); newCol.mask := LVCF_TEXT or LVCF_WIDTH or LVCF_FMT; for i:=Low(AListColumns) to High(AListColumns) do begin newCol.pszText := PGMChar(AListColumns[i].Title); newCol.cx := AListColumns[i].Width; //case AListColumns[i].Alignment of // //haDefault, haLeft, // haCenter: newCol.fmt := LVCFMT_CENTER; // haRight: newCol.fmt := LVCFMT_RIGHT; // else newCol.fmt := LVCFMT_LEFT; //end; newCol.fmt := cLVAlignment[AListColumns[i].Alignment]; ListView_InsertColumn(FHandle, i, newCol); end; end; function TGMListView.AddRow(const AValues: array of TGMString; const AImageIndex: Integer; const AData: Pointer): Integer; var i: Integer; NewItem: TLVItem; begin //if not HandleAllocated then Exit; if Length(AValues) = 0 then begin Result := -1; Exit; end; Result := ListView_GetItemCount(FHandle); NewItem := LVItemRec(Result, 0, LVIF_DI_SETITEM, AValues[Low(AValues)], AImageIndex, -1, -1, LPARAM(AData)); ListView_InsertItem(FHandle, NewItem); NewItem.mask := LVIF_DI_SETITEM or LVIF_TEXT; for i:=Low(AValues)+1 to High(AValues) do begin NewItem.pszText := PGMChar(AValues[i]); NewItem.iSubItem := i; ListView_SetItem(FHandle, NewItem); end; end; function TGMListView.ItemAtPoint(const Point: TPoint): PtrInt; begin Result := HitTestInfo(Point).iItem; end; function TGMListView.CreateDragImage(const AItem: PtrInt; var ADragPoint: TPoint): THandle; // // ADragPoint: In -> MousePos, Out -> DragHotSpot // var pt: TPoint; rItem: TRect; begin if AItem < 0 then begin Result := 0; Exit; end; Result := ListView_CreateDragImage(FHandle, AItem, pt); if Result = 0 then Exit; ListView_GetItemRect(FHandle, AItem, rItem, LVIR_BOUNDS); ADragPoint := GMPoint(ADragPoint.x - rItem.Left, ADragPoint.y - rItem.Top); end; function TGMListView.HitTestInfo(const ClientPoint: TPoint): TLVHitTestInfo; begin //FillByte(Result, SizeOf(Result), 0); Result := Default(TLVHitTestInfo); Result.pt := ClientPoint; ListView_HitTest(FHandle, Result); end; procedure TGMListView.DeleteItem(const AItemIdx: LongInt); begin if HandleAllocated then ListView_DeleteItem(FHandle, AItemIdx); end; function TGMListView.GetLVItem(const AItemIdx, ASubItemIdx, AMask: LongInt): TLVItem; begin Result := LVItemRec(AItemIdx, ASubItemIdx, AMask); ListView_GetItem(FHandle, Result); end; procedure TGMListView.SetLVItem(const AItemIdx: TLVItem); begin if HandleAllocated then ListView_SetItem(FHandle, AItemIdx); end; function TGMListView.GetItemText(const AItemIdx, ASubItemIdx: LongInt): TGMString; var Item: TLVItem; begin Item := LVItemRec(AItemIdx, ASubItemIdx); SetLength(Result, 2048); Item.pszText := PGMChar(Result); Item.cchTextMax := Length(Result); SetLength(Result, SendMessage(FHandle, LVM_GETITEMTEXT, AItemIdx, LPARAM(@Item))); {SetLength(Result, 2048); Result[1] := #0; ListView_GetItemText(FHandle, iItem, iSubItem, PGMChar(Result), Length(Result)); SetLength(Result, GMStrLen(PGMChar(Result)));} end; procedure TGMListView.SetItemText(const AItemIdx, ASubItemIdx: LongInt; const Value: TGMString); begin if HandleAllocated then ListView_SetItemText(FHandle, AItemIdx, ASubItemIdx, PGMChar(Value)); end; function TGMListView.GetItemCount: LongInt; begin if HandleAllocated then Result := ListView_GetItemCount(FHandle) else Result := 0; end; procedure TGMListView.ClearSelection; var Idx: Integer; begin repeat Idx := ListView_GetNextItem(FHandle, -1, LVNI_ALL or LVNI_SELECTED); if Idx >= 0 then SetLVItem(LVItemRec(Idx, 0, LVIF_DI_SETITEM, '', cUnkImgIdx, 0, LVIS_SELECTED)) until Idx < 0; end; function TGMListView.StartTitleEdit(const AItemIdx: LongInt): HWnd; begin if HandleAllocated then Result := ListView_EditLabel(FHandle, AItemIdx) else Result := 0; end; function TGMListView.GetSelectedItem: PtrInt; begin if HandleAllocated then Result := ListView_GetNextItem(FHandle, -1, LVNI_ALL or LVNI_SELECTED) else Result := -1; end; procedure TGMListView.SetSelectedItem(const AValue: PtrInt); begin if AValue = -1 then ClearSelection else SetLVItem(LVItemRec(AValue, 0, LVIF_DI_SETITEM, '', cUnkImgIdx, LVIS_SELECTED)); end; procedure TGMListView.ScrollToItem(const AItemIdx: LongInt; const AllowPartial: Boolean); begin if HandleAllocated then ListView_EnsureVisible(FHandle, AItemIdx, AllowPartial); end; function TGMListView.GetItemChecked(const AItemIdx: LongInt): Boolean; begin if HandleAllocated then Result := ListView_GetCheckState(FHandle, AItemIdx) <> 0 else Result := False; end; procedure TGMListView.SetItemChecked(const AItemIdx: LongInt; const AValue: Boolean); begin if HandleAllocated then ListView_SetCheckState(FHandle, AItemIdx, AValue); end; function TGMListView.GetImageList(const AItemIdx: TLVImageList): THandle; begin if HandleAllocated then Result := ListView_GetImageList(FHandle, cLVImageList[AItemIdx]) else Result := 0; end; procedure TGMListView.SetImageList(const AItemIdx: TLVImageList; const Value: THandle); begin if HandleAllocated then ListView_SetImageList(FHandle, Value, cLVImageList[AItemIdx]); end; function TGMListView.GetItemData(const AItemIdx: LongInt): Pointer; begin if HandleAllocated then Result := Pointer(GetLVItem(AItemIdx, 0, LVIF_PARAM).lParam) else Result := nil; end; procedure TGMListView.SetItemData(const AItemIdx: LongInt; const Value: Pointer); begin if HandleAllocated then SetLVItem(LVItemRec(AItemIdx, 0, LVIF_DI_SETITEM, '', cUnkImgIdx, -1, -1, LPARAM(Value))); end; procedure TGMListView.SortItemsByText(const AColIdx: LongInt); var SortData: TGMLVSortData; begin SortData.ListView := Self; SortData.ColIdx := AColIdx; SendMessage(FHandle, LVM_SORTITEMSEX, WPARAM(@SortData), LPARAM(@ListViewItemTextCompareFunc)); end; { ---------------------------- } { ---- TGMWccTreeNodeData ---- } { ---------------------------- } constructor TGMWccTreeNodeData.Create(const AOwner: TGMTreeView; const ATreeItem: HTreeItem; const ARefLifeTime: Boolean); begin Create(ARefLifeTime); FOwner := AOwner; FTreeItem := ATreeItem; end; //function TGMWccTreeNodeData.GetHint: TGMString; //begin //Result := ''; //end; procedure TGMWccTreeNodeData.LoadData(const Source: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); begin // Nothing! end; procedure TGMWccTreeNodeData.StoreData(const Dest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); begin // Nothing! end; function TGMWccTreeNodeData.TreeNode: IGMWccTvNode; //var getNode: IGMGetTreeNode; begin //if not GMGetInterface(FOwner, IGMGetTreeNode, getNode) then Result := nil else // GMQueryInterface(getNode.GetTreeNode(Element), IGMWccTvNode, Result); //if not (Owner is TGMTreeView) then Result := nil else Result := TGMTreeView(Owner).CreateNodeWrapper(Element); if FOwner = nil then Result := nil else Result := FOwner.CreateNodeWrapper(FTreeItem); end; { ----------------------------- } { ---- Node visit routines ---- } { ----------------------------- } function VisitCountNodeIdx(const ANode: IGMTreeable; const AParameter: Pointer): Boolean; var nodeHandle, searchHandle: IGMGetHandle; begin // // Result = True means "continue iteration" (not found) // Result := not ((AParameter <> nil) and GMQueryInterface(ANode, IGMGetHandle, nodeHandle) and GMQueryInterface(PGMNodeVisitData(AParameter).Node, IGMGetHandle, searchHandle) and (nodeHandle.Handle = searchHandle.Handle)); if Result and (AParameter <> nil) then Inc(PGMNodeVisitData(AParameter).Index); end; function VisitExpandNode(const ANode: IGMTreeable; const AParameter: Pointer): Boolean; var wccNode: IGMWccTvNode; begin Result := True; // <- always continue iteration if GMQueryInterface(ANode, IGMWccTvNode, wccNode) then TreeView_Expand(wccNode.Owner.FHandle, HTreeItem(GMGetIntfHandle(ANode)), WPARAM(AParameter)); end; function IsAbsNodeIdx(const ANode: IGMTreeable; const AParameter: Pointer): Boolean; var findData: PGMNodeVisitData; begin // Result = True => continue iteration (no match), result = False => found, stop iteration Result := True; if AParameter = nil then Exit(False); findData := AParameter; Result := not (findData.Index = findData.SearchIdx); if Result then Inc(findData.Index); // else TreeNode := ANode; end; function UnselectNode(const ANode: IGMTreeable; const AParameter: Pointer): Boolean; var wccNode: IGMWccTvNode; begin if GMQueryInterface(ANode, IGMWccTvNode, wccNode) then wccNode.State := wccNode.State - [tnsSelected]; Result := True; end; function AddSelectedNode(const ANode: IGMTreeable; const AParameter: Pointer): Boolean; var wccNode: IGMWccTvNode; begin Result := AParameter <> nil; if GMQueryInterface(ANode, IGMWccTvNode, wccNode) and ([tnsSelected, tnsFocused] * wccNode.State <> []) then begin SetLength(PGMWccTreeNodeArray(AParameter)^, Length(PGMWccTreeNodeArray(AParameter)^) + 1); PGMWccTreeNodeArray(AParameter)^[High(PGMWccTreeNodeArray(AParameter)^)] := wccNode; end; end; { ---------------------- } { ---- TGMWccTvNode ---- } { ---------------------- } constructor TGMWccTvNode.Create(const AHandle: HTreeItem; const AOwner: TGMTreeView; const ARefLifeTime: Boolean = True); begin inherited Create(ARefLifeTime); FHandle := AHandle; FOwner := AOWner; end; function TGMWccTvNode.Obj: TGMWccTvNode; begin Result := Self; end; function TGMWccTvNode.GetOwner: TGMTreeView; begin Result := FOwner; end; procedure TGMWccTvNode.FreeDataObj; begin DataObject := nil; // <- will free data via SetData end; function TGMWccTvNode.DataClassName: AnsiString; begin if DataObject = nil then Result := '' else Result := DataObject.ClassName; end; function TGMWccTvNode.BuildHintText: TGMString; var getHint: IGMGetHint; begin if GMGetInterface(DataObject, IGMGetHint, getHint) then Result := getHint.Hint else Result := ''; end; procedure TGMWccTvNode.Select; begin Owner.SelectedNode := Self; end; procedure TGMWccTvNode.DeleteChildren; var TVChild: IGMWccTvNode; begin while FirstChild <> nil do if GMQueryInterface(FirstChild, IGMWccTvNode, TVChild) then TVChild.Delete; end; function TGMWccTvNode.StartTitleEdit: HWnd; begin //if not FOwner.HandleAllocated then Result := 0 else Result := TreeView_EditLabel(FOwner.FHandle, FHandle); end; function TGMWccTvNode.AbsoluteIndex: LongInt; var visitData: RGMNodeVisitData; begin visitData := GMInitNodeVisitData(nil, '', Self); GMVisitNodesRootFirst(RootNode, VisitCountNodeIdx, True, @visitData); Result := visitData.Index; end; function TGMWccTvNode.ChildIndex: LongInt; var visitData: RGMNodeVisitData; begin visitData := GMInitNodeVisitData(nil, '', Self); GMVisitNodesRootFirst(Parent, VisitCountNodeIdx, True, @visitData); Result := visitData.Index; end; procedure TGMWccTvNode.LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); stdcall; var _State: TGMTreeNodeStates; dataObjLoad: IGMLoadStoreData; begin if ASource = nil then Exit; // Title, DataCreateClass and Image indexes are set by Tree view load routine _State := TreeNodeStatesFromInt(ASource.ReadInteger(cStrState, TreeNodeStatesToInt(cDfltTreeNodeState))); State := _State - [tnsFocused, tnsSelected]; //if (tnsSelected in _State) and Owner.HandleAllocated then PostMessage(Owner.Handle, TVM_SELECTITEM, TVGN_CARET, Integer(Handle)); if GMGetInterface(DataObject, IGMLoadStoreData, dataObjLoad) then dataObjLoad.LoadData(ASource, ACryptCtrlData); end; procedure TGMWccTvNode.StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); stdcall; var dataObjStore: IGMLoadStoreData; begin if ADest = nil then Exit; GMStoreString(ADest, cStrDataClassName, DataClassName); GMStoreInteger(ADest, cStrState, TreeNodeStatesToInt(State), TreeNodeStatesToInt(cDfltTreeNodeState)); if GMGetInterface(DataObject, IGMLoadStoreData, dataObjStore) then dataObjStore.StoreData(ADest, ACryptCtrlData); //if (DataObject is TGMWccTreeNodeData) and not TGMWccTreeNodeData(DataObject).CustomStoreValues then if not GMAskBoolean(DataObject, Ord(bvCustomStoreValues), False) then begin GMStoreString(ADest, cStrTitle, Text); GMStoreInteger(ADest, cStrImageIndex, ImageIdx, cUnkImgIdx); GMStoreInteger(ADest, cStrSelectedImgIdx, SelectedImgIdx, cUnkImgIdx); //GMStoreInteger(ADest, cStrStateImgIdx, StateImgIdx, cUnkImgIdx); //GMStoreInteger(ADest, cStrOverlayImgIdx, OverlayImgIdx, cUnkImgIdx); end; end; function TGMWccTvNode.GetTVItem(const AMask: UINT): TTVItem; begin Result := TVItemRec(FHandle, AMask); //if FOwner.HandleAllocated then TreeView_GetItem(FOwner.FHandle, Result); end; procedure TGMWccTvNode.SetTVItem(const AValue: TTVItem); begin //if FOwner.HandleAllocated then TreeView_SetItem(FOwner.FHandle, AValue); end; function TGMWccTvNode.GetHandle: THandle; stdcall; begin Result := THandle(FHandle); end; function TGMWccTvNode.RootNode: IGMWccTvNode; begin Result := FOwner.RootNode; end; function TGMWccTvNode.Parent: IGMTreeable; begin Result := FOwner.CreateNodeWrapper(TreeView_GetParent(FOwner.FHandle, FHandle)); end; function TGMWccTvNode.Expand(const AOperation: TTVExpandOperation; const Recurse: Boolean = False): Boolean; begin //GMExpandWccTvNode(Self, TObject(cTVExpandOperation[AOperation])); Result := TreeView_Expand(FOwner.FHandle, FHandle, cTVExpandOperation[AOperation]); if Recurse then GMVisitNodesRootFirst(FirstChild, VisitExpandNode, Recurse, Pointer(cTVExpandOperation[AOperation])); end; procedure TGMWccTvNode.MoveTo(const AParent: IGMTreeable; const InsertAfter: HTreeItem; const ACryptCtrlData: PGMCryptCtrlData); var saveStorage: IGMValueStorage; nodeIdx: Integer; paintDisabler: IUnknown; wnd: THandle; begin saveStorage := TGMPersistentData.Create(TGMCompoundDocStorage, '', '', cDontUseRootKey, True); nodeIdx := 0; if GMGetAllocatedObjHandle(Owner, wnd) then paintDisabler := TGMWndPaintDisabler.Create(wnd); GMStoreTree(saveStorage, Self, nodeIdx, False, ACryptCtrlData); Delete; Owner.LoadSubNodes(saveStorage, AParent, InsertAfter, ACryptCtrlData); end; function TGMWccTvNode.MakeVisible: Boolean; begin Result := TreeView_EnsureVisible(FOwner.FHandle, FHandle); end; function TGMWccTvNode.Delete: Boolean; var prntNode: IGMTreeable; tvPrntNode: IGMWccTvNode; begin // Will delete all childs // Node data will be freed via TVN_DELETEITEM notifications prntNode := Parent; Result := TreeView_DeleteItem(FOwner.FHandle, FHandle); if (prntNode <> nil) and (prntNode.FirstChild = nil) and GMQueryInterface(prntNode, IGMWccTvNode, tvPrntNode) then tvPrntNode.HasChildren := False; end; function TGMWccTvNode.DoBeforeDraw(const PData: PNMTVCustomDraw): LRESULT; begin Result := CDRF_DODEFAULT; end; function TGMWccTvNode.DoAfterDraw(const PData: PNMTVCustomDraw): LRESULT; begin Result := CDRF_DODEFAULT; end; function TGMWccTvNode.OnBeforeExpandOrCollapse(const AOperation: TTVExpandOperation): Boolean; begin Result := True; end; procedure TGMWccTvNode.OnAfterExpandOrCollapse(const AOperation: TTVExpandOperation); begin // Nothing! end; function TGMWccTvNode.FirstChild: IGMTreeable; begin Result := FOwner.CreateNodeWrapper(TreeView_GetChild(FOwner.FHandle, FHandle)); end; function TGMWccTvNode.PrevSibling: IGMTreeable; begin Result := FOwner.CreateNodeWrapper(TreeView_GetPrevSibling(FOwner.FHandle, FHandle)); end; function TGMWccTvNode.NextSibling: IGMTreeable; begin Result := FOwner.CreateNodeWrapper(TreeView_GetNextSibling(FOwner.FHandle, FHandle)); end; function TGMWccTvNode.GetHasChildren: Boolean; begin Result := GetTVItem(TVIF_CHILDREN).cChildren <> 0; end; procedure TGMWccTvNode.SetHasChildren(const AValue: Boolean); const cChildren: array [Boolean] of LongInt = (0, 1); begin SetTVItem(TVItemRec(FHandle, TVIF_DI_SETITEM, nil, cUnkImgIdx, cUnkImgIdx, cChildren[AValue])); end; function TGMWccTvNode.GetImageIdx: Integer; begin Result := GetTVItem(TVIF_IMAGE).iImage; end; procedure TGMWccTvNode.SetImageIdx(const AValue: Integer); var SetSelIdx: Boolean; begin SetSelIdx := (SelectedImgIdx = cUnkImgIdx) or (SelectedImgIdx = ImageIdx); SetTVItem(TVItemRec(FHandle, TVIF_DI_SETITEM, nil, AValue)); if SetSelIdx then SelectedImgIdx := AValue; end; function TGMWccTvNode.GetSelectedImgIdx: Integer; begin Result := GetTVItem(TVIF_SELECTEDIMAGE).iSelectedImage; end; procedure TGMWccTvNode.SetSelectedImgIdx(const AValue: Integer); begin SetTVItem(TVItemRec(FHandle, TVIF_DI_SETITEM, nil, cUnkImgIdx, AValue)); end; function TGMWccTvNode.GetStateImgIdx: Integer; var Item: TTVItem; begin Item := TVItemRec(FHandle, TVIF_STATE, nil, cUnkImgIdx, cUnkImgIdx, -1, -1, TVIS_STATEIMAGEMASK); TreeView_GetItem(FOwner.FHandle, Item); Result := Item.state shr 12; end; procedure TGMWccTvNode.SetStateImgIdx(const AValue: Integer); begin SetTVItem(TVItemRec(FHandle, TVIF_DI_SETITEM, nil, cUnkImgIdx, cUnkImgIdx, -1, AValue shl 12, TVIS_STATEIMAGEMASK)); end; function TGMWccTvNode.GetOverlayImgIdx: Integer; var Item: TTVItem; begin Item := TVItemRec(FHandle, TVIF_STATE, nil, cUnkImgIdx, cUnkImgIdx, -1, -1, TVIS_OVERLAYMASK); TreeView_GetItem(FOwner.FHandle, Item); Result := Item.state shr 8; end; procedure TGMWccTvNode.SetOverlayImgIdx(const AValue: Integer); begin SetTVItem(TVItemRec(FHandle, TVIF_DI_SETITEM, nil, cUnkImgIdx, cUnkImgIdx, -1, AValue shl 8, TVIS_OVERLAYMASK)); end; function TGMWccTvNode.GetText: TGMString; stdcall; const cBufLen = 2048; var tvItem: TTVItem; begin //Result := ''; SetLength(Result, cBufLen); tvItem := TVItemRec(FHandle, 0, PGMChar(Result)); tvItem.cchTextMax := cBufLen; TreeView_GetItem(FOwner.FHandle, tvItem); SetLength(Result, GMStrLen(tvItem.pszText, tvItem.cchTextMax)); //SetString(Result, tvItem.pszText, GMStrLen(tvItem.pszText, tvItem.cchTextMax)); //Result := tvItem.pszText; end; procedure TGMWccTvNode.SetText(const AValue: TGMString); stdcall; begin SetTVItem(TVItemRec(FHandle, TVIF_DI_SETITEM, PGMChar(AValue))); end; function TGMWccTvNode.GetDataObject: TObject; stdcall; begin Result := TObject(LPARAM(GetTVItem(TVIF_PARAM).lParam)); end; procedure TGMWccTvNode.SetDataObject(const AValue: TObject); stdcall; var currDataObj: TObject; begin currDataObj := DataObject; if AValue <> currDataObj then begin if currDataObj <> nil then currDataObj.Free; SetTVItem(TVItemRec(FHandle, TVIF_DI_SETITEM, nil, cUnkImgIdx, cUnkImgIdx, -1, -1, -1, LPARAM(AValue))); end; end; function TGMWccTvNode.GetState: TGMTreeNodeStates; var Item: TTVItem; i: TGMTreeNodeState; begin Result := []; Item := TVItemRec(FHandle, TVIF_STATE, nil, cUnkImgIdx, cUnkImgIdx, -1, -1, cNodeStateMask); TreeView_GetItem(FOwner.FHandle, Item); for i:=Low(i) to High(i) do if Item.state and cTVItemStates[i] <> 0 then Include(Result, i); end; procedure TGMWccTvNode.SetState(const Value: TGMTreeNodeStates); var newState: PtrUInt; i: TGMTreeNodeState; item: TTVItem; begin newState := 0; for i:=Low(i) to High(i) do if i in Value then newState := newState or cTVItemStates[i]; item := TVItemRec(FHandle, TVIF_STATE, nil, cUnkImgIdx, cUnkImgIdx, -1, -1, cNodeStateMask); TreeView_GetItem(FOwner.FHandle, item); if newState = item.state then Exit; SetTVItem(TVItemRec(FHandle, TVIF_DI_SETITEM, nil, cUnkImgIdx, cUnkImgIdx, -1, newState, cNodeStateMask)); if (newState and TVIS_SELECTED <> 0) and (item.state and TVIS_SELECTED = 0) then Inc(FOwner.FSelectedNodeCount); if (newState and TVIS_SELECTED = 0) and (item.state and TVIS_SELECTED <> 0) then Dec(FOwner.FSelectedNodeCount); end; { --------------------- } { ---- TGMTreeView ---- } { --------------------- } constructor TGMTreeView.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); Attributes := cDfltTVAttributes; end; function TGMTreeView.RegisterWndClass: TGMString; begin GMInitComCtl32Dll(ICC_TREEVIEW_CLASSES); Result := WC_TREEVIEW; end; function TGMTreeView.TreeNodeCreateClass: TGMTreeNodeClass; begin Result := TGMWccTvNode; end; //procedure TGMTreeView.WindowProc(var AMsg: TMessage); //type TWndProc = function (Wnd: HWND; AMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; //begin // if FOrgWndProc <> nil then // AMsg.Result := TWndProc(FOrgWndProc)(FHandle, AMsg.Msg, AMsg.WParam, AMsg.LParam) // AMsg.Result := orgProc(FHandle. AMsg.Msg, AMsg.WParam, AMsg.LParam) // else // inherited WindowProc(AMsg); //end; {procedure TGMTreeView.CreateHandle; begin if HandleAllocated then begin inherited CreateHandle; Exit; end else inherited CreateHandle; //ToDo: Set background color? //TreeView_SetIndent(FHandle, IndentPixel); end;} procedure TGMTreeView.WMDestroy(var AMsg: TWMDestroy); begin RemoveAllNodes(False); inherited; end; function TGMTreeView.HitTestInfo(const AClientPoint: TPoint): TTVHitTestInfo; begin //FillByte(Result, SizeOf(Result), 0); Result := Default(TTVHitTestInfo); Result.pt := AClientPoint; TreeView_HitTest(FHandle, Result); end; function TGMTreeView.CreateDragImage(const AItem: PtrInt; var ADragPoint: TPoint): THandle; // // ADragPoint: In -> MousePos, Out -> DragHotSpot // var RItem: TRect; begin if AItem = 0 then begin Result := 0; Exit; end; Result := TreeView_CreateDragImage(FHandle, HTreeItem(AItem)); if Result = 0 then Exit; TreeView_GetItemRect(FHandle, HTreeItem(AItem), RItem, True); ADragPoint := GMPoint(ADragPoint.x - RItem.Left, ADragPoint.y - RItem.Top); end; function TGMTreeView.ItemAtPoint(const APoint: TPoint): PtrInt; begin Result := PtrInt(HitTestInfo(APoint).hItem); end; function TGMTreeView.NodeAtPoint(const APoint: TPoint): IGMWccTvNode; var hNode: HTreeItem; begin hNode := HitTestInfo(APoint).hItem; Result := CreateNodeWrapper(hNode); //Result := CreateNodeWrapper(HitTestInfo(APoint).hItem); <- crashes with FPC! end; function TGMTreeView.SelectedHasDataClass(const ADataClass: TClass): Boolean; begin Result := GMIntfHasDataClass(SelectedNode, ADataClass); end; function TGMTreeView.CreateNodeWrapper(const AHTreeNode: HTreeItem; const ARefLifeTime: Boolean): IGMWccTvNode; begin if AHTreeNode = nil then Result := nil else if TreeNodeCreateClass = nil then Result := TGMWccTvNode.Create(AHTreeNode, Self, ARefLifeTime) else Result := TreeNodeCreateClass.Create(AHTreeNode, Self, ARefLifeTime); FTempNodeRef := Result; // <- Keep a reference to the created wrapper end; function TGMTreeView.GetTreeNodeFromRaw(const ANode: Pointer): IGMTreeable; stdcall; begin Result := CreateNodeWrapper(ANode); end; procedure TGMTreeView.RemoveAllNodes(const ANotify: Boolean); var NMMsg: TNMTreeView; begin FTempNodeRef := nil; FRClickTargetNode := nil; TreeView_DeleteAllItems(FHandle); // <- Node data will be freed via TVN_DELETEITEM notifications if ANotify and HandleAllocated then begin FillByte(NMMsg, SizeOf(NMMsg), 0); NMMsg.hdr.hwndFrom := FHandle; NMMsg.hdr.code := TVN_SELCHANGED; GMSendObjMessage(Self, WM_NOTIFY, 0, LPARAM(@NMMsg)); end; end; function TreeViewCompareByPosition(lParam1, lParam2, lParamSort: LPARAM): LongInt stdcall; begin if (lParamSort = 0) or not Assigned(PGMTVSortData(lParamSort).CompareFunc) then Result := 0 else Result := PGMTVSortData(lParamSort).CompareFunc(lParam1, lParam2, PGMTVSortData(lParamSort).CustomData); end; {function TGMTreeView.CompareItems(const ItemA, ItemB: LongInt; const ACustomData: Pointer): LongInt; begin Result := 0; //if (ItemA = 0) or (ItemB = 0) or (AFolder = nil) then begin Result := 0; Exit; end; // Result := AFolder.CompareSubFolders(TFolderNodeData(ItemA).Folder, TFolderNodeData(ItemB).Folder); end;} procedure TGMTreeView.SortSubNodes(const AParentNode: IGMTreeable; const ACompareFunc: TGMTreeNodeCompareFunc; const ACustomData: Pointer); // AFolder: IFsFolder = nil var tvSortData: TTVSortCB; parentTVNode: IGMWccTvNode; sortData: TGMTVSortData; begin if not GMQueryInterface(AParentNode, IGMWccTvNode, parentTVNode) then Exit; //sortData.TreeView := Self; sortData.CustomData := ACustomData; sortData.CompareFunc := ACompareFunc; tvSortData.hParent := HTreeItem(GMGetIntfHandle(parentTVNode)); tvSortData.lpfnCompare := TreeViewCompareByPosition; tvSortData.lParam := LPARAM(@sortData); TreeView_SortChildrenCB(FHandle, tvSortData, 0); end; function TGMTreeView.EndTitleEdit(const ACancelChanges: BOOL): BOOL; begin Result := TreeView_EndEditLabelNow(FHandle, ACancelChanges); end; procedure TGMTreeView.ExecContextMenu(const ANode: IGMTreeable); begin // Nothing! end; function TGMTreeView.NodeAtAboluteIndex(const AAbsoluteIndex: LongInt): IGMTreeable; var searchData: RGMNodeVisitData; begin Result := nil; if not GMIsInRange(AAbsoluteIndex, 0, NodeCount-1) then Exit; searchData := GMInitNodeVisitData(nil, '', nil, AAbsoluteIndex); Result := GMFindNode(RootNode, IsAbsNodeIdx, True, @searchData); end; function TGMTreeView.RootNode: IGMWccTvNode; begin Result := CreateNodeWrapper(TreeView_GetRoot(FHandle)); end; function TGMTreeView.NodeCount: LongInt; begin Result := TreeView_GetCount(FHandle); end; function TGMTreeView.SelectedNodeCount: PtrInt; begin //Result := GMSendObjMessage(Self, TVM_GETSELECTEDCOUNT); Result := FSelectedNodeCount; end; function TGMTreeView.GetImageList(const AIndex: TTVImageList): THandle; begin Result := TreeView_GetImageList(FHandle, cTVImageList[AIndex]); end; procedure TGMTreeView.SetImageList(const AIndex: TTVImageList; const AValue: THandle); begin TreeView_SetImageList(FHandle, AValue, cTVImageList[AIndex]); end; function TGMTreeView.GetSelectedNode: IGMWccTvNode; begin Result := CreateNodeWrapper(TreeView_GetSelection(FHandle)); end; procedure TGMTreeView.SetSelectedNode(const AValue: IGMWccTvNode); begin if AValue = nil then TreeView_SelectItem(FHandle, nil) else TreeView_SelectItem(FHandle, HTreeItem(GMGetIntfHandle(AValue))); end; function TGMTreeView.GetDropTargetNode: IGMWccTvNode; begin Result := CreateNodeWrapper(TreeView_GetDropHilite(FHandle)); end; procedure TGMTreeView.SetDropTargetNode(const AValue: IGMWccTvNode); begin if AValue = nil then TreeView_SelectDropTarget(FHandle, nil) else TreeView_SelectDropTarget(FHandle, HTreeItem(GMGetIntfHandle(AValue))); end; function TGMTreeView.CommandTargetNode: IGMWccTvNode; begin if FRClickTargetNode <> nil then Result := FRClickTargetNode else Result := SelectedNode; end; function TGMTreeView.GetSelectedItem: PtrInt; var Node: IGMWccTvNode; begin Node := SelectedNode; if Node = nil then Result := cInvalidItemIdx else Result := Node.AbsoluteIndex; //Result := PtrInt(TreeView_GetSelection(FHandle)); end; procedure TGMTreeView.SetSelectedItem(const AValue: PtrInt); var tvNode: IGMWccTvNode; // node: IGMTreeable; begin //node := NodeAtAboluteIndex(AValue); if GMQueryInterface(NodeAtAboluteIndex(AValue), IGMWccTvNode, tvNode) then SelectedNode := tvNode; end; function TGMTreeView.InsertNode(const ANewNode: TTVItem; const AParent: IGMTreeable; const ADataObj: TObject; const AInsertAfter: HTreeItem): IGMWccTvNode; var insertData: TTVInsertStruct; prntNode: IGMWccTvNode; begin FillByte(insertData, SizeOf(insertData), 0); if GMQueryInterface(AParent, IGMWccTvNode, prntNode) then insertData.hParent := HTreeItem(GMGetIntfHandle(prntNode)) else insertData.hParent := nil; if AInsertAfter = nil then insertData.hInsertAfter := TVI_LAST else insertData.hInsertAfter := AInsertAfter; insertData.item := ANewNode; if (insertData.item.hItem = nil) and (insertData.item.mask and TVIF_IMAGE = 0) then begin insertData.item.iImage := cUnkImgIdx; insertData.item.mask := insertData.item.mask or TVIF_IMAGE; end; if (insertData.item.hItem = nil) and (insertData.item.mask and TVIF_SELECTEDIMAGE = 0) then begin insertData.item.iSelectedImage := insertData.item.iImage; insertData.item.mask := insertData.item.mask or TVIF_SELECTEDIMAGE; end; //if item.mask and TVIF_CHILDREN = 0 then // begin // item.cChildren := 1; // item.mask := item.mask or TVIF_CHILDREN; // end; //if item.mask and TVIF_STATE = 0 then // begin // item.state := 0; // item.stateMask := $ffffffff; // item.mask := item.mask or TVIF_STATE; // end; Result := CreateNodeWrapper(TreeView_InsertItem(FHandle, @insertData)); if prntNode <> nil then prntNode.HasChildren := True; if ADataObj <> nil then GMSetDataObject(Result, ADataObj); end; //function TGMTreeView.AssignTextBkColor(const ANode: IGMWccTvNode): Boolean; //begin ////if (PNMCustomDraw(Msg.NMHdr).uItemState and CDIS_SELECTED = 0) then //Result := (ANode <> nil) and (ANode.State * [tnsFocused, tnsSelected, tnsDropHilited] = []); //end; procedure TGMTreeView.WMChar(var Msg: TWMChar); var clpBrd: IGMClipboard; begin inherited; case Chr(Msg.CharCode) of ^C: if SelectedNode <> nil then begin clpBrd := TGMClipboard.Create(FHandle); clpBrd.Obj.AsText := GMGetIntfText(SelectedNode); end; end; end; procedure TGMTreeView.UMQueryDrop(var AMsg: TGMDragMessageRec); var NewHighliteNode: IGMWccTvNode; HideDrag: IUnknown; begin inherited; NewHighliteNode := NodeAtPoint(GMPoint(AMsg.XPos, AMsg.YPos)); if not GMIsSameWccNode(DropTargetNode, NewHighliteNode) then begin HideDrag := TGMHideDragPainter.Create(vGMDragPainter); DropTargetNode := NewHighliteNode; end; end; procedure TGMTreeView.UMDragControl(var AMsg: TMessage); var HideDrag: IUnknown; begin inherited; case AMsg.WParam of Ord(drgLeave), Ord(drgCancel): begin HideDrag := TGMHideDragPainter.Create(vGMDragPainter); DropTargetNode := nil; end; end; end; procedure TGMTreeView.UMDragDropped(var AMsg: TMessage); begin DropTargetNode := nil; end; procedure TGMTreeView.UMAfterNodeRClick(var AMsg: TMessage); begin FRClickTargetNode := nil; end; procedure TGMTreeView.WMLButtonDown(var Msg: TWMLButtonDown); var keyState: SGMKeyStates; clickNode, wccNode: IGMWccTvNode; hitTest: TTVHitTestInfo; procedure SelectNodeRange(AStartNode, AEndNode: IGMWccTvNode); var loopNode: IGMTreeable; leave: Boolean; tmpNode: IGMWccTvNode; begin if (AStartNode = nil) or (AEndNode = nil) or not GMIsSameWccNode(AStartNode.Parent, AEndNode.Parent) then Exit; if AStartNode.ChildIndex > AEndNode.ChildIndex then begin tmpNode := AStartNode; AStartNode := AEndNode; AEndNode := tmpNode; end; loopNode := AStartNode; leave := False; while (loopNode <> nil) and not leave do begin if GMQueryInterface(loopNode, IGMWccTvNode, wccNode) then wccNode.State := wccNode.State + [tnsSelected]; if GMIsSameWccNode(loopNode, AEndNode) then leave := True; loopNode := loopNode.NextSibling; end; end; begin inherited; keyState := GMKeyDataToKeyState(Msg.Keys); hitTest := HitTestInfo(GMPoint(Msg.XPos, Msg.YPos)); //if hitTest.flags and TVHT_NOWHERE <> 0 then if hitTest.hItem = nil then begin SelectedNode := nil; FPassMessageToOriginalHandler := False; Exit; end; // <- NOTE: May Exit here! if hitTest.hItem = nil then Exit; clickNode := CreateNodeWrapper(hitTest.hItem); if FMultiSelect then if (keyState * [ksShift, ksCtrl] = []) or (clickNode = nil) then UnselectOtherNodes else try if keyState = [ksCtrl] then if tnsSelected in clickNode.State then clickNode.State := clickNode.State - [tnsSelected] else clickNode.State := clickNode.State + [tnsSelected]; if (keyState = [ksShift]) then SelectNodeRange(SelectedNode, clickNode); finally FPassMessageToOriginalHandler := False; end; end; procedure TGMTreeView.WMAppNotify(var AMsg: TWMNotify); //const cAllowExpandResult: array [Boolean] of Integer = (1, 0); var node: IGMWccTvNode; hintText: TGMString; rItem: TRect; // l: TTVImageList; // n: Cardinal; //procedure FillWithColor(ADrawInfo: PNMTVCustomDraw); //var brush: IGMGetHandle; clr: TColorRef; r: TRect; //begin // SetBkMode(ADrawInfo.nmcd.hdc, OPAQUE); // SetBkColor(ADrawInfo.nmcd.hdc, clRed); // clr := ADrawInfo.clrTextBk; // r := ADrawInfo.nmcd.rc; // brush := TGMGdiBrush.Create(0, clRed); // ADrawInfo.clrTextBk // FillRect(ADrawInfo.nmcd.hdc, ADrawInfo.nmcd.rc, brush.Handle); //end; begin // inherited; case Integer(AMsg.NMHdr.code) of NM_RCLICK: begin FRClickTargetNode := GetDropTargetNode; // CreateNodeWrapper(TreeView_GetDropHilite(FHandle)); if FRClickTargetNode = nil then FRClickTargetNode := SelectedNode; ExecContextMenu(FRClickTargetNode); PostMessage(FHandle, UM_AFTERNODERCLICK, 0, 0); end; //TVN_SELCHANGED: FRClickTargetNode := CreateNodeWrapper(PNMTreeView(AMsg.NMHdr).itemNew.hItem); TVN_DELETEITEM: begin //try //if Assigned(OnBeforeItemDelete) then AMsg.Result := OnBeforeItemDelete(Self, PTVChangeData(AMsg.NMHdr)) else AMsg.Result := 0; //finally node := CreateNodeWrapper(PNMTreeView(AMsg.NMHdr).itemOld.hItem); if node <> nil then node.FreeDataObj; end; TVN_GETINFOTIP: if tlvShowHints in Attributes then begin node := CreateNodeWrapper(PNMTVGetInfoTip(AMsg.NMHdr).hItem); if node = nil then Exit; hintText := node.BuildHintText; if Length(hintText) > 0 then lstrcpyn(PNMTVGetInfoTip(AMsg.NMHdr).pszText, PGMChar(hintText), PNMTVGetInfoTip(AMsg.NMHdr).cchTextMax); end; TVN_BEGINDRAG: if tlvAllowDrag in Attributes then begin //GMSendObjMessage(Self, WM_LBUTTONUP, 0, MakeLongInt(PNMTreeView(AMsg.NMHdr).ptDrag.x, PNMTreeView(AMsg.NMHdr).ptDrag.y)); rItem := cNullRect; TreeView_GetItemRect(FHandle, PNMTreeView(AMsg.NMHdr).itemNew.hItem, rItem, True); // for l:=Low(l) to High(l) do if ImageList[l] <> 0 then Dec(rItem.Left, GetSystemMetrics(SM_CXSMICON) + 2); if ImageList[ilTVIcons] <> 0 then Dec(rItem.Left, GetSystemMetrics(SM_CXSMICON)); //ImgList := TGMImageList.TakeOver(TreeView_CreateDragImage(FHandle, PNMTreeView(AMsg.NMHdr).itemNew.hItem)); //vGMDragPainter := TGMImgListDragPainter.Create(Self, ImgList, PNMTreeView(AMsg.NMHdr).ptDrag, True); node := CreateNodeWrapper(PNMTreeView(AMsg.NMHdr).itemNew.hItem); // FPaintDragImg := True; // try with PNMTreeView(AMsg.NMHdr)^ do vGMDragPainter := TGMImgListDragPainter.Create(Self, TGMImageList.TakeOver(TreeView_CreateDragImage(FHandle, itemNew.hItem)), GMPoint(ptDrag.x - rItem.Left, ptDrag.y - rItem.Top), node, 0, True); // finally // FPaintDragImg := False; // end; end; TVN_ITEMEXPANDING: begin node := CreateNodeWrapper(PNMTreeView(AMsg.NMHdr).itemNew.hItem); if (node <> nil) and not node.OnBeforeExpandOrCollapse(ExpandOperationFromFlags(PNMTreeView(AMsg.NMHdr).action)) then AMsg.Result := 1; // <- Returning 1 prevents expand or collapse operation! // if node <> nil then // AMsg.Result := cAllowExpandResult[node.OnBeforeExpandOrCollapse(ExpandOperationFromFlags(PNMTreeView(AMsg.NMHdr).action))]; end; TVN_ITEMEXPANDED: begin node := CreateNodeWrapper(PNMTreeView(AMsg.NMHdr).itemNew.hItem); if node <> nil then node.OnAfterExpandOrCollapse(ExpandOperationFromFlags(PNMTreeView(AMsg.NMHdr).action)); end; NM_CUSTOMDRAW: case PNMCustomDraw(AMsg.NMHdr).dwDrawStage of CDDS_PREPAINT: AMsg.Result := CDRF_NOTIFYITEMDRAW; // <- always route through CDDS_ITEMPREPAINT for item Bkgnd Color CDDS_ITEMPREPAINT: begin // AMsg.Result := CDRF_DODEFAULT; node := CreateNodeWrapper(HTreeItem(PNMTVCustomDraw(AMsg.NMHdr).nmcd.dwItemSpec)); // if FPaintDragImg then FillWithColor(PNMTVCustomDraw(AMsg.NMHdr)); // if PNMTVCustomDraw(AMsg.NMHdr).clrTextBk = 0 then // PNMTVCustomDraw(AMsg.NMHdr).clrTextBk := GMRGBColor(BkgndColor); // if AssignTextBkColor(node) then PNMTVCustomDraw(AMsg.NMHdr).clrTextBk := GMRGBColor(BkgndColor); AMsg.Result := node.DoBeforeDraw(PNMTVCustomDraw(AMsg.NMHdr)); end; CDDS_ITEMPOSTPAINT: begin // AMsg.Result := CDRF_DODEFAULT; node := CreateNodeWrapper(HTreeItem(PNMTVCustomDraw(AMsg.NMHdr).nmcd.dwItemSpec)); AMsg.Result := node.DoAfterDraw(PNMTVCustomDraw(AMsg.NMHdr)); // if GMGetDataObject(node) is TGMWccTreeNodeData then AMsg.Result := (GMGetDataObject(node) as TGMWccTreeNodeData).DoAfterDraw(PNMTVCustomDraw(AMsg.NMHdr)); //if Assigned(OnAfterItemDraw) then AMsg.Result := OnAfterItemDraw(Self, PNMTVCustomDraw(AMsg.NMHdr)); end; //else inherited; end; end; FPassMessageToOriginalHandler := False; // <- dont let ForgWndProc overwrite AMsg.Result! end; procedure TGMTreeView.UnselectOtherNodes; begin if FSelectedNodeCount > 0 then GMVisitNodesRootFirst(RootNode, UnselectNode); end; procedure TGMTreeView.GetSelectedNodes(var ANodes: TIGMWccTreeNodeArray); begin GMVisitNodesRootFirst(RootNode, AddSelectedNode, True, @ANodes); end; function TGMTreeView.CreateDataObjFromClass(const ANode: IUnknown; const AClass: TClass; const AClassName: TGMString): TObject; begin if GMIsClass(AClass, TGMWccTreeNodeData) then Result := TGMWccTreeNodeDataClass(AClass).Create(Self, HTreeItem(GMGetIntfHandle(ANode))) else Result := nil; end; function TGMTreeView.CreateTreeNodeWithDataObj(const ASource: IGMValueStorage; const AParentNode: IGMTreeable; const AParameter: IUnknown): IGMTreeable; var parentNode: IGMWccTvNode; getHandle: IGMGetHandle; InsterAfter: HTreeItem; setHandle: IGMGetSetHandle; dataClassName: TGMString; begin if ASource = nil then Exit; GMQueryInterface(AParentNode, IGMWccTvNode, parentNode); if GMQueryInterface(AParameter, IGMGetHandle, getHandle) then InsterAfter := HTreeItem(getHandle.Handle) else InsterAfter := TVI_LAST; Result := InsertNode(TVItemRec(nil, TVIF_DI_SETITEM, PGMChar(ASource.ReadString(cStrTitle)), ASource.ReadInteger(cStrImageIndex, cUnkImgIdx), ASource.ReadInteger(cStrSelectedImgIdx, cUnkImgIdx)), parentNode, nil, InsterAfter); dataClassName := ASource.ReadString(cStrDataClassName); GMSetDataObject(Result, CreateDataObjFromClass(Result, GMFindRegisteredClass(dataClassName), dataClassName)); if GMQueryInterface(AParameter, IGMGetSetHandle, setHandle) then setHandle.Handle := THandle(TVI_LAST); end; function TGMTreeView.CreateNewTreeNode(const AParentNode: IGMTreeable; const ATitle: TGMString; const AImgIdx, ASelectedImgIdx: Integer; const ADataObj: TObject; const AParameter: IUnknown): IGMTreeable; stdcall; var parentNode: IGMWccTvNode; getHandle: IGMGetHandle; InsterAfter: HTreeItem; setHandle: IGMGetSetHandle; begin GMQueryInterface(AParentNode, IGMWccTvNode, parentNode); if GMQueryInterface(AParameter, IGMGetHandle, getHandle) then InsterAfter := HTreeItem(getHandle.Handle) else InsterAfter := TVI_LAST; Result := InsertNode(TVItemRec(nil, TVIF_DI_SETITEM, PGMChar(ATitle), AImgIdx, ASelectedImgIdx), parentNode, ADataObj, InsterAfter); if GMQueryInterface(AParameter, IGMGetSetHandle, setHandle) then setHandle.Handle := THandle(TVI_LAST); end; procedure TGMTreeView.StoreUIState(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); stdcall; begin if ADest = nil then Exit; {$IFDEF CPU64} GMStoreInt64(ADest, cStrSelectedNodeIdx, SelectedItem, cInvalidItemIdx); {$ELSE} GMStoreInteger(ADest, cStrSelectedNodeIdx, SelectedItem, cInvalidItemIdx); {$ENDIF} GMStoreInteger(ADest, cStrVScrollPos, GMScrollDataFromWnd(FHandle, SB_VERT, SIF_POS).nPos, cDfltScrollPos); GMStoreInteger(ADest, cStrHScrollPos, GMScrollDataFromWnd(FHandle, SB_HORZ, SIF_POS).nPos, cDfltScrollPos); end; procedure TGMTreeView.StoreData(const ADest: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); stdcall; var threadSync: RGMCriticalSectionLock; mousePtrWait, paintDisabler: IUnknown; nodeIdx: Integer; begin if ADest = nil then Exit; threadSync.Lock(ADest); mousePtrWait := TGMTempCursor.Create(vGMWaitCursor); paintDisabler := TGMWndPaintDisabler.Create(GMHWndFromWndObj(-Int64(Self))); //GMStoreInteger(ADest, cStrAttributes, TVAttributesToInt(Attributes), TVAttributesToInt(cDfltTVAttributes)); StoreUIState(ADest, ACryptCtrlData); nodeIdx := 0; GMStoreTree(ADest, RootNode, nodeIdx, True, ACryptCtrlData); end; procedure TGMTreeView.DoAfterLoad(const ANode: IGMTreeable); begin // Nothing, may be used by derived classes for linking nodes etc. end; procedure TGMTreeView.LoadSubNodes(const ASource: IGMValueStorage; const AParentNode: IGMTreeable; const AInsterAfter: HTreeItem; const ACryptCtrlData: PGMCryptCtrlData); var InsertAfterObj: IGMGetHandle; begin InsertAfterObj := TGMMutableHandleObj.Create(THandle(AInsterAfter)); GMVsdLoadTree(ASource, AParentNode, Self, InsertAfterObj, ACryptCtrlData); if AParentNode = nil then DoAfterLoad(RootNode) else DoAfterLoad(AParentNode); end; procedure TGMTreeView.LoadData(const ASource: IGMValueStorage; const ACryptCtrlData: PGMCryptCtrlData); stdcall; var threadSync: RGMCriticalSectionLock; mousePtrWait, paintDisabler: IUnknown; scrollPos: TPoint; selIdx: PtrInt; //procedure SetScrollPos(APos: LongInt); //var scroll: TScrollInfo; //begin // scroll := Default(TScrollInfo); // scroll := GMScrollData(SIF_POS, 0, 0 ,0, APos); // SetScrollInfo(FHandle, SB_VERT, scroll, True); //end; begin if ASource = nil then Exit; threadSync.Lock(ASource); mousePtrWait := TGMTempCursor.Create(vGMWaitCursor); paintDisabler := TGMWndPaintDisabler.Create(GMHWndFromWndObj(-Int64(Self))); //Attributes := TVAttributesFromInt(ASource.ReadInteger(cStrAttributes, TVAttributesToInt(cDfltTVAttributes))); {$IFDEF CPU64} SelIdx := ASource.ReadInt64(cStrSelectedNodeIdx, cInvalidItemIdx); {$ELSE} selIdx := ASource.ReadInteger(cStrSelectedNodeIdx, cInvalidItemIdx); {$ENDIF} scrollPos.y := ASource.ReadInteger(cStrVScrollPos, cDfltScrollPos); scrollPos.x := ASource.ReadInteger(cStrHScrollPos, cDfltScrollPos); LoadSubNodes(ASource, nil, TVI_LAST, ACryptCtrlData); //paintDisabler := nil; //GMProcessAllMessages; if GMIsInRange(selIdx, 0, NodeCount-1) then SelectedItem := selIdx; if HandleAllocated then begin // PostMessage because this may be called from CreateWnd PostMessage(FHandle, WM_VSCROLL, MAKEWPARAM(SB_THUMBPOSITION, scrollPos.y), 0); // <- does'nt work //SetScrollPos(scrollPos.y); // <- does'nt work //PostMessage(FHandle, WM_VSCROLL, SB_LINEDOWN, 0); // <- does work! PostMessage(FHandle, WM_HSCROLL, MAKEWPARAM(SB_THUMBPOSITION, scrollPos.x), 0); // <- does'nt work end; end; end.