{ +-------------------------------------------------------------+ } { | | } { | GM-Software | } { | =========== | } { | | } { | Project: All Projects | } { | | } { | Description: Controls offered by the underlying | } { | Operating System. | } { | | } { | Copyright (C) - 2012 - Gerrit Moeller. | } { | | } { | Source code dstributed under MIT license. | } { | | } { | See: https://www.gm-software.de | } { | | } { +-------------------------------------------------------------+ } {$INCLUDE GMCompilerSettings.inc} unit GMOsCtrls; interface uses {$IFDEF JEDIAPI}jwaWinType, jwaWinUser,{$ELSE}Windows,{$ENDIF} GMMessages, GMStrDef, GMIntf, GMCommon, GMGdi, GMUICore, GMxCtrls {$IFDEF RICHEDIT}, GMRichEdit, GMActiveX{$ENDIF}; const {$EXTERNALSYM BS_TYPEMASK} BS_TYPEMASK = $F; {$EXTERNALSYM ECM_FIRST} ECM_FIRST = $1500; {$EXTERNALSYM EM_SETCUEBANNER} EM_SETCUEBANNER = ECM_FIRST + 1; cWin2DDirections: array [TGM2DDirection] of LongInt = (SB_HORZ, SB_VERT); cWinBtnCheck: array [Boolean] of LongInt = (BST_UNCHECKED, BST_CHECKED); type RGMUiItemData = record Title: TGMString; Data: PtrInt; end; PGMUiItemDataArray = ^TGMUiItemDataArray; TGMUiItemDataArray = array of RGMUiItemData; TGMEditBase = class(TGMNCWinControl) protected FMaxEditLength: PtrInt; FTextWhenEmpty: UnicodeString; // <- Must be UnicodeString! Because EM_SETCUEBANNER is only supported as Unicode! FOnBeforeTextChange: TGMObjNotifyProc; FOnAfterTextChange: TGMObjNotifyProc; procedure WMGetDlgCode(var AMsg: TMessage); message WM_GETDLGCODE; // TWMGetDlgCode procedure WMAppCommand(var AMsg: TWMCommand); message WM_COMMAND + WM_APP; procedure WMChar(var Msg: TWMKey); message WM_CHAR; //procedure WMPrint(var Msg: TMessage); message WM_PRINT; //procedure WMPaint(var Msg: TWMPaint); message WM_PAINT; //procedure UMHandleCreated(var Msg: TMessage); message UM_HANDLECREATED; procedure SetMaxEditLength(const AValue: PtrInt); procedure SetText(const AValue: TGMString); override; procedure SetOnBeforeTextChange(const AValue: TGMObjNotifyProc); virtual; procedure SetOnAfterTextChange(const AValue: TGMObjNotifyProc); virtual; public //OnBeforeTextChange: TGMObjNotifyProc; //OnAfterTextChange: TGMObjNotifyProc; constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString = cDfltWndText; const AWndStyle: DWORD = cVisibleTabstop; const AWndExStyle: DWORD = cDfltWndExStyle; const ABkgndColor: COLORREF = clrWindow; const ARefLifeTime: Boolean = False); override; procedure SelectAll; procedure Clear(const ANotify: Boolean = True); override; function RegisterWndClass: TGMString; override; //function ExecuteOperation(const AOperation: LongInt; const AParameter: IUnknown): Boolean; override; procedure InternalCreateHandle; override; procedure SetTextWhenEmpty(const AValue: UnicodeString); function FillsComplete: Boolean; override; property OnBeforeTextChange: TGMObjNotifyProc read FOnBeforeTextChange write SetOnBeforeTextChange; property OnAfterTextChange: TGMObjNotifyProc read FOnAfterTextChange write SetOnAfterTextChange; property MaxEditLength: PtrInt read FMaxEditLength write SetMaxEditLength; property TextWhenEmpty: UnicodeString read FTextWhenEmpty write SetTextWhenEmpty; // <- Must be UnicodeString! Because EM_SETCUEBANNER is only supported as Unicode! end; TGMEdit = Class(TGMEditBase) //protected //procedure WMChar(var Msg: TWMChar); message WM_CHAR; //procedure WMPaste(var Msg: TMessage); message WM_PASTE; //procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE; public constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString = cDfltWndText; const AWndStyle: DWORD = cVisibleTabstop; const AWndExStyle: DWORD = cDfltWndExStyle; const ABkgndColor: COLORREF = clrWindow; const ARefLifeTime: Boolean = False); override; procedure InternalCreateHandle; override; end; TGMFramedEdit = class(TGMEditBase) //protected //procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS; public constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString = cDfltWndText; const AWndStyle: DWORD = cVisibleTabstop; const AWndExStyle: DWORD = cDfltWndExStyle; const ABkgndColor: COLORREF = clrWindow; const ARefLifeTime: Boolean = False); override; //procedure FinalizeShow; override; end; TGMColorTextFramedEdit = class(TGMFramedEdit, IGMSetFonColor) protected FFontColor: COLORREF; public constructor Create(const ARefLifeTime: Boolean = False); override; procedure SetFontColor(const AColor: COLORREF); function FontColor: COLORREF; override; end; TGMMemo = Class(TGMEditBase) public constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString = cDfltWndText; const AWndStyle: DWORD = cVisibleTabstop; const AWndExStyle: DWORD = cDfltWndExStyle; const ABkgndColor: COLORREF = clrWindow; const ARefLifeTime: Boolean = False); override; end; TGMComboBox = class; TGMComboBoxEdit = class(TGMOEMControl) protected FComboBox: TGMComboBox; procedure WMKeyDown(var Msg: TWMKeyDown); message WM_KEYDOWN; // procedure WMAppCommand(var Msg: TWMCommand); message WM_COMMAND + WM_APP; // procedure EMSetSel(var Msg: TMessage); message EM_SETSEL; // procedure WMSysKeyDown(var Msg: TWMKeyDown); message WM_SYSKEYDOWN; // procedure WMGetDlgCode(var Msg: TMessage); message WM_GETDLGCODE; public constructor Create(const AComboBox: TGMComboBox; const AHandle: HWnd; const AText: TGMString; const ABkgndColor: COLORREF; const ARefLifeTime: BOolean); reintroduce; overload; procedure SurfaceOriginChanged; override; function IsDialogKeyMsg(const Msg: TMessage): Boolean; override; end; TGMComboBox = class(TGMOEMControl) protected FEditWnd: IGMGetHandle; FSelectedIndex: PtrInt; FCalculatedMinWidth: LongInt; FTextWhenEmpty: UnicodeString; //FOnAfterSelectionChange: TGMObjNotifyProc; //FOnAfterEditTextChange: TGMObjNotifyProc; procedure CBResetContent(var Msg: TWMKeyDown); message CB_RESETCONTENT; procedure WMKeyDown(var Msg: TWMKeyDown); message WM_KEYDOWN; procedure WMAppCommand(var Msg: TWMCommand); message WM_COMMAND + WM_APP; procedure WMGetDlgCode(var Msg: TMessage); message WM_GETDLGCODE; procedure UMHandleCreated(var Msg: TMessage); message UM_HANDLECREATED; procedure WMMouseWheel(var Msg: TMessage); message WM_MOUSEWHEEL; procedure FillDropValues; virtual; public OnAfterSelectionChange: TGMObjNotifyProc; OnAfterEditTextChange: TGMObjNotifyProc; constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString = cDfltWndText; const AWndStyle: DWORD = cVisibleTabstop; const AWndExStyle: DWORD = cDfltWndExStyle; const ABkgndColor: COLORREF = clrWindow; const ARefLifeTime: Boolean = False); override; procedure Clear(const ANotify: Boolean = True); override; procedure LanguageChanged(const ANewLanguage: LParam); override; function IsDialogKeyMsg(const Msg: TMessage): Boolean; override; //function ExecuteOperation(const Operation: Integer; const Parameter: IUnknown): Boolean; override; function InternalCalcWidth(const ANewSize: TPoint): LongInt; override; procedure InternalCreateHandle; override; function WndCreateRect: TRect; override; function RegisterWndClass: TGMString; override; function IsPopupWindow: Boolean; override; function GetListBoxString(const AIndex: PtrInt): TGMString; function GetItemData(const AItemIdx: PtrInt): PtrInt; function GetItemCount: PtrInt; procedure SelectAll; function SelectString(const AValue: TGMString; const ANotifyOnChange: Boolean): PtrInt; function SelectItemData(const AItemData: PtrInt; const ANotifyOnChange: Boolean): PtrInt; function GetSelectedIndex: PtrInt; procedure SetSelectedIndex(const AIndex: PtrInt); function GetCBInfo: TComboBoxInfo; procedure SetTextWhenEmpty(const AValue: UnicodeString); property SelectedIndex: PtrInt read GetSelectedIndex write SetSelectedIndex; property TextWhenEmpty: UnicodeString read FTextWhenEmpty write SetTextWhenEmpty; //procedure FinalizeShow; override; //procedure WindowProc(var Msg: TMessage); override; //function CalculateHeight(const NewSize: TPoint): LongInt; override; //property OnAfterSelectionChange: TGMObjNotifyProc read FOnAfterSelectionChange write FOnAfterSelectionChange; //property OnAfterEditTextChange: TGMObjNotifyProc read FOnAfterEditTextChange write FOnAfterEditTextChange; end; {$IFDEF RICHEDIT} TGMRichTextEdit = class(TGMEditBase, IGMSetFonColor) // TGMNCWinControl protected FEventMask: PtrInt; FInitialEreaseBkngd: Boolean; //procedure UMFocusEnter(var Msg: TMessage); message UM_FOCUSENTER; //procedure WMGetDlgCode(var Msg: TMessage); message WM_GETDLGCODE; procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND; // procedure WMPrintClient(var Msg: TMessage); message WM_PRINTCLIENT; procedure SetOnBeforeTextChange(const AValue: TGMObjNotifyProc); override; procedure SetOnAfterTextChange(const AValue: TGMObjNotifyProc); override; public constructor Create(const ARefLifeTime: Boolean = False); override; //constructor Create(const AParent: TGMWndObj; // const APosition: TRect; // const AAreaAlign: TGMAreaAlignRec; // const AText: TGMString = cDfltWndText; // const AWndStyle: DWORD = cVisibleTabstop; // const AWndExStyle: DWORD = cDfltWndExStyle; // const ABkgndColor: COLORREF = clrWindow; // const ARefLifeTime: Boolean = False); override; function RegisterWndClass: TGMString; override; procedure InternalCreateHandle; override; procedure SaveToStream(const AStream: IStream; const AFormat: PtrInt = SF_RTF); procedure LoadFromStream(const AStream: IStream; const AFormat: PtrInt = SF_RTF); //procedure Print(const Caption: TGMString); procedure SetFontColor(const AColor: COLORREF); end; {$ENDIF} TGMScollPosChangeProc = procedure (const AOldPos, ANewPos: LongInt) of Object; TGMCalcIntegerFunc = function: LongInt of object; TGMScrollBar = class(TGMOEMControl, IGMScrollBar) protected FDirection: TGM2DDirection; FMin, FMax, FPage, FPos: LongInt; procedure WMAppHScroll(var Msg: TWMScroll); message WM_HSCROLL + WM_APP; procedure WMAppVScroll(var Msg: TWMScroll); message WM_VSCROLL + WM_APP; //procedure UMHandleCreated(var Msg: TMessage); message UM_HANDLECREATED; procedure SetScrollData(const AScrollData: TScrollInfo; const ARedraw: Boolean = True); function GetPosition: PtrInt; stdcall; procedure SetPosition(const AValue: PtrInt); stdcall; function GetMinPosition: LongInt; stdcall; procedure SetMinPosition(const Value: LongInt); stdcall; function GetMaxPosition: LongInt; stdcall; procedure SetMaxPosition(const Value: LongInt); stdcall; function GetPageSize: LongInt; stdcall; procedure SetPageSize(const Value: LongInt); stdcall; function CalcPageSize: LongInt; procedure HandleScroll(var Msg: TWMScroll); procedure SetupArrows(const AScrollData: TScrollInfo); //procedure DisableIfNoScroll; public OnCalcPageSize: TGMCalcIntegerFunc; OnScrollPosChange: TGMScollPosChangeProc; constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ADirection: TGM2DDirection; const AOnScrollPosChanged: TGMScollPosChangeProc = nil; const AWndStyle: DWORD = WS_VISIBLE; const AWndExStyle: DWORD = cDfltWndExStyle; const ABkgndColor: COLORREF = cDfltColor; const ARefLifeTime: Boolean = False); reintroduce; overload; //procedure InternalCreateHandle; override; function InternalCalcWidth(const NewSize: TPoint): LongInt; override; function InternalCalcHeight(const NewSize: TPoint): LongInt; override; procedure InternalCreateHandle; override; procedure WindowProc(var Msg: TMessage); override; function HBkgndBrush: THandle; override; function RegisterWndClass: TGMString; override; procedure SetLayoutBounds(const Value: TRect; const Repaint: Boolean); override; procedure ResetValues; procedure SetupPageSize; property Position: PtrInt read GetPosition write SetPosition; property MinPosition: LongInt read GetMinPosition write SetMinPosition; property MaxPosition: LongInt read GetMaxPosition write SetMaxPosition; property PageSize: LongInt read GetPageSize write SetPageSize; end; TGMScrollingWinCtrl = class(TGMWinControl) protected FContainedSize: TPoint; procedure WMHScroll(var Msg: TWMScroll); message WM_HSCROLL; // + WM_APP; procedure WMVScroll(var Msg: TWMScroll); message WM_VSCROLL; // + WM_APP; procedure WMMouseWheel(var Msg: TWMMouseWheel); message WM_MOUSEWHEEL; procedure DoScroll(const ADirection: TGM2DDirection; var AScrollOrigin: LongInt; const ANewPos: LongInt); procedure DoScrollMsg(const ADirection: TGM2DDirection; var AScrollOrigin: Integer; var Msg: TWMScroll); procedure ScrollToVPosition(const ADirection: TGM2DDirection; const APosition: Integer); public procedure ShowScrollBarsIfNeeded; procedure LayoutContainedAreas(const ARepaint: Boolean); override; //: TPoint; procedure ScrollRectVisible(const ARect: TRect); procedure ScrollAreaVisible(const AArea: TObject); end; TGMButton = class(TGMOEMControl, IGMIsDefaultDlgBtn) protected FOnClick: TGMObjNotifyProc; FHFont: THandle; // procedure WMMouseWheel(var Msg: TWMMouseWheel); message WM_MOUSEWHEEL; procedure WMAppCommand(var Msg: TWMCommand); message WM_COMMAND + WM_APP; //procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS; //procedure WMGetDlgCode(var Msg: TMessage); message WM_GETDLGCODE; // TWMGetDlgCode procedure WMKeyDown(var Msg: TWMKeyDown); message WM_KEYDOWN; //procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND; public constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString = cDfltWndText; const AOnClick: TGMObjNotifyProc = nil; const AWndStyle: DWORD = cVisibleTabstop; const AWndExStyle: DWORD = cDfltWndExStyle; const ABkgndColor: COLORREF = cDfltColor; const AHFont: HFONT = 0; const ARefLifeTime: Boolean = False); reintroduce; overload; function IsDefaultDlgBtn: Boolean; function FontHandle: THandle; override; function IsDialogKeyMsg(const Msg: TMessage): Boolean; override; function RegisterWndClass: TGMString; override; //procedure WindowProc(var Msg: TMessage); override; procedure Click(const ASender: TObject = nil); virtual; function FillsComplete: Boolean; override; //function PaintsComplete: Boolean; override; function InternalCalcHeight(const NewSize: TPoint): LongInt; override; function InternalCalcWidth(const NewSize: TPoint): LongInt; override; property OnClick: TGMObjNotifyProc read FOnClick write FOnClick; end; TGMMinWidthBtn = class(TGMButton) // // Never narrower than cDlgBtnWidth // public function InternalCalcWidth(const NewSize: TPoint): LongInt; override; end; TGMBtnImgKind = (bikIcon, bikBitmap); TGMImageButton = class(TGMMinWidthBtn) protected FImageKind: TGMBtnImgKind; FImage: THandle; FDestroyImage: Boolean; public constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString = ''; const AImage: THandle = 0; const AImageKind: TGMBtnImgKind = bikIcon; const ADestroyImage: Boolean = False; const AOnClick: TGMObjNotifyProc = nil; const AWndStyle: DWORD = cVisibleTabstop; const AWndExStyle: DWORD = cDfltWndExStyle; const ABkgndColor: COLORREF = cDfltColor; const ARefLifeTime: Boolean = False); reintroduce; overload; destructor Destroy; override; procedure InternalCreateHandle; override; // function CalculateWidth(const NewSize: TPoint): LongInt; override; end; TGMDlgButton = class(TGMMinWidthBtn) protected FBtnKind: TDlgBtnKind; public constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ABtnKind: TDlgBtnKind; const AWndStyle: DWORD = cVisibleTabstop; const ABkgndColor: COLORREF = cDfltColor; const ARefLifeTime: Boolean = False); reintroduce; overload; // procedure SetBtnKind(const ABtnKind: TDlgBtnKind); procedure Click(const ASender: TObject = nil); override; property ButtonKind: TDlgBtnKind read FBtnKind write FBtnKind; end; TGMDlgButtonClass = class of TGMDlgButton; TGMCheckButton = class(TGMButton) protected FChecked: Boolean; // <- used when window handle is not allocated function GetChecked: Boolean; procedure SetChecked(const AValue: Boolean); procedure InternalCreateHandle; override; public procedure Clear(const ANotify: Boolean = True); override; function InternalCalcWidth(const NewSize: TPoint): LongInt; override; function InternalCalcHeight(const NewSize: TPoint): LongInt; override; //function ExecuteOperation(const Operation: Integer; const Parameter: IUnknown): Boolean; override; property Checked: Boolean read GetChecked write SetChecked; end; TGMRadioButton = class(TGMCheckButton) public constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString = cDfltWndText; const AWndStyle: DWORD = cVisibleTabstop; const AWndExStyle: DWORD = cDfltWndExStyle; const ABkgndColor: COLORREF = cDfltColor; const ARefLifeTime: Boolean = False); override; end; TGMCheckBox = class(TGMCheckButton) public constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString = cDfltWndText; const AWndStyle: DWORD = cVisibleTabstop; const AWndExStyle: DWORD = cDfltWndExStyle; const ABkgndColor: COLORREF = cDfltColor; const ARefLifeTime: Boolean = False); override; end; //const // //cDfltDlgBtnCreateClass: TGMDlgButtonClass = TGMDlgButton; // //type TDlgButtons = array [TDlgBtnKind] of TGMDlgButton; TGMDlgBottomArea = class(TGMUiArea) protected FButtons: TDlgButtons; public constructor Create(const AParent: TObject; const AButtons: TDlgBtnKinds; const ADfltBtn: TDlgBtnKind = dbkNone; //const ADlgSpace: LongInt = cDlgSpace; ABtnCreateClass: TGMDlgButtonClass = nil; // cDfltDlgBtnCreateClass; const ABkgndColor: COLORREF = cDfltColor; const AHeight: LongInt = cDlgBtnAreaHeight; const ARefLifeTime: Boolean = False); reintroduce; overload; property Buttons: TDlgButtons read FButtons; end; function GMInitUiItemData(const ATitle: TGMString; const AData: PtrInt = 0): RGMUiItemData; procedure GMAddUiItemDataToArray(const AItemData: RGMUiItemData; var AItems: TGMUiItemDataArray); procedure GMFillComboBox(const AComboBox: TObject; const AItems: array of RGMUiItemData; const ARemoveExisting: Boolean = True); procedure GMFillComboBoxFromStrings(const AComboBox: TObject; const AStrings: array of TGMString; const ARemoveExisting: Boolean = True); procedure GMFillComboBoxFromCollection(const AComboBox: TObject; const ACollection: IUnknown; const ARemoveExisting: Boolean = True); function GMInsertLabeledCtrl(const ADisplayName: TGMString; const ALabelParent, CtlParent: TObject; const ACtrlClass: TGMWinControlClass; const AWndstyle: DWORD = 0; // cVisibleTabstop; const ACtlColor: COLORREF = clrWindow; const ABkgndColor: COLORREF = cDfltColor; const ADlgSpace: LongInt = cDlgSpace; const ACtlHeight: LongInt = cEditHeight; ACtlSpace: LongInt = 0): TGMLabelAndCtrlRec; implementation uses GMCollections {$IFDEF JEDIAPI}{$IFDEF RICHEDIT}, jwaWinError{$ENDIF}, jwaWinGdi{$ENDIF}; {$IFDEF RICHEDIT} //const cStrRichEditDLL = 'Riched32.dll'; const cStrRichEditDLL = 'Msftedit.dll'; // 'Riched20.dll'; //resourcestring RStrRichEditNotFound = cStrRichEditDLL + ' not Found'; var vRichEditDLL: IGMGetHandle = nil; {$ENDIF} { ------------------------- } { ---- Global Routines ---- } { ------------------------- } function GMInitUiItemData(const ATitle: TGMString; const AData: PtrInt): RGMUiItemData; begin Result.Title := ATitle; Result.Data := AData; end; procedure GMAddUiItemDataToArray(const AItemData: RGMUiItemData; var AItems: TGMUiItemDataArray); begin SetLength(AItems, Length(AItems)+1); AItems[High(AItems)] := AItemData; end; function GMInsertLabeledCtrl(const ADisplayName: TGMString; const ALabelParent, CtlParent: TObject; const ACtrlClass: TGMWinControlClass; const AWndstyle: DWORD; const ACtlColor: COLORREF; const ABkgndColor: COLORREF; const ADlgSpace, ACtlHeight: LongInt; ACtlSpace: LongInt): TGMLabelAndCtrlRec; var IsLabeled: Boolean; ctlText: TGMString; TopSpace: LongInt; //resTextRef: RGMResTextRefData; begin //FillByte(Result, SizeOf(Result), 0); Result := Default(TGMLabelAndCtrlRec); if ACtrlClass = nil then Exit; //resTextRef := GMResTextRefDataRec(nil); //ADisplayName := GMResolveTextResData(ADisplayName, resTextRef); IsLabeled := not GMIsClass(ACtrlClass, TGMCheckButton); // (ACtrlClass <> TGMRadioButton) and (ACtrlClass <> TGMCheckBox); if ACtlSpace = 0 then ACtlSpace := c2CtlSpace; //ADlgSpace; if (ALabelParent is TGMUiAreaBase) and TGMUiAreaBase(ALabelParent).ContainedAreas.IsEmpty then TopSpace := ADlgSpace else TopSpace := cCtlSpace; if (ADisplayName = '') or not IsLabeled then Result.Label_ := GMOwnArea(ALabelParent, TGMUiArea.Create(ALabelParent, GMRect(ADlgSpace, TopSpace, ADlgSpace, ACtlHeight), cLabelAlign, ABkgndColor)) else // if resTextRef.ResStringPtr = nil then Result.Label_ := GMOwnArea(ALabelParent, TGMxLabel.Create(ALabelParent, GMRect(ADlgSpace, TopSpace, 0, ACtlHeight), cLabelAlign, cNullRect, ADisplayName, ABkgndColor)); // else // Result.Label_ := GMOwnArea(ALabelParent, TGMxResLabel.Create(ALabelParent, GMRect(ADlgSpace, TopSpace, 0, ACtlHeight), cLabelAlign, cNullRect, resTextRef, '%s:', ABkgndColor)); if IsLabeled then ctlText := '' else ctlText := ADisplayName; Result.Ctrl := GMOwnArea(CtlParent, ACtrlClass.Create(-Int64(CtlParent), GMRect(ACtlSpace, TopSpace, ADlgSpace, ACtlHeight), cTopAligned, ctlText, cVisibleTabstop or AWndstyle, 0, ACtlColor)); //Inc(Top, ACtlHeight + cCtlSpace); end; procedure GMFillComboBox(const AComboBox: TObject; const AItems: array of RGMUiItemData; const ARemoveExisting: Boolean); var i, wMax, idx: LongInt; // wnd: THandle; txt: TGMString; textResetNeeded: Boolean; selIdx begin if not (AComboBox is TGMUiAreaBase) then Exit; // or not GMGetAllocatedObjHandle(AComboBox, wnd) //selIdx := GMSendObjMessage(AComboBox, CB_GETCURSEL); GMSendObjMessage(AComboBox, CB_RESETCONTENT); // <- will reset selected index too //if ARemoveExisting then // GMSendObjMessage(AComboBox, CB_RESETCONTENT); <- Would reset selected index too // for i:=GMSendObjMessage(AComboBox, CB_GETCOUNT)-1 downto 0 do GMSendObjMessage(AComboBox, CB_DELETESTRING, i); // // CB_SETDROPPEDWIDTH does a SelectAll, we want to prevent that, resetting to empty text helps // //textResetNeeded := GetWindowLong(wnd, GWL_STYLE) and $000f = CBS_DROPDOWNLIST; //if textResetNeeded then // begin // txt := GMGetObjText(AComboBox); // GMSetObjText(AComboBox, ''); // end; //try // Calculate max width of drop strings in pixels wMax := 0; for i:=Low(AItems) to High(AItems) do begin idx := GMSendObjMessage(AComboBox, CB_ADDSTRING, 0, LPARAM(PGMChar(AItems[i].Title))); wMax := Max(wMax, GMTextExtent(AItems[i].Title, TGMUiAreaBase(AComboBox).FontHandle).x); if (idx >= 0) and (AItems[i].Data <> 0) then GMSendObjMessage(AComboBox, CB_SETITEMDATA, idx, AItems[i].Data); end; // Set width of drop window to show strings in full length if wMax > 0 then begin if GMWinVersion >= wvVista then Inc(wMax, GetSystemMetrics(SM_CXVSCROLL)); GMSendObjMessage(AComboBox, CB_SETDROPPEDWIDTH, wMax + 8, 0); end; //GMPostObjMessage(AComboBox, EM_SETSEL, -1, 0); //finally // if textResetNeeded then GMSetObjText(AComboBox, txt); // if selIdx >= 0 then GMSendObjMessage(AComboBox, CB_SETCURSEL, selIdx); //end; end; procedure GMFillComboBoxFromStrings(const AComboBox: TObject; const AStrings: array of TGMString; const ARemoveExisting: Boolean); var i: Integer; itemDataArr: TGMUiItemDataArray; begin for i:=Low(AStrings) to High(AStrings) do GMAddUiItemDataToArray(GMInitUiItemData(AStrings[i]), itemDataArr); GMFillComboBox(AComboBox, itemDataArr, ARemoveExisting); end; procedure GMFillComboBoxFromCollection(const AComboBox: TObject; const ACollection: IUnknown; const ARemoveExisting: Boolean); var it: IGMIterator; collection: IGMIntfCollection; unkItem: IUnknown; getName: IGMGetName; itemDataArr: TGMUiItemDataArray; dataRec: RGMUiItemData; begin if (AComboBox = nil) or not GMQueryInterface(ACollection, IGMIntfCollection, collection) then Exit; it := collection.CreateIterator; while it.NextEntry(unkItem) and GMQueryInterface(unkItem, IGMGetName, getName) do begin dataRec.Title := getName.Name; dataRec.Data := PtrInt(Pointer(unkItem)); GMAddUiItemDataToArray(dataRec, itemDataArr); end; GMFillComboBox(AComboBox, itemDataArr, ARemoveExisting); end; //procedure GMFillComboBox(const AComboBox: TObject; const AItems: IUnknown; const ARemoveExisting: Boolean); //var it: IGMIterator; collection: IGMIntfCollection; i, WMax, idx: Integer; Wnd: THandle; unkItem: IUnknown; getName: IGMGetName; itemName: UnicodeString; //begin //if not (AComboBox is TGMUiAreaBase) or not GMGetAllocatedObjHandle(AComboBox, Wnd) or // not GMQueryInterface(AItems, IGMIntfCollection, collection) then Exit; // //if ARemoveExisting then // GMSendObjMessage(AComboBox, CB_RESETCONTENT); // for i:=GMSendObjMessage(AComboBox, CB_GETCOUNT)-1 downto 0 do GMSendObjMessage(AComboBox, CB_DELETESTRING, i); // //WMax := 0; //it := collection.CreateIterator; //while it.NextEntry(unkItem) and GMQueryInterface(unkItem, IGMGetName, getName) do // begin //// itemName := getName.Name; // idx := GMSendObjMessage(AComboBox, CB_ADDSTRING, 0, PtrInt(PGMChar(getName.Name))); // WMax := Max(WMax, GMTextExtent(getName.Name, TGMUiAreaBase(AComboBox).FontHandle).x); // if (idx >= 0) then GMSendObjMessage(AComboBox, CB_SETITEMDATA, idx, LParam(Pointer(unkItem))); // end; //if WMax <= 0 then Exit; //if GMWinVersion >= wvVista then Inc(WMax, GetSystemMetrics(SM_CXVSCROLL)); //GMSendObjMessage(AComboBox, CB_SETDROPPEDWIDTH, WMax + 8, 0); //end; {$IFDEF RICHEDIT} procedure LoadRichEditDLL; begin if vRichEditDLL = nil then vRichEditDLL := TGMDLLHandleObj.Create(cStrRichEditDLL, True); //if vRichEditDLL.Handle = 0 then // begin // vRichEditDLL := nil; // raise EGMException.ObjError(RStrRichEditNotFound, nil, 'LoadRichEditDLL'); // end; {if vRichEditDLL = nil then vRichEditDLL := TGMDLLHandleObj.Create('Riched20.dll'); Result := rev20; if vRichEditDLL.Handle = 0 then begin vRichEditDLL := TGMDLLHandleObj.Create('Riched32.dll'); if vRichEditDLL.Handle = 0 then begin vRichEditDLL := nil; raise EGMException.ObjError(RStrRichEditNotFound, nil, 'LoadRichEditDLL'); end; Result := rev20; end;} end; {$ENDIF} { --------------------- } { ---- TGMEditBase ---- } { --------------------- } // // Single Row edit controls neither print frame nor client // MUlti Row edit controls dont print frame // Single Row edits only adjust their edit rect nicely when they have a client edge // Edit controls properly handle WM_PRINT on fade out, so it may be some state problem on fade in // constructor TGMEditBase.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString; const AWndStyle: DWORD; const AWndExStyle: DWORD; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); const cAutoHScroll: array [Boolean] of DWORD = (0, ES_AUTOHSCROLL); begin inherited Create(AParent, APosition, AAreaAlign, AText, AWndStyle or cAutoHScroll[AWndStyle and ES_MULTILINE = 0], AWndExStyle, ABkgndColor, ARefLifeTime); end; function TGMEditBase.RegisterWndClass: TGMString; begin Result := 'EDIT'; end; {procedure TGMEditBase.WMPaint(var Msg: TWMPaint); begin // Nothing! end;} {procedure TGMEditBase.WMPrintClient(var Msg: TMessage); begin if WndStyle and ES_MULTILINE = 0 then begin GMPrintClientImpl(Handle, HDC(Msg.WParam), HBkgndBrush); FPassMessageToOriginalHandler := False; end; end;} procedure TGMEditBase.SetTextWhenEmpty(const AValue: UnicodeString); begin if AValue = FTextWhenEmpty then Exit; FTextWhenEmpty := AValue; if HandleAllocated then SendMessage(FHandle, EM_SETCUEBANNER, 0, LPARAM(PWideChar(FTextWhenEmpty))); end; function TGMEditBase.FillsComplete: Boolean; begin //Result := inherited FillsComplete; Result := True; end; procedure TGMEditBase.InternalCreateHandle; begin inherited InternalCreateHandle; if FMaxEditLength > 0 then GMSendObjMessage(Self, EM_LIMITTEXT, FMaxEditLength); if Length(FTextWhenEmpty) > 0 then SendMessage(FHandle, EM_SETCUEBANNER, 0, LPARAM(PWideChar(FTextWhenEmpty))); end; //function TGMEditBase.ExecuteOperation(const AOperation: LongInt; // const AParameter: IUnknown): Boolean; //begin // case AOperation of // Ord(opClear): begin Text := ''; Result := True; end; // else Result := inherited ExecuteOperation(AOperation, AParameter); // end; //end; procedure TGMEditBase.SetText(const AValue: TGMString); var doNotify: Boolean; begin // // Edit controls with ES_MULTILINE don't send EN_CHANGE notifications when the text is changed via WM_SETTEXT // doNotify := HandleAllocated and (WndStyle and ES_MULTILINE <> 0) and (AValue <> Text); if doNotify and Assigned(OnBeforeTextChange) then OnBeforeTextChange(Self); inherited SetText(AValue); if doNotify and Assigned(OnAfterTextChange) then OnAfterTextChange(Self); end; procedure TGMEditBase.SetOnBeforeTextChange(const AValue: TGMObjNotifyProc); begin FOnBeforeTextChange := AValue; end; procedure TGMEditBase.SetOnAfterTextChange(const AValue: TGMObjNotifyProc); begin FOnAfterTextChange := AValue; end; procedure TGMEditBase.SetMaxEditLength(const AValue: PtrInt); begin if HandleAllocated then GMSendObjMessage(Self, EM_LIMITTEXT, AValue); FMaxEditLength := AValue; end; //procedure TGMEditBase.WMPrint(var Msg: TMessage); //begin // if (WndStyle and ES_MULTILINE = 0) and (Self is TGMWindow) then TGMWindow(Self).WMPrint(Msg); //end; procedure TGMEditBase.WMGetDlgCode(var AMsg: TMessage); begin if FOrgWndProc <> nil then AMsg.Result := CallWindowProc(FOrgWndProc, FHandle, AMsg.Msg, AMsg.WParam, AMsg.LParam); //else //AMsg.Result := DefWindowProc(FHandle, AMsg.Msg, AMsg.WParam, AMsg.LParam); if WndStyle and ES_READONLY <> 0 then AMsg.Result := AMsg.Result and not (DLGC_WANTTAB or DLGC_WANTALLKEYS); FPassMessageToOriginalHandler := False; // <- dont call FOrgWndProc again, we called it already end; procedure TGMEditBase.WMAppCommand(var AMsg: TWMCommand); begin //inherited; case AMsg.NotifyCode of EN_UPDATE: if Assigned(OnBeforeTextChange) then OnBeforeTextChange(Self); EN_CHANGE: if Assigned(OnAfterTextChange) then OnAfterTextChange(Self); end; FPassMessageToOriginalHandler := False; end; procedure TGMEditBase.SelectAll; begin if HandleAllocated then SendMessage(FHandle, EM_SETSEL, 0, -1); end; procedure TGMEditBase.Clear(const ANotify: Boolean); begin inherited Clear(ANotify); Text := ''; end; //procedure TGMEditBase.UMFocusEnter(var Msg: TMessage); //begin ////SelectAll; //if Msg.LParam and cSelectAll <> 0 then SendMessage(FHandle, EM_SETSEL, 0, -1); //end; procedure TGMEditBase.WMChar(var Msg: TWMKey); begin inherited; case Msg.CharCode of // otherwise select all does not word when readonly or multiline Ord(^A): begin SelectAll; FPassMessageToOriginalHandler := False; end; end; end; //procedure TGMEditBase.WMPrint(var Msg: TMessage); //begin // //if (WndStyle and ES_MULTILINE = 0) and (Self is TGMWindow) then TGMWindow(Self).WMPrint(Msg); //end; {procedure TGMEditBase.WMPrintClient(var Msg: TMessage); var ADC: HDC; Brush: IGMGetHandle; R: TRect; begin if (ExStyle and WS_EX_CLIENTEDGE <> 0) and (Msg.LParam and PRF_NONCLIENT <> 0) and (Msg.WParam <> 0) then begin ADC := HDC(Msg.WParam); Brush := TGMGdiBrush.Create(0, GMRGBColor(cDfltColor)); GetWindowRect(FHandle, R); FillRect(ADC, GMMoveRect(R, -R.Left, -R.Top), Brush.Handle); end; end;} {procedure TGMEditBase.WMSetFocus(var Msg: TWMSetFocus); begin inherited; SelectAll; end;} { ----------------- } { ---- TGMEdit ---- } { ----------------- } constructor TGMEdit.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString; const AWndStyle, AWndExStyle: DWORD; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); begin // Without ES_MULTILINE the edit rect cannot be set inherited; // Create(AParent, APosition, AAreaAlign, AText, AWndStyle or ES_AUTOHSCROLL, AWndExStyle, ABkgndColor, ARefLifeTime); GMSetIntfMultifFrame(Frame, frsLowered, frsLowered); end; {function TGMEdit.FontHeight: LongInt; begin Result := GMFontProperties(FontHandle).lfHeight; if Result = 0 then Result := -12; end;} procedure TGMEdit.InternalCreateHandle; begin //if HandleAllocated then begin inherited CreateHandle; Exit; end else inherited CreateHandle; inherited; SendMessage(FHandle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, MakeLong(2, 2)); //SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN, MakeLong(1, 1)); //AdjustWndEditRect(Handle, FontHeight); end; {procedure TGMEdit.WMGetDlgCode(var Msg: TWMGetDlgCode); begin // we need to be multiline to adjust the edit rect, but we dont want to handle VK_TAB and VK_RETURN //inherited; FPassMessageToOriginalHandler := False; Msg.Result := 0; end;} {procedure TGMEdit.WMPaste(var Msg: TMessage); var Clipboard: IGMClipboard; begin inherited; Clipboard := TGMClipboard.Create(Handle, True); Clipboard.AsText := GMFirstLine(Clipboard.AsText); end;} {procedure TGMEdit.WMPrintClient(var Msg: TMessage); begin //inherited; if (WndStyle and ES_MULTILINE <> 0) or (Msg.WParam = 0) then Exit; GMPrintClientImpl(Handle, HDC(Msg.WParam), HBkgndBrush); end;} {procedure TGMEdit.WMPrint(var Msg: TMessage); begin end;} {procedure TGMEdit.UMHandleCreated(var Msg: TMessage); begin //inherited; if ExStyle and WS_EX_CLIENTEDGE <> 0 then GMHideAndShowWnd(-Int64(Self)); //InvalidateRect(Handle, nil, False); end;} { ----------------------- } { ---- TGMFramedEdit ---- } { ----------------------- } constructor TGMFramedEdit.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString; const AWndStyle, AWndExStyle: DWORD; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); //const CClientEdge: array [Boolean] of DWORD = (0, WS_EX_CLIENTEDGE); begin //FUseClientEdge := GMWinVersion >= wvWinXP; //if GMWinVersion = wvWin10_11 then CornerRounding := GMPoint(1, 1); inherited Create(AParent, APosition, AAreaAlign, AText, AWndStyle, AWndExStyle or {CClientEdge[FUseClientEdge]} WS_EX_CLIENTEDGE, ABkgndColor, ARefLifeTime); GMSetIntfMultifFrame(Self, frsNone, frsNone); end; {procedure TGMFramedEdit.FinalizeShow; begin if WndStyle and ES_PASSWORD <> 0 then GMHideAndShowWnd(-Int64(Self)) else inherited FinalizeShow; end;} {procedure TGMFramedEdit.WMSetFocus(var Msg: TWMSetFocus); begin inherited; end;} //procedure TGMFramedEdit.UMHandleCreated(var Msg: TMessage); //begin // //inherited; // GMHideAndShowWnd(-Int64(Self)); // //if FUseClientEdge or (GetWindowLong(Handle, GWL_STYLE) and ES_MULTILINE = 0) then GMHideAndShowWnd(-Int64(Self)); //end; //procedure TGMFramedEdit.WMPrintClient(var Msg: TMessage); //begin // //inherited; // //if (GetWindowLong(Handle, GWL_STYLE) and ES_MULTILINE <> 0) or (Msg.WParam = 0) then Exit; // GMPrintClientImpl(Handle, HDC(Msg.WParam), HBkgndBrush); //end; { -------------------------------- } { ---- TGMColorTextFramedEdit ---- } { -------------------------------- } constructor TGMColorTextFramedEdit.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); FFontColor := clrWindowText; end; function TGMColorTextFramedEdit.FontColor: COLORREF; begin Result := FFontColor; end; procedure TGMColorTextFramedEdit.SetFontColor(const AColor: COLORREF); begin if AColor = FFontColor then Exit; FFontColor := AColor; ScheduleRepaint; end; //procedure TGMColorTextFramedEdit.WMSetFocus(var Msg: TMessage); //begin //inherited; //if FOrgWndProc <> nil then with Msg do Result := CallWindowProc(FOrgWndProc, FHandle, Msg, WParam, LParam); //SelectAll; //end; { ----------------- } { ---- TGMMemo ---- } { ----------------- } constructor TGMMemo.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 or ES_AUTOHSCROLL or ES_AUTOVSCROLL or ES_MULTILINE, AWndExStyle, ABkgndColor, ARefLifeTime); GMSetIntfMultifFrame(Frame, frsLowered, frsLowered); end; //procedure TGMMemo.CreateHandle; //begin // if HandleAllocated then begin inherited CreateHandle; Exit; end else inherited CreateHandle; // SetClassLong(FHandle, GCL_STYLE, GetClassLong(FHandle, GCL_STYLE) or CS_HREDRAW or CS_VREDRAW); //end; { ------------------------- } { ---- TGMComboBoxEdit ---- } { ------------------------- } constructor TGMComboBoxEdit.Create(const AComboBox: TGMComboBox; const AHandle: HWnd; const AText: TGMString; const ABkgndColor: COLORREF; const ARefLifeTime: BOolean); begin FHandle := AHandle; inherited Create(GetParent(AHandle), cNullRect, cFixedPlace, AText, GetWindowLong(AHandle, GWL_STYLE), GetWindowLong(AHandle, GWL_EXSTYLE), ABkgndColor, ARefLifeTime); FOrgWndPtrData := SetWindowLongPtr(FHandle, cWndObjPtrData, PtrInt(Self)); {ToDO: Use window extra memory to store self pointer?} FOrgWndProc := Pointer(SetWindowLongPtr(FHandle, GWL_WNDPROC, PtrInt(@GMStdWndProc))); FComboBox := AComboBox; end; //procedure TGMComboBoxEdit.EMSetSel(var Msg: TMessage); //begin //inherited; //end; function TGMComboBoxEdit.IsDialogKeyMsg(const Msg: TMessage): Boolean; begin //if GMSendObjMessage(FComboBox, CB_GETDROPPEDSTATE) <> 0 then Result := False else // Result := ((Msg.Msg <> WM_SYSKEYDOWN) and (Msg.Msg <> WM_SYSKEYUP) and (Msg.WParamLo <> VK_DOWN)) and inherited IsDialogKeyMsg(Msg); // and () if FComboBox <> nil then Result := FComboBox.IsDialogKeyMsg(Msg) else Result := True; // // We are not a tabstop, our parent, the combobox, is the tabstop. But tab navigation is based on vGMKeyboardFocusArea // whhich points to us, so before processing tab navigation we set vGMKeyboardFocusArea to our combobox parent. // if (Msg.Msg = WM_KEYDOWN) and (Msg.WParamLo = VK_TAB) and (vGMKeyboardFocusArea = Self) then vGMKeyboardFocusArea := FComboBox; end; //procedure TGMComboBoxEdit.WMGetDlgCode(var Msg: TMessage); //begin //Msg.Result := DLGC_WANTALLKEYS; //FPassMessageToOriginalHandler := False; //end; procedure TGMComboBoxEdit.SurfaceOriginChanged; begin // Nothing! Will always be placed correctly by MS Windows end; //procedure TGMComboBoxEdit.WMAppCommand(var Msg: TWMCommand); //begin //case Msg.NotifyCode of // EN_CHANGE: // if FComboBox <> nil then FComboBox.OnAfterEditTextChange(FComboBox); //end; //end; procedure TGMComboBoxEdit.WMKeyDown(var Msg: TWMKeyDown); begin inherited; if (GMKeyDataToKeyState(Msg.KeyData) = []) then //and (Wndstyle and BS_TYPEMASK in [BS_PUSHBUTTON, BS_DEFPUSHBUTTON]) then case Msg.CharCode of VK_ESCAPE, VK_RETURN: GMSendObjMessage(FComboBox, CB_SHOWDROPDOWN, 0); end; end; //procedure TGMComboBoxEdit.WMSysKeyDown(var Msg: TWMKeyDown); //begin //inherited; //if (GMKeyDataToKeyState(Msg.KeyData) = []) then //and (Wndstyle and BS_TYPEMASK in [BS_PUSHBUTTON, BS_DEFPUSHBUTTON]) then // case Msg.CharCode of // VK_DOWN: GMSendObjMessage(FComboBox, CB_SHOWDROPDOWN, 0); // end; //end; { --------------------- } { ---- TGMComboBox ---- } { --------------------- } constructor TGMComboBox.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString; const AWndStyle: DWORD; const AWndExStyle: DWORD; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); var RPos: TRect; begin // ComboBoxes always show a border even if no border WndStyle has been set .. // In W2K or less popup list wont show unless height is 21, only bill knows why .. RPos := APosition; FSelectedIndex := -1; //if GMWinVersion <= wvWin2000 then case AAreaAlign.EdgeAlign[edgTop] of ealFixed: RPos.Bottom := RPos.Top + cEditHeight; ealAligned, ealCentered: RPos.Bottom := cEditHeight; end; // Always add CBS_AUTOHSCROLL // Always add WS_VSCROLL, scrollbar will only be shown if needed (automatically handeled by the windows control) inherited Create(AParent, RPos, AAreaAlign, AText, AWndStyle or WS_VSCROLL or CBS_AUTOHSCROLL, AWndExStyle, ABkgndColor, ARefLifeTime); end; function TGMComboBox.RegisterWndClass: TGMString; begin Result := 'COMBOBOX'; end; function TGMComboBox.IsPopupWindow: Boolean; begin Result := HandleAllocated and (SendMessage(Handle, CB_GETDROPPEDSTATE, 0, 0) <> 0); end; function TGMComboBox.GetCBInfo: TComboBoxInfo; begin //FillByte(Result, SizeOf(Result), 0); Result := Default(TComboBoxInfo); Result.cbSize := SizeOf(Result); if HandleAllocated then SendMessage(FHandle, CB_GETCOMBOBOXINFO, 0, LPARAM(@Result)); end; procedure TGMComboBox.SetTextWhenEmpty(const AValue: UnicodeString); begin if AValue = FTextWhenEmpty then Exit; FTextWhenEmpty := AValue; if (FEditWnd <> nil) and GMIsHandleAllocated(FEditWnd) then SendMessage(FEditWnd.Handle, EM_SETCUEBANNER, 0, LPARAM(PWideChar(FTextWhenEmpty))); end; function TGMComboBox.IsDialogKeyMsg(const Msg: TMessage): Boolean; begin if GMSendObjMessage(Self, CB_GETDROPPEDSTATE) <> 0 then Result := False else Result := ((Msg.Msg <> WM_SYSKEYDOWN) and (Msg.Msg <> WM_SYSKEYUP) and (Msg.WParamLo <> VK_DOWN)) and //((Msg.Msg <> WM_KEYDOWN) and (Msg.Msg <> WM_KEYUP) and not (Msg.WParamLo in [VK_UP, VK_DOWN])) and inherited IsDialogKeyMsg(Msg); end; procedure TGMComboBox.WMGetDlgCode(var Msg: TMessage); begin Msg.Result := DLGC_WANTARROWS; // or DLGC_WANTALLKEYS FPassMessageToOriginalHandler := False; end; function TGMComboBox.WndCreateRect: TRect; begin // Rect(APosition.Left, APosition.Top, APosition.Right, APosition.Bottom + 350) Result := inherited WndCreateRect; Inc(Result.Bottom, 700); end; function TGMComboBox.GetSelectedIndex: PtrInt; begin if HandleAllocated then Result := SendMessage(FHandle, CB_GETCURSEL, 0, 0) else Result := FSelectedIndex; end; function TGMComboBox.GetItemCount: PtrInt; begin if HandleAllocated then Result := SendMessage(FHandle, CB_GETCOUNT, 0, 0) else Result := 0; end; procedure TGMComboBox.SetSelectedIndex(const AIndex: PtrInt); begin if HandleAllocated then FSelectedIndex := GMSendObjMessage(Self, CB_SETCURSEL, AIndex); FSelectedIndex := AIndex; end; procedure TGMComboBox.FillDropValues; begin // Nothing, should be overridden in derived classes to fill items into the combobox end; procedure TGMComboBox.WMMouseWheel(var Msg: TMessage); begin // // The windows combobox sends VK_UP, VK_DOWN key GMMessages to the focus control when it receives a wheel message // if HasFocus then inherited else begin Msg.Result := DefWindowProc(FHandle, Msg.Msg, Msg.wParam, Msg.lParam); FPassMessageToOriginalHandler := False; end; end; function TGMComboBox.InternalCalcWidth(const ANewSize: TPoint): LongInt; var i: LongInt; entry: TGMString; // tmp begin if not HandleAllocated then Result := inherited InternalCalcWidth(ANewSize) else begin Result := FCalculatedMinWidth; if Result > 0 then Exit; for i:=0 to SendMessage(FHandle, CB_GETCOUNT, 0, 0)-1 do begin SetLength(entry, SendMessage(FHandle, CB_GETLBTEXTLEN, i, 0)); SendMessage(FHandle, CB_GETLBTEXT, i, LPARAM(PGMChar(entry))); Result := Max(Result, GMTextExtent(entry, FontHandle).x); end; Inc(Result, GMRectSize(GetCBInfo.rcButton).x + 10); FCalculatedMinWidth := Result; end; end; procedure TGMComboBox.InternalCreateHandle; var editWnd: HWnd; begin // // If the edit control inside the combobox is not subclassed it won't recognize dialog keys like ESC and RETURN. // inherited; editWnd := GetWindow(Handle, GW_CHILD); if editWnd <> 0 then FEditWnd := TGMComboBoxEdit.Create(Self, editWnd, Text, BkgndColor, True); FillDropValues; if FSelectedIndex >= 0 then GMSendObjMessage(Self, CB_SETCURSEL, FSelectedIndex); if (Length(FTextWhenEmpty) > 0) and (editWnd <> 0) then SendMessage(editWnd, EM_SETCUEBANNER, 0, LPARAM(PWideChar(FTextWhenEmpty))); end; procedure TGMComboBox.UMHandleCreated(var Msg: TMessage); begin if WndStyle and CBS_DROPDOWNLIST <> 0 then ScheduleRepaint; end; procedure TGMComboBox.Clear(const ANotify: Boolean); begin inherited Clear(ANotify); GMSendObjMessage(Self, CB_SETCURSEL, -1); end; //function TGMComboBox.ExecuteOperation(const Operation: Integer; const Parameter: IUnknown): Boolean; //begin // case Operation of // Ord(opClear): begin GMSendObjMessage(Self, CB_SETCURSEL, -1); Result := True; end; // else Result := inherited ExecuteOperation(Operation, Parameter); // end; //end; procedure TGMComboBox.CBResetContent(var Msg: TWMKeyDown); begin inherited; FCreateData.Text := ''; FSelectedIndex := -1; end; procedure TGMComboBox.WMKeyDown(var Msg: TWMKeyDown); //var passmsg: boolean; begin // // Nothing, dont call inherited (TGMWinControl.WMKeyDown) and leave FPassMessageToOriginalHandler = True! // //if (Msg.CharCode = VK_ESCAPE) and (GMKeyDataToKeyState(Msg.KeyData) = []) then //inherited; //passmsg := FPassMessageToOriginalHandler; //case Msg.CharCode of // VK_ESCAPE: SendMessage(FHandle, CB_SHOWDROPDOWN, 0, 0); //end; end; function TGMComboBox.GetListBoxString(const AIndex: PtrInt): TGMString; begin //if not HandleAllocated then Exit; SetLength(Result, GMSendObjMessage(Self, CB_GETLBTEXTLEN, AIndex)); if Length(Result) > 0 then GMSendObjMessage(Self, CB_GETLBTEXT, AIndex, LPARAM(PGMChar(Result))); end; function TGMComboBox.GetItemData(const AItemIdx: PtrInt): PtrInt; begin Result := GMSendObjMessage(Self, CB_GETITEMDATA, AItemIdx); end; procedure TGMComboBox.WMAppCommand(var Msg: TWMCommand); begin //inherited; case Msg.NotifyCode of // CBN_SELCHANGE CBN_SELENDOK CBN_SELCHANGE: if Assigned(OnAfterSelectionChange) and (FSelectedIndex <> SendMessage(FHandle, CB_GETCURSEL, 0, 0)) then begin FSelectedIndex := SendMessage(FHandle, CB_GETCURSEL, 0, 0); // // Neither the cb-edit control nor the combobox have the new text set at this point, // better set the new text before notifying. // // if (FEditWnd <> nil) and (FSelectedIndex >= 0) then Text := GetListBoxString(FSelectedIndex); // // well, text is set at this point .. if Assigned(OnAfterSelectionChange) then OnAfterSelectionChange(Self); FPassMessageToOriginalHandler := False; end; //CBN_SELENDOK: if Assigned(OnAfterSelectionChange) then OnAfterSelectionChange(Self); CBN_EDITCHANGE: if Assigned(OnAfterEditTextChange) then begin OnAfterEditTextChange(Self); FPassMessageToOriginalHandler := False; end; //CBN_DROPDOWN: if Assigned(OnBeforeListDrop) then OnBeforeListDrop(Self); end; //FPassMessageToOriginalHandler := False; end; procedure TGMComboBox.SelectAll; begin if HandleAllocated then SendMessage(FHandle, CB_SETEDITSEL, 0, LPARAM($FFFF0000)); end; function TGMComboBox.SelectString(const AValue: TGMString; const ANotifyOnChange: Boolean): PtrInt; var oldSelIdx: PtrInt; begin if not HandleAllocated then Exit(CB_ERR); oldSelIdx := GMSendObjMessage(Self, CB_GETCURSEL); Result := GMSendObjMessage(Self, CB_FINDSTRINGEXACT, -1, LPARAM(PGMChar(AValue))); if Result = CB_ERR then SetSelectedIndex(-1); if oldSelIdx <> Result then begin SetSelectedIndex(Result); if ANotifyOnChange and Assigned(OnAfterSelectionChange) then OnAfterSelectionChange(Self); end; end; function TGMComboBox.SelectItemData(const AItemData: PtrInt; const ANotifyOnChange: Boolean): PtrInt; var oldSelIdx: PtrInt; begin if not HandleAllocated then begin Result := CB_ERR; Exit; end; oldSelIdx := GMSendObjMessage(Self, CB_GETCURSEL); for Result:=0 to GetItemCount-1 do if GetItemData(Result) = AItemData then begin if Result <> oldSelIdx then begin SelectedIndex := Result; if ANotifyOnChange and Assigned(OnAfterSelectionChange) then OnAfterSelectionChange(Self); end; Exit; end; Result := CB_ERR; end; procedure TGMComboBox.LanguageChanged(const ANewLanguage: LParam); var selIdx: Integer; begin selIdx := SelectedIndex; FillDropValues; if selIdx >= 0 then SelectedIndex := selIdx; end; //procedure TGMComboBox.FinalizeShow; //begin // GMHideAndShowWnd(-Int64(Self)); //end; // //function TGMComboBox.CalculateHeight(const NewSize: TPoint): LongInt; //begin // Result := 21; // <- the MS ComboBox will always be this height //end; // //procedure TGMComboBox.WMKeyDown(var Msg: TWMKeyDown); //begin // if (Msg.CharCode <> VK_ESCAPE) or not IsPopupWindow then inherited; //end; // //procedure TGMComboBox.WindowProc(var Msg: TMessage); //begin // if IsDialogKeyMsg(Msg) and (SendMessage(Handle, CB_GETDROPPEDSTATE, 0, 0) = 0) then PassMsgToParentDlg(Msg) // else // case Msg.Msg of // WM_CTLCOLORMSGBOX .. WM_CTLCOLORSTATIC, WM_CTLCOLORMSGBOX + WM_APP .. WM_CTLCOLORSTATIC + WM_APP: // begin // SetTextColor(HDC(Msg.WParam), GMRGBColor(FontColor)); // SetBkColor(HDC(Msg.WParam), GMRGBColor(BkgndColor)); // Msg.Result := LRESULT(HBkgndBrush); // end; // else Msg.Result := CallWindowProc(FOrgWndProc, FHandle, Msg.Msg, Msg.WParam, Msg.LParam); // end; //end; // //procedure TGMComboBox.WMPrintClient(var Msg: TMessage); //begin // //inherited; // GMPrintClientImpl(Handle, HDC(Msg.WParam), HBkgndBrush); //end; // //procedure TGMComboBox.CreateHandle; //var EditWnd: HWnd; //begin // if HandleAllocated then begin inherited CreateHandle; Exit; end else inherited CreateHandle; // if WndStyle and $F <> CBS_DROPDOWN then Exit; // EditWnd := GetWindow(Handle, GW_CHILD); // if EditWnd = 0 then Exit; // // //FOrgEditId := SetWindowLongPtr(EditWnd, CWndObjPtrTag, WPARAM(Self)); // //FOrgEditProc := Pointer(SetWindowLongPtr(EditWnd, GWL_WNDPROC, PtrInt(@GMStdWndProc))); //end; { ------------------------- } { ---- TGMRichTextEdit ---- } { ------------------------- } // EDITSTREAMCALLBACK = function (dwCookie:PDWORD; pbBuff:LPBYTE; cb:LONG; var pcb:LONG):DWORD; {$IFDEF RICHEDIT} function RichEditStreamReadFunc(dwCookie: PtrUInt; Buffer: PByte; cb: LongInt; pcb: PLongInt): LongInt; stdcall; var Strm: IStream; begin Result := 0; try if dwCookie = 0 then Exit(E_INVALIDARG); Strm := IStream(dwCookie); Result := Strm.Read(Buffer, cb, pcb); except Result := E_UNEXPECTED; end; end; function RichEditStreamWriteFunc(dwCookie: PtrUInt; Buffer: PByte; cb: LongInt; pcb: PLongInt): LongInt; stdcall; var Strm: IStream; begin Result := 0; try if dwCookie = 0 then Exit(E_INVALIDARG); Strm := IStream(dwCookie); Result := Strm.Write(Buffer, cb, pcb); except Result := E_UNEXPECTED; end; end; constructor TGMRichTextEdit.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); FMaxEditLength := $7FFFFFFF; // <- RichEdit Max edit length is 32 KB by default (FMaxEditLength = 0)! end; //constructor TGMRichTextEdit.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; // const AText: TGMString; const AWndStyle: DWORD; const AWndExStyle: DWORD; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); //begin // inherited Create(AParent, APosition, AAreaAlign, AText, AWndStyle or ES_AUTOHSCROLL or ES_AUTOVSCROLL, // AWndExStyle, ABkgndColor, ARefLifeTime); //end; procedure TGMRichTextEdit.InternalCreateHandle; begin inherited; SendMessage(FHandle, EM_SETBKGNDCOLOR, 0, GMRGBColor(BkgndColor)); SendMessage(FHandle, EM_SETEVENTMASK, 0, FEventMask); end; procedure TGMRichTextEdit.SetOnBeforeTextChange(const AValue: TGMObjNotifyProc); begin inherited SetOnBeforeTextChange(AValue); if Assigned(FOnBeforeTextChange) then FEventMask := FEventMask or ENM_UPDATE else FEventMask := FEventMask and not ENM_UPDATE; if HandleAllocated then SendMessage(FHandle, EM_SETEVENTMASK, 0, FEventMask); end; procedure TGMRichTextEdit.SetOnAfterTextChange(const AValue: TGMObjNotifyProc); begin inherited SetOnAfterTextChange(AValue); if Assigned(FOnAfterTextChange) then FEventMask := FEventMask or ENM_CHANGE else FEventMask := FEventMask and not ENM_CHANGE; if HandleAllocated then SendMessage(FHandle, EM_SETEVENTMASK, 0, FEventMask); end; function TGMRichTextEdit.RegisterWndClass: TGMString; begin LoadRichEditDLL; Result := MSFTEDIT_CLASS; // RICHEDIT_CLASS; end; procedure TGMRichTextEdit.WMEraseBkgnd(var Msg: TWMEraseBkgnd); begin if not FInitialEreaseBkngd then begin // // If not filled once, shows in black Bkgnd until resized, .. // FillRect(Msg.DC, PaintingRect, HBkgndBrush); GMPaintWndFrame(-Int64(Self)); //GMHideAndShowWnd(-Int64(Self)); FInitialEreaseBkngd := True; end; //inherited; end; //procedure TGMRichTextEdit.WMPrintClient(var Msg: TMessage); //var R: TRect; //begin //GetWindowRect(FHandle, R); // <- ClientRect would not fill frame area! //FillRect(HDC(Msg.WParam), R, HBkgndBrush); //end; //procedure TGMRichTextEdit.WMPrintClient(var Msg: TMessage); //begin ////inherited; ////GMPrintClientImpl(Handle, HDC(Msg.WParam), HBkgndBrush); //end; procedure TGMRichTextEdit.LoadFromStream(const AStream: IStream; const AFormat: PtrInt); var StrmRec: TEditStream; begin FillByte(StrmRec, SizeOf(StrmRec), 0); StrmRec.dwCookie := PtrUInt(AStream); StrmRec.pfnCallback := RichEditStreamReadFunc; GMSendObjMessage(Self, EM_STREAMIN, AFormat, LPARAM(@StrmRec)); GMHrCheckObj(StrmRec.dwError, Self, 'LoadFromStream'); //GMAPICheckObj('LoadFromStream', '', StrmRec.dwError, False, Self); end; procedure TGMRichTextEdit.SaveToStream(const AStream: IStream; const AFormat: PtrInt); var StrmRec: TEditStream; begin FillByte(StrmRec, SizeOf(StrmRec), 0); StrmRec.dwCookie := PtrUInt(AStream); StrmRec.pfnCallback := RichEditStreamWriteFunc; GMSendObjMessage(Self, EM_STREAMOUT, AFormat, LPARAM(@StrmRec)); GMHrCheckObj(StrmRec.dwError, Self, 'SaveToStream'); //GMAPICheckObj('SaveToStream', '', StrmRec.dwError, False, Self); end; procedure TGMRichTextEdit.SetFontColor(const AColor: COLORREF); begin end; //procedure TGMRichTextEdit.UMFocusEnter(var Msg: TMessage); //begin //if Msg.LParam and cSelectAll <> 0 then SendMessage(FHandle, EM_SETSEL, 0, -1); //end; //procedure TGMRichTextEdit.WMGetDlgCode(var Msg: TMessage); //begin // inherited; // if (WndStyle and ES_READONLY <> 0) then begin Msg.Result := DLGC_WANTARROWS; FPassMessageToOriginalHandler := False; end; //end; //procedure TGMRichTextEdit.Print(const Caption: TGMString); //var Range: TFormatRange; LastChar, MaxLen, LogX, LogY, OldMap: Integer; SaveRect: TRect; //begin // FillByte(Range, SizeOf(TFormatRange), 0); // with Printer, Range do // begin // Title := Caption; // BeginDoc; // hdc := Handle; // hdcTarget := hdc; // LogX := GetDeviceCaps(Handle, LOGPIXELSX); // LogY := GetDeviceCaps(Handle, LOGPIXELSY); // if IsRectEmpty(PageRect) then // begin // rc.right := PageWidth * 1440 div LogX; // rc.bottom := PageHeight * 1440 div LogY; // end // else begin // rc.left := PageRect.Left * 1440 div LogX; // rc.top := PageRect.Top * 1440 div LogY; // rc.right := PageRect.Right * 1440 div LogX; // rc.bottom := PageRect.Bottom * 1440 div LogY; // end; // rcPage := rc; // SaveRect := rc; // LastChar := 0; // MaxLen := GetTextLen; // chrg.cpMax := -1; // // ensure printer DC is in text map mode // OldMap := SetMapMode(hdc, MM_TEXT); // SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0); // flush buffer // try // repeat // rc := SaveRect; // chrg.cpMin := LastChar; // LastChar := SendMessage(Self.Handle, EM_FORMATRANGE, 1, LongInt(@Range)); // if (LastChar < MaxLen) and (LastChar <> -1) then NewPage; // until (LastChar >= MaxLen) or (LastChar = -1); // EndDoc; // finally // SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0); // flush buffer // SetMapMode(hdc, OldMap); // restore previous map mode // end; // end; //end; {$ENDIF} { ---------------------- } { ---- TGMScrollBar ---- } { ---------------------- } constructor TGMScrollBar.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ADirection: TGM2DDirection; const AOnScrollPosChanged: TGMScollPosChangeProc; const AWndStyle: DWORD; const AWndExStyle: DWORD; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); const cDirection: array [TGM2DDirection] of DWORD = (SBS_HORZ, SBS_VERT); begin FDirection := ADirection; OnScrollPosChange := AOnScrollPosChanged; inherited Create(AParent, APosition, AAreaAlign, '', AWndStyle or cDirection[ADirection], AWndExStyle, ABkgndColor, ARefLifeTime); end; function TGMScrollBar.RegisterWndClass: TGMString; begin Result := 'SCROLLBAR'; end; procedure TGMScrollBar.WindowProc(var Msg: TMessage); begin case Msg.Msg of // scrollbars send WM_CANCELMODE to themself when getting fullsize, dont redirect those messages! WM_CANCELMODE: DispatchMsg(Msg); else inherited WindowProc(Msg); end; end; procedure TGMScrollBar.InternalCreateHandle; begin //FCreateData.WndStyle := FCreateData.WndStyle or WS_DISABLED; inherited InternalCreateHandle; FPage := CalcPageSize; SetScrollData(GMScrollData(SIF_POS or SIF_PAGE or SIF_RANGE, FMin, FMax, FPage, FPos)); //if FMax - FMin <= FPage then SendMessage(FHandle, WM_CANCELMODE, 0, 0); end; //procedure TGMScrollBar.UMHandleCreated(var Msg: TMessage); //begin //inherited; //FPage := CalcPageSize; //SetScrollData(GMScrollData(SIF_POS or SIF_PAGE or SIF_RANGE, FMin, FMax, FPage, FPos)); ////if FMax - FMin <= FPage then SendMessage(FHandle, WM_CANCELMODE, 0, 0); //end; function TGMScrollBar.HBkgndBrush: THandle; begin Result := 0; // <- Returning NULL brush will use system standard scrollbar background end; procedure TGMScrollBar.ResetValues; begin Position := 0; MinPosition := 0; MaxPosition := 0; // PageSize := 1; end; function TGMScrollBar.CalcPageSize: LongInt; begin if Assigned(OnCalcPageSize) then Result := OnCalcPageSize else //Max(cDfltSBPageSize, OnCalcPageSize) else case FDirection of d2dHorizontal: Result := Max(0, GMRectSize(FLayoutBounds).x); d2dVertical: Result := Max(0, GMRectSize(FLayoutBounds).y); else Result := 0; // cDfltSBPageSize end; end; procedure TGMScrollBar.SetupPageSize; begin if HandleAllocated then PageSize := CalcPageSize; end; procedure TGMScrollBar.SetLayoutBounds(const Value: TRect; const Repaint: Boolean); var PageSizeChanged: Boolean; begin if Assigned(OnCalcPageSize) then begin inherited; Exit; end; // <- SetupPageSize should be done by whoever has hooked OnCalcPageSize PageSizeChanged := HandleAllocated and (((FDirection = d2dHorizontal) and (GMRectSize(Value).x <> GMRectSize(LayoutBounds).x)) or ((FDirection = d2dVertical) and (GMRectSize(Value).y <> GMRectSize(LayoutBounds).y))); inherited; if PageSizeChanged then SetupPageSize; end; procedure TGMScrollBar.WMAppHScroll(var Msg: TWMScroll); begin HandleScroll(Msg); end; procedure TGMScrollBar.WMAppVScroll(var Msg: TWMScroll); begin HandleScroll(Msg); end; procedure TGMScrollBar.HandleScroll(var Msg: TWMScroll); //var NewPos: LongInt; //function LineScrollAmmount: LongInt; //begin // Result := Max(1, Round(PageSize * 0.06)); //end; // //function PageScrollAmmount: LongInt; //begin // Result := Max(1, Round(PageSize * 0.95)); //end; begin //NewPos := Position; //case Msg.ScrollCode of // SB_TOP: NewPos := MinPosition; // SB_BOTTOM: NewPos := MaxPosition; // SB_LINEDOWN: Inc(NewPos, LineScrollAmmount); // SB_LINEUP: Dec(NewPos, LineScrollAmmount); // SB_PAGEDOWN: Inc(NewPos, PageScrollAmmount); // SB_PAGEUP: Dec(NewPos, PageScrollAmmount); // SB_THUMBPOSITION, SB_THUMBTRACK: NewPos := GMScrollDataFromWnd(Handle, SB_CTL, SIF_TRACKPOS).nTrackPos; // //SB_ENDSCROLL: //end; //Position := GMBoundedInt(NewPos, MinPosition, MaxPosition - Max(PageSize-1, 0)); //Position := NewPos; Position := GMCalcScrollPos(Msg.ScrollCode, GMScrollDataFromWnd(FHandle, SB_CTL, SIF_RANGE or SIF_PAGE or SIF_POS or SIF_TRACKPOS)); FPassMessageToOriginalHandler := False; end; procedure TGMScrollBar.SetupArrows(const AScrollData: TScrollInfo); begin //EnableScrollBar(Handle, SB_CTL, cScrollArrowStates[FDirection][Position <= MinPosition, Position >= MaxPosition - PageSize + 1]); // On Windows XP or Vista clicking a disabled scroll arrow causes a hangup inside msctl32.dll, MS should explain why .. if GMWinVersion <= wvWin2000 then with AScrollData do EnableScrollBar(Handle, SB_CTL, cScrollArrowStates[FDirection][nPos <= nMin, nPos >= nMax - LongInt(nPage) + 1]); end; procedure TGMScrollBar.SetScrollData(const AScrollData: TScrollInfo; const ARedraw: Boolean); var newPos: LongInt; _ScollData: TScrollInfo; begin if not HandleAllocated then begin if AScrollData.fMask and SIF_POS <> 0 then FPos := AScrollData.nPos; if AScrollData.fMask and SIF_PAGE <> 0 then FPage := AScrollData.nPage; if AScrollData.fMask and SIF_RANGE <> 0 then begin FMin := AScrollData.nMin; FMax := AScrollData.nMax; end; end else begin _ScollData := GMScrollDataFromWnd(Handle, SB_CTL, SIF_PAGE or SIF_RANGE or SIF_POS); if (AScrollData.fMask = SIF_POS) and ((_ScollData.nPos = AScrollData.nPos) or (_ScollData.nMax - _ScollData.nMin <= LongInt(_ScollData.nPage))) then Exit; // Setting the range may change the position too! if AScrollData.fMask and (SIF_PAGE or SIF_RANGE) <> 0 then PScrollInfo(@AScrollData)^.fMask := AScrollData.fMask or SIF_DISABLENOSCROLL; newPos := SetScrollInfo(Handle, SB_CTL, AScrollData, ARedraw); //newPos := SendMessage(FHandle, SBM_GETPOS, 0, 0); if Assigned(OnScrollPosChange) and (_ScollData.nPos <> newPos) then OnScrollPosChange(_ScollData.nPos, newPos); //SetupArrows(GMScrollDataFromWnd(Handle, SB_CTL, SIF_RANGE or SIF_PAGE or SIF_POS)); // ScrollData // // SIF_DISABLENOSCROLL does not always work .. // _ScollData := GMScrollDataFromWnd(Handle, SB_CTL, SIF_PAGE or SIF_RANGE or SIF_POS); EnableWindow(FHandle, _ScollData.nMax - _ScollData.nMin > LongInt(_ScollData.nPage)); SetupArrows(AScrollData); end; end; //procedure TGMScrollBar.DisableIfNoScroll; //begin ////if HandleAllocated then EnableWindow(FHandle, PageSize + 1 < (MaxPosition - MinPosition)); //end; function TGMScrollBar.GetPosition: PtrInt; begin // Result := GMScrollDataFromWnd(Handle, SB_CTL, SIF_POS).nPos; if not HandleAllocated then Result := FPos else Result := GetScrollPos(Handle, SB_CTL); // Result := SendMessage(FHandle, SBM_GETPOS, 0, 0); end; procedure TGMScrollBar.SetPosition(const AValue: PtrInt); begin SetScrollData(GMScrollData(SIF_POS, 0, 0, 0, AValue), True); end; function TGMScrollBar.GetMinPosition: LongInt; var DummyMaxPos: LongInt; begin // Result := GMScrollDataFromWnd(Handle, SB_CTL, SIF_RANGE).nMin; if not HandleAllocated then Result := FMin else // SendMessage(FHandle, SBM_GETRANGE, WPARAM(@Result), LPARAM(@DummyMaxPos)); GetScrollRange(Handle, SB_CTL, Result, DummyMaxPos); end; procedure TGMScrollBar.SetMinPosition(const Value: LongInt); begin SetScrollData(GMScrollData(SIF_RANGE or SIF_PAGE, Value, MaxPosition, CalcPageSize), True); end; function TGMScrollBar.GetMaxPosition: LongInt; var DummyMinPos: LongInt; begin // Result := GMScrollDataFromWnd(Handle, SB_CTL, SIF_RANGE).nMax; if not HandleAllocated then Result := FMax else //SendMessage(Handle, SBM_GETRANGE, WPARAM(@DummyMinPos), LPARAM(@Result)); GetScrollRange(Handle, SB_CTL, DummyMinPos, Result); end; procedure TGMScrollBar.SetMaxPosition(const Value: LongInt); begin SetScrollData(GMScrollData(SIF_RANGE or SIF_PAGE, MinPosition, Value, CalcPageSize), True); end; function TGMScrollBar.GetPageSize: LongInt; begin if not HandleAllocated then Result := FPage else Result := GMScrollDataFromWnd(Handle, SB_CTL, SIF_PAGE).nPage; // cDfltSBPageSize end; procedure TGMScrollBar.SetPageSize(const Value: LongInt); begin SetScrollData(GMScrollData(SIF_PAGE, 0, 0, Max(0, Value)), True); end; function TGMScrollBar.InternalCalcWidth(const NewSize: TPoint): LongInt; begin Result := GetSystemMetrics(SM_CXVSCROLL); end; function TGMScrollBar.InternalCalcHeight(const NewSize: TPoint): LongInt; begin Result := GetSystemMetrics(SM_CYHSCROLL); end; { ----------------------------- } { ---- TGMScrollingWinCtrl ---- } { ----------------------------- } procedure TGMScrollingWinCtrl.DoScroll(const ADirection: TGM2DDirection; var AScrollOrigin: LongInt; const ANewPos: LongInt); var Delta: TPoint; // R, RUpdate: TRect; begin case ADirection of d2dHorizontal: Delta := GMPoint(-AScrollOrigin - ANewPos, 0); d2dVertical: Delta := GMPoint(0, -AScrollOrigin - ANewPos); else Delta := cNullPoint; end; if (Delta.x = 0) and (Delta.y = 0) then Exit; //R := PaintingRect;//GMCalculateClientRect(Frame, PaintingRect); // CalculateSurfaceRect(LayoutBounds)); //ScrollWindowEx(FHandle, 0, Delta, @R, @R, 0, nil, SW_SCROLLCHILDREN or SW_INVALIDATE); // or SW_SCROLLCHILDREN SW_ERASE @RUpdate ScrollWindowEx(FHandle, Delta.x, Delta.y, nil, nil, 0, nil, SW_SCROLLCHILDREN or SW_INVALIDATE); // or SW_SCROLLCHILDREN SW_ERASE @RUpdate //MakeLong(SW_INVALIDATE or SW_SCROLLCHILDREN or SW_SMOOTHSCROLL, Abs(Round(ScrollDelta/1.75))) //InvalidateRect(FHandle, @RUpdate, False); SetScrollInfo(FHandle, cWin2DDirections[ADirection], GMScrollData(SIF_POS, 0, 0, 0, ANewPos), True); AScrollOrigin := -ANewPos; SurfaceOriginChanged; end; procedure TGMScrollingWinCtrl.DoScrollMsg(const ADirection: TGM2DDirection; var AScrollOrigin: LongInt; var Msg: TWMScroll); var NewPos: LongInt; begin if Msg.ScrollCode = SB_ENDSCROLL then Exit; NewPos := GMCalcScrollPos(Msg.ScrollCode, GMScrollDataFromWnd(FHandle, cWin2DDirections[ADirection], SIF_RANGE or SIF_PAGE or SIF_POS or SIF_TRACKPOS)); DoScroll(ADirection, AScrollOrigin, NewPos); FPassMessageToOriginalHandler := False; end; procedure TGMScrollingWinCtrl.WMHScroll(var Msg: TWMScroll); begin DoScrollMsg(d2dHorizontal, ScrollOffset.x, Msg); end; procedure TGMScrollingWinCtrl.WMVScroll(var Msg: TWMScroll); begin DoScrollMsg(d2dVertical, ScrollOffset.y, Msg); end; procedure TGMScrollingWinCtrl.ScrollToVPosition(const ADirection: TGM2DDirection; const APosition: LongInt); var ScrollData: TScrollInfo; begin if HandleAllocated then begin ScrollData := GMScrollDataFromWnd(FHandle, cWin2DDirections[ADirection], SIF_RANGE or SIF_PAGE or SIF_POS or SIF_TRACKPOS); ScrollData.nTrackPos := APosition; DoScroll(ADirection, ScrollOffset.y, GMCalcScrollPos(SB_THUMBTRACK, ScrollData)); end; end; procedure TGMScrollingWinCtrl.ScrollRectVisible(const ARect: TRect); var RSurface: TRect; begin if HandleAllocated then begin RSurface := GMRect(GMPoint(0, 0), ClientAreaSize); //PaintingRect; if ARect.Top + ScrollOffset.y < RSurface.Top then ScrollToVPosition(d2dVertical, ARect.Top) // + RSurface.Top else if ARect.Bottom + ScrollOffset.y > RSurface.Bottom then ScrollToVPosition(d2dVertical, Min(ARect.Top, ARect.Bottom - GMRectSize(RSurface).y)); //ScrollToVPosition(d2dVertical, Min(ARect.Top + RSurface.Top, ARect.Bottom - GMRectSize(RSurface).y + RSurface.Top)); end; end; procedure TGMScrollingWinCtrl.ScrollAreaVisible(const AArea: TObject); var area: IGMUiArea; begin if HandleAllocated and GMGetInterface(AArea, IGMUiArea, area) then ScrollRectVisible(GMAreaBoundsOffset(Self, AArea)); end; procedure TGMScrollingWinCtrl.WMMouseWheel(var Msg: TWMMouseWheel); begin ScrollToVPosition(d2dVertical, -ScrollOffset.y - GMWheelScrollDelta(ClientAreaSize.y, Msg.WheelDelta)); Msg.Result := 1; FPassMessageToOriginalHandler := False; end; procedure TGMScrollingWinCtrl.ShowScrollBarsIfNeeded; const cVScroll: array [Boolean] of DWORD = (0, WS_VSCROLL); cHScroll: array [Boolean] of DWORD = (0, WS_HSCROLL); var i, newPos: LongInt; rArea: TRect; oldStyle, newStyle: DWORD; clientSz: TPoint; childArea: IGMUiArea; begin clientSz := ClientAreaSize; if (clientSz.x <= 0) or (clientSz.y <= 0) then Exit; FContainedSize := cNullPoint; for i:=0 to ContainedAreas.Count-1 do if GMGetInterface(ContainedAreas[i], IGMUiArea, childArea) and childArea.Visible then begin rArea := childArea.LayoutBounds; if rArea.Right > FContainedSize.x then FContainedSize.x := rArea.Right; if rArea.Bottom > FContainedSize.y then FContainedSize.y := rArea.Bottom; end; oldStyle := WndStyle; newStyle := (oldStyle and not (WS_VSCROLL or WS_HSCROLL)) or cVScroll[FContainedSize.y > clientSz.y] or cHScroll[FContainedSize.x > clientSz.x]; if oldStyle <> newStyle then FLastLayoutSize := GMPoint(cInvalidLayoutVal, cInvalidLayoutVal); WndStyle := newStyle; // <- will set FCreateData WndStyle if handle has not yet been created if not HandleAllocated then Exit; if (newStyle or oldStyle) and WS_VSCROLL <> 0 then begin // FLastLayoutSize.y := cInvalidLayoutVal; newPos := SetScrollInfo(FHandle, SB_VERT, GMScrollData(SIF_RANGE or SIF_PAGE, 0, FContainedSize.y-1, clientSz.y), True); if newPos <> -ScrollOffset.y then SendMessage(FHandle, WM_VSCROLL, MakeLong(SB_THUMBPOSITION, newPos), FHandle); end; if (newStyle or oldStyle) and WS_HSCROLL <> 0 then begin // FLastLayoutSize.x := cInvalidLayoutVal; newPos := SetScrollInfo(FHandle, SB_HORZ, GMScrollData(SIF_RANGE or SIF_PAGE, 0, FContainedSize.x-1, clientSz.x), True); if newPos <> -ScrollOffset.x then SendMessage(FHandle, WM_HSCROLL, MakeLong(SB_THUMBPOSITION, newPos), FHandle); end; end; procedure TGMScrollingWinCtrl.LayoutContainedAreas(const ARepaint: Boolean); // : TPoint; begin inherited LayoutContainedAreas(False); ShowScrollBarsIfNeeded; if ARepaint then ScheduleRepaint; end; { ------------------- } { ---- TGMButton ---- } { ------------------- } constructor TGMButton.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString; const AOnClick: TGMObjNotifyProc; const AWndStyle: DWORD; const AWndExStyle: DWORD; const ABkgndColor: COLORREF; const AHFont: HFONT; const ARefLifeTime: Boolean); begin Create(AParent, APosition, AAreaAlign, AText, AWndStyle, AWndExStyle, ABkgndColor, ARefLifeTime); FOnClick := AOnClick; FHFont := AHFont; end; function TGMButton.IsDefaultDlgBtn: Boolean; begin Result := (WndStyle and BS_TYPEMASK) = BS_DEFPUSHBUTTON; end; function TGMButton.RegisterWndClass: TGMString; begin Result := 'BUTTON'; end; //procedure TGMButton.WindowProc(var Msg: TMessage); //var i: LongInt; //begin // case Msg.Msg of // WM_CTLCOLORMSGBOX .. WM_CTLCOLORSTATIC, WM_CTLCOLORMSGBOX + WM_APP .. WM_CTLCOLORSTATIC + WM_APP: // begin // //SetTextColor(HDC(Msg.WParam), GMRGBColor(FontColor)); // //SetBkColor(HDC(Msg.WParam), GMRGBColor(BkgndColor)); // //Msg.Result := LRESULT(HBkgndBrush); // i := 1; // end; // // //else Msg.Result := CallWindowProc(FOrgWndProc, FHandle, Msg.Msg, Msg.WParam, Msg.LParam); // end; // // inherited WindowProc(Msg); //end; function TGMButton.FontHandle: THandle; begin if FHFont <> 0 then Result := FHFont else Result := inherited FontHandle; end; function TGMButton.IsDialogKeyMsg(const Msg: TMessage): Boolean; begin Result := ((Msg.Msg = WM_KEYDOWN) or (Msg.Msg = WM_KEYUP) or (Msg.Msg = WM_CHAR)) and ((Msg.WParamLo <> VK_RETURN) or (vGMKeyboardFocusArea <> Self) or not (Wndstyle and BS_TYPEMASK in [BS_PUSHBUTTON, BS_DEFPUSHBUTTON])) and inherited IsDialogKeyMsg(Msg); end; procedure TGMButton.WMKeyDown(var Msg: TWMKeyDown); begin inherited; if (GMKeyDataToKeyState(Msg.KeyData) = []) and (Wndstyle and BS_TYPEMASK in [BS_PUSHBUTTON, BS_DEFPUSHBUTTON]) then case Msg.CharCode of VK_RETURN: if GetEnabled then Click(Self); // , Ord(' ') end; end; //procedure TGMButton.WMEraseBkgnd(var Msg: TWMEraseBkgnd); //begin // //if Msg.DC <> 0 then // // begin // // FillRect(Msg.DC, PaintingRect, HBkgndBrush); // // end; //end; procedure TGMButton.Click(const ASender: TObject); begin if Assigned(OnClick) then OnClick(ASender); end; //procedure TGMButton.WMMouseWheel(var Msg: TWMMouseWheel); //begin //inherited; //Msg.Result := 0; ////FPassMessageToOriginalHandler := False; //end; {procedure TGMButton.WMGetDlgCode(var Msg: TMessage); // TWMGetDlgCode begin with Msg do Result := CallWindowProc(FOrgWndProc, FHandle, Msg, WParam, LParam) or DLGC_WANTALLKEYS; FPassMessageToOriginalHandler := False; end;} {procedure TGMButton.WMKeyDown(var Msg: TWMKeyDown); begin if (Msg.CharCode = VK_RETURN) and (GMKeyDataToKeyState(Msg.KeyData) = []) then Click else inherited; end;} {procedure TGMButton.WMSetFocus(var Msg: TWMSetFocus); begin WndStyle := WndStyle or BS_DEFPUSHBUTTON; end;} procedure TGMButton.WMAppCommand(var Msg: TWMCommand); begin case Msg.NotifyCode of BN_CLICKED: Click(Self); end; end; function TGMButton.FillsComplete: Boolean; begin // ODS_NOFOCUSRECT //Result := GMWinVersion < wvWinXP; //Result := True; Result := False; end; //function TGMButton.PaintsComplete: Boolean; //begin // //Result := inherited PaintsComplete; // Result := False; //end; function TGMButton.InternalCalcWidth(const NewSize: TPoint): LongInt; begin Result := GMTextExtent(Text, FontHandle).x + GMFrameExtent(Frame).x + (2*cDlgSpace); //Result := GMCalcTextAreaSize(Text, NewSize, GMFrameExtent(Frame), GMPoint(2*cDlgSpace, 0), FontHandle, cBtnDTFlags[WndStyle and BS_MULTILINE <> 0]).x; end; function TGMButton.InternalCalcHeight(const NewSize: TPoint): LongInt; //var Padd: TPoint; begin //if GMWinVersion < wvWinXP then Padd := GMPoint(4, 6) else Padd := GMPoint(2, 6); //Result := GMCalcTextAreaSize(Text, NewSize, GMPoint(4, 4), Padd, FontHandle, cBtnDTFlags[WndStyle and BS_MULTILINE <> 0]).y; Result := GMCalcTextAreaSize(Text, NewSize, GMFrameExtent(Frame), GMPoint(2*cDlgSpace, 10), FontHandle, cBtnDTFlags[WndStyle and BS_MULTILINE <> 0]).y; end; { ------------------------ } { ---- TGMImageButton ---- } { ------------------------ } // // BS_ICON style and BM_SETIMAGE message -> Show icon only // no BS_ICON style but BM_SETIMAGE message -> Show icon and Text // constructor TGMImageButton.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString; const AImage: THandle; const AImageKind: TGMBtnImgKind; const ADestroyImage: Boolean; const AOnClick: TGMObjNotifyProc; const AWndStyle, AWndExStyle: DWORD; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); const cImage: array [TGMBtnImgKind, Boolean] of LongWord = ((BS_ICON, 0), (BS_BITMAP, 0)); begin inherited Create(AParent, APosition, AAreaAlign, AText, AOnClick, AWndStyle or cImage[AImageKind, Length(AText) > 0], AWndExStyle, ABkgndColor, 0, ARefLifeTime); FImage := AImage; FImageKind := AImageKind; FDestroyImage := ADestroyImage; end; destructor TGMImageButton.Destroy; begin if (FImage <> 0) and FDestroyImage then begin case FImageKind of bikIcon: DestroyIcon(FImage); bikBitmap: DeleteObject(FImage); end; FImage := 0; end; inherited Destroy; end; procedure TGMImageButton.InternalCreateHandle; const cImgKind: array [TGMBtnImgKind] of LongWord = (IMAGE_ICON, IMAGE_BITMAP); begin //if HandleAllocated then begin inherited CreateHandle; Exit; end else inherited CreateHandle; inherited; if FImage <> 0 then SendMessage(FHandle, BM_SETIMAGE, cImgKind[FImageKind], LPARAM(FImage)); //SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN, MakeLong(1, 1)); //AdjustWndEditRect(Handle, FontHeight); end; //function TGMImageButton.CalculateWidth(const NewSize: TPoint): LongInt; //begin //Result := Max(20 + GMTextExtent(Text, FontHandle).x + (cDlgSpace+2) * 2, inherited CalculateWidth(NewSize)); // NewSize.x ////Result := inherited CalculateWidth(NewSize); ////if FImage <> 0 then Inc(Result, 20); //end; { ------------------------ } { ---- TGMMinWidthBtn ---- } { ------------------------ } function TGMMinWidthBtn.InternalCalcWidth(const NewSize: TPoint): LongInt; begin Result := Max(inherited InternalCalcWidth(NewSize), cDlgBtnWidth); end; { ---------------------- } { ---- TGMDlgButton ---- } { ---------------------- } constructor TGMDlgButton.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ABtnKind: TDlgBtnKind; const AWndStyle: DWORD; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, GMDlgBtnTitle(ABtnKind), AWndStyle, 0, ABkgndColor, ARefLifeTime); FBtnKind := ABtnKind; end; procedure TGMDlgButton.Click(const ASender: TObject); var dlg: TObject; HelpInfo: THelpInfo; begin if Assigned(OnClick) then inherited else case FBtnKind of {ToDo: WM_HELP gets eaten by message queue if sended or posted - why?} dbkHelp: if GMFindParentDlg(Self, dlg) then begin FillByte(HelpInfo, SizeOf(HelpInfo), 0); GMCallObjWindowProc(dlg, WM_HELP, 0, LPARAM(@HelpInfo)); //GMSendObjMessage(dlg, WM_HELP, 0, LPARAM(@HelpInfo)); end; else if GMFindParentDlg(Self, dlg) then GMPostObjMessage(dlg, vDlgBtnMessage[FBtnKind], vDlgBtnModalResult[FBtnKind]); end; end; //procedure TGMDlgButton.SetBtnKind(const ABtnKind: TDlgBtnKind); //begin //if FBtnKind = ABtnKind then Exit; //FBtnKind := ABtnKind; //Text := GMDlgBtnTitle(ABtnKind); //end; { ------------------------ } { ---- TGMCheckButton ---- } { ------------------------ } function TGMCheckButton.GetChecked: Boolean; begin if not HandleAllocated then Result := FChecked else Result := SendMessage(FHandle, BM_GETCHECK, 0, 0) = BST_CHECKED; end; procedure TGMCheckButton.SetChecked(const AValue: Boolean); begin //if HandleAllocated then SendMessage(FHandle, BM_SETCHECK, cWinBtnCheck[AValue], 0); FChecked := AValue; GMSendObjMessage(Self, BM_SETCHECK, cWinBtnCheck[AValue]); end; procedure TGMCheckButton.InternalCreateHandle; begin inherited; GMSendObjMessage(Self, BM_SETCHECK, cWinBtnCheck[FChecked]); end; procedure TGMCheckButton.Clear(const ANotify: Boolean); begin inherited Clear(ANotify); Checked := False; end; //function TGMCheckButton.ExecuteOperation(const Operation: Integer; const Parameter: IUnknown): Boolean; //begin // case Operation of // Ord(opClear): begin Checked := False; Result := True; end; // else Result := inherited ExecuteOperation(Operation, Parameter); // end; //end; function TGMCheckButton.InternalCalcWidth(const NewSize: TPoint): LongInt; //var ADC: IGMGetHandle; RText: TRect; begin {ADC := TGMGdiCompatibleDC.Create(FontHandle, True); RText := GMRect(0, 0, NewSize.x, NewSize.y); Result := GMMultiLineTextSize(ADC.Handle, Text, RText, cBtnDTFlags[WndStyle and BS_MULTILINE <> 0]).x + GMCheckBoxSize.x + 6;} //Result := GMCalcTextAreaSize(Text, NewSize, GMFrameExtent(Frame), cNullPoint, FontHandle, cBtnDTFlags[WndStyle and BS_MULTILINE <> 0]).x + GMCheckBoxSize.x + 6; Result := GMTextExtent(Text, FontHandle).x + GMFrameExtent(Frame).x + GMCheckBoxSize.x + 2; end; function TGMCheckButton.InternalCalcHeight(const NewSize: TPoint): LongInt; //const cPaddX: array [Boolean] of LongInt = (3, 0); //var ADC: IGMGetHandle; RText: TRect; begin {ADC := TGMGdiCompatibleDC.Create(FontHandle, True); RText := GMRect(0, 0, NewSize.x - GMCheckBoxSize.x - 7, NewSize.y); Result := GMMultiLineTextSize(ADC.Handle, Text, RText, cBtnDTFlags[WndStyle and BS_MULTILINE <> 0]).y + 2;} //Result := GMCalcTextAreaSize(Text, NewSize, GMFrameExtent(Frame), GMPoint(GMCheckBoxSize.x+cPaddX[GMWinVersion < wvWinXP], 0), FontHandle, cBtnDTFlags[WndStyle and BS_MULTILINE <> 0]).y + 2; Result := GMCalcTextAreaSize(Text, GMPoint(NewSize.x - GMCheckBoxSize.x - 1, NewSize.y), GMFrameExtent(Frame), cNullPoint, FontHandle, cBtnDTFlags[WndStyle and BS_MULTILINE <> 0]).y + 2; end; { ------------------------ } { ---- TGMRadioButton ---- } { ------------------------ } constructor TGMRadioButton.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString; const AWndStyle, AWndExStyle: DWORD; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); begin // BS_AUTORADIOBUTTON BS_RADIOBUTTON inherited Create(AParent, APosition, AAreaAlign, AText, AWndStyle or BS_AUTORADIOBUTTON, AWndExStyle, ABkgndColor, ARefLifeTime); end; { --------------------- } { ---- TGMCheckBox ---- } { --------------------- } constructor TGMCheckBox.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 or BS_AUTOCHECKBOX, AWndExStyle, ABkgndColor, ARefLifeTime); end; { -------------------------- } { ---- TGMDlgBottomArea ---- } { -------------------------- } constructor TGMDlgBottomArea.Create(const AParent: TObject; const AButtons: TDlgBtnKinds; const ADfltBtn: TDlgBtnKind; //const ADlgSpace: LongInt; ABtnCreateClass: TGMDlgButtonClass; const ABkgndColor: COLORREF; const AHeight: LongInt; const ARefLifeTime: Boolean); const cDfltBtn: array [Boolean] of DWORD = (0, BS_DEFPUSHBUTTON); var b: TDlgBtnKind; //TopSep: TObject; begin inherited Create(AParent, GMRect(0, -AHeight, 0, 0), cBottomAligned, ABkgndColor, True, ARefLifeTime); //TopSep := OwnArea(TGMUiArea.Create(Self, GMRect(ADlgSpace, 0, ADlgSpace, 2), cTopAligned)); //GMSetObjMultiFrame(TopSep, frsNone, frsLowered); GMSetObjMultiFrame(OwnArea(TGMUiArea.Create(Self, GMRect(0, 0, 0, 2), cTopAligned)), frsNone, frsLowered); OwnArea(TGMxSizeGrip.Create(Self, GMRect(-cSizeGripSize, -cSizeGripSize, 0, 0), cBottomRightCorner, cDfltSizeGripAppearance, ABkgndColor)); if ABtnCreateClass = nil then ABtnCreateClass := TGMDlgButton; for b:=Low(b) to High(b) do if b in AButtons then FButtons[b] := OwnArea(ABtnCreateClass.Create(-Int64(Self), cDlgBtnRect, cDlgBtnAlign, b, cVisibleTabstop or cDfltBtn[b = ADfltBtn])) as TGMDlgButton; end; end.