{ +-------------------------------------------------------------+ } { | | } { | GM-Software | } { | =========== | } { | | } { | Project: All Projects | } { | | } { | Description: Controls based only on simple GDI drawing. | } { | They work on any OS that offers a GDI. | } { | | } { | Copyright (C) - 2012 - Gerrit Moeller. | } { | | } { | Source code dstributed under MIT license. | } { | | } { | See: https://www.gm-software.de | } { | | } { +-------------------------------------------------------------+ } {$INCLUDE GMCompilerSettings.inc} unit GMxCtrls; {$R *.res} interface uses {$IFDEF JEDIAPI}jwaWinType, jwaWinUser,{$ELSE}Windows,{$ENDIF} GMMessages, GMStrDef, GMIntf, GMCommon, GMCollections, GMUICore, GMGdi {$IFDEF PNGSUPPORT}, GMPngImage{$ENDIF}; type TGMGripSizeAppearance = (sgaLines, sgaDots); TImgAttribute = (iaTransparent, iaStretched, iaKeepAspectRatio, iaHalfTone); TImgAttributes = set of TImgAttribute; TGMScrollArrowStates = array [Boolean, Boolean] of LongWord; TGMxEditorAttribute = (edMultiLine, edWrapLines, edReadOnly); // , edReadOnly, edPassword TGMxEditorAttributes = set of TGMxEditorAttribute; TGMSelectionKind = (skRange, skBox); TDlgBtnKind = (dbkNone, dbkCancel, dbkOk, dbkClose, dbkHelp, dbkNo, dbkYes, dbkAbort, dbkIgnore, dbkRetry, dbkContinue); TDlgBtnKinds = set of TDlgBtnKind; const cDlgBtnsOkCancel = [dbkCancel, dbkOk]; cDlgBtnsOkCancelHelp = [dbkOk, dbkCancel, dbkHelp]; cDlgBtnAreaHeight = 44; cSizeGripSize = 15; cDlgFrmSpace = 3; cDlgBtnWidth = 80; cCheckBoxHeight = 17; cLabelHeight = 17; cDfltChkBoxSize = 14; //cDfltSBPageSize = 0; cChevronBtnWidth = 12; cCtlSpace = 4; cIconSpace = 6; c2CtlSpace = 2 * cCtlSpace; c3CtlSpace = 3 * cCtlSpace; cDlgSpace = c2CtlSpace; // 10 cDlgBtnHeight = 25; cEditHeight = 21; cBtnInitialDelay = 200; cBtnRepeatDelay = 10; cImgIdxHigh = 32000; cDownOffs: array [Boolean] of Integer = (0, 1); cDfltLabelDrawFlags = DT_NOCLIP or DT_NOPREFIX or DT_SINGLELINE; // or DT_END_ELLIPSIS cDfltTextLabelDrawFlags = DT_NOCLIP or DT_NOPREFIX or DT_WORDBREAK; // or DT_WORD_ELLIPSIS; cDfltFontColor = clrWindowText; cDfltSizeGripAppearance = sgaDots; cDfltBmpAttributes = []; // bmaVisible cDfltIconAttributes = [iaTransparent]; cDlgBtnAlign: TGMAreaAlignRec = (EdgeAlign: (ealFixed, ealCentered, ealAligned, ealCentered); ShrinkRestX: True; ShrinkRestY: False); cLabelAlign: TGMAreaAlignRec = (EdgeAlign: (ealFixed, ealAligned, ealFixed, ealFixed); ShrinkRestX: False; ShrinkRestY: True); cDlgBtnRect: TRect = (Left: 0; Top: 0; Right: c2CtlSpace; Bottom: cDlgBtnHeight); cBtnDTFlags: array [Boolean] of DWORD = (cDfltLabelDrawFlags, cDfltTextLabelDrawFlags); cAdjstChkBtnStyle = cVisibleTabstop or BS_MULTILINE or BS_TOP; cAdjstBtnStyle = cVisibleTabstop or BS_MULTILINE or BS_VCENTER; cDfltEditorAttributes = []; cUnlimitedTextLength = -1; //cDfltToolBtnFrameColor = $c66931; //cDfltToolBtnHooverColor = $efd3c6; //clDfltHoverFrameColor = $FAA881; // $FAB08d cPassiveFrameColor = $96A4AB; cToolBtnDownColor = $F7F7F7; cDitherGray = $dfdfdf; cCloseCrossColor = $3c3bb7; // $1c2bc4; <- Windows 11 close button color type { ----------------------------- } { ---- Windowless Controls ---- } { ----------------------------- } TGMxLabel = class(TGMUiArea, IGMGetText, IGMGetSetText, IGMGetSetEnabled, IGMLanguageChanged) // // Displays a text and calculates width // Height will only be calculated if it is zero // protected FResTextRef: RGMResTextRefData; FText: TGMString; FPaddSpace: TRect; FTextVAlignment: TGMVerticalAlignment; FTextHAlignment: TGMHorizontalAlignment; FDisabled: Boolean; FDrawFlags: DWORD; FFont: HFONT; FFontColor: COLORREF; function GetText: TGMString; stdcall; function TextRect(const ASize: TPoint): TRect; procedure SetText(const AText: TGMString); virtual; stdcall; procedure SetPaddSpace(const APaddSpace: TRect); procedure SetFDrawFlags(const ADrawFlags: DWORD); public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const APaddSpace: TRect; const AText: TGMString = ''; const ABkgndColor: COLORREF = cDfltColor; // cDfltColor; clrTransparent const AFont: HFONT = 0; const AFontColor: COLORREF = cDfltFontColor; const ADrawFlags: DWORD = cDfltLabelDrawFlags; const ATextHAlignment: TGMHorizontalAlignment = haLeft; const AtextVAlignment: TGMVerticalAlignment = vaCenter; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; procedure LanguageChanged(const ANewLanguage: LParam); virtual; function GetEnabled: Boolean; override; procedure SetEnabled(const AEnabled: Boolean); stdcall; //procedure PaintBackground(const ADC: HDC; const AClientRect: TRect; const ARegion: IGMGetHandle); override; function PaintArea(const ADC: HDC; const ARect: TRect): Boolean; override; function ExecuteOperation(const AOperation: LongInt; const AParameter: IUnknown): Boolean; override; function FontHandle: THandle; override; function FontColor: COLORREF; override; // function PaintsComplete: Boolean; override; function InternalCalcWidth(const ANewSize: TPoint): LongInt; override; function InternalCalcHeight(const ANewSize: TPoint): LongInt; override; procedure SetFontHandle(const AValue: HFont; const ARelayout: Boolean = True); procedure SetFontColor(const AColor: COLORREF; const ARepaint: Boolean = True); procedure SetTextValue(const ATextValue: TGMString); property Text: TGMString read GetText write SetText; property PaddSpace: TRect read FPaddSpace write SetPaddSpace; property DrawFlags: DWORD read FDrawFlags write SetFDrawFlags; end; TGMxTextLabel = class(TGMxLabel) // // Displays a multiline wrapping text and calculates width and height // public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const APaddSpace: TRect; const AText: TGMString = ''; const ABkgndColor: COLORREF = cDfltColor; // cDfltColor; clrTransparent const AFont: HFONT = 0; const AFontColor: COLORREF = cDfltFontColor; const ADrawFlags: DWORD = cDfltTextLabelDrawFlags; // <- different to TGMxLabel! const ATextHAlignment: TGMHorizontalAlignment = haLeft; const AtextVAlignment: TGMVerticalAlignment = vaCenter; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; end; TGMxUrlLabel = class(TGMxLabel) protected FMouseDown: Boolean; FHoverFont: IGMGdiFont; FUrl: TGMString; procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR; procedure WMLButtonDown(var Msg: TWMMouse); message WM_LBUTTONDOWN; procedure WMLButtonUp(var Msg: TWMMouse); message WM_LBUTTONUP; procedure WMMouseEnter(var Msg: TWMMouse); message UM_MOUSEENTER; procedure WMMouseLeave(var Msg: TWMMouse); message UM_MOUSELEAVE; public OnClick: TGMObjNotifyProc; constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const APaddSpace: TRect; const AText: TGMString = ''; const AUrl: TGMString = ''; const ABkgndColor: COLORREF = cDfltColor; // cDfltColor; clrTransparent const AOnClick: TGMObjNotifyProc = nil; const AFont: HFONT = 0; const AFontColor: COLORREF = clBlue; const ATextHAlignment: TGMHorizontalAlignment = haLeft; const AtextVAlignment: TGMVerticalAlignment = vaCenter; const ADrawFlags: DWORD = cDfltLabelDrawFlags; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; procedure Click(const ASender: TObject = nil); virtual; function FontHandle: THandle; override; end; TGMxSizeGrip = class(TGMUiArea) // // Grip that sizes next parent that is not a layout child // protected FDragOrigin: TPoint; FStartBounds: TRect; FAppearance: TGMGripSizeAppearance; procedure PaintLines(const ADC: HDC; const ARect: TRect); virtual; procedure PaintDots(const ADC: HDC; const ARect: TRect); virtual; function GetResizeArea(var Area: IGMUiArea): Boolean; function MouseIsOnCorner: Boolean; procedure WMLButtonDown(var Msg: TWMMouse); message WM_LBUTTONDOWN; procedure WMMouseMove(var Msg: TWMMouseMove); message WM_MOUSEMOVE; procedure WMLButtonUp(var Msg: TWMLButtonUp); message WM_LBUTTONUP; procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR; procedure WMCancelMode(var Msg: TWMCancelMode); message WM_CANCELMODE; procedure StartSizing(const ATargetArea: IGMUiArea); virtual; procedure CancelSizing; virtual; public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AAppearance: TGMGripSizeAppearance = cDfltSizeGripAppearance; const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; function PaintArea(const ADC: HDC; const ARect: TRect): Boolean; override; end; TGMxImageAreaBase = class(TGMUiArea) protected FAttributes: TImgAttributes; FHorizontalAlignment: TGMHorizontalAlignment; FVerticalAlignment: TGMVerticalAlignment; FImageSize: TPoint; procedure AssignImageSize; virtual; abstract; function InternalPaintArea(const ADC: HDC; const ARect: TRect): Boolean; virtual; abstract; public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; 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; function PaintsComplete: Boolean; override; function InternalCalcWidth(const NewSize: TPoint): LongInt; override; function InternalCalcHeight(const NewSize: TPoint): LongInt; override; function PaintArea(const ADC: HDC; const ARect: TRect): Boolean; override; end; TGMxCollectionImgArea = class(TGMxImageAreaBase) protected FImageCollection: IGMImageCollection; FImageIndex: LongInt; FDisabled: Boolean; 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 AImageCollection: IGMImageCollection; const AImageIndex: LongInt; const AAttributes: TImgAttributes = []; const ABkgndColor: COLORREF = cDfltColor; const ADisabled: Boolean = False; 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); procedure SetDisabled(const ADisabled: Boolean; const ARepaint: Boolean = False); end; TGMxBmpImageAreaBase = class(TGMxImageAreaBase) // // A Bitmap painted inside the area, abstract base class! // protected FPaintBmp: IGMGetHandle; FPaintBmpDC: IGMGetHandle; FTransparentColor: COLORREF; procedure AssignImageSize; override; function InternalPaintArea(const ADC: HDC; const ARect: TRect): Boolean; override; public constructor Create(const ARefLifeTime: Boolean = False); override; function TransparentColor: COLORREF; virtual; function InternalCreatePaintBmp(const ADC: HDC): IGMGetHandle; virtual; abstract; //function PaintArea(const ADC: HDC; const ARect: TRect): Boolean; override; end; //TGMxBmpImageArea = class(TGMxBmpImageAreaBase) // public // constructor Create(const AParent: TObject; // const APosition: TRect; // const AAreaAlign: TGMAreaAlignRec; // const ABitmap: IGMGetHandle; // 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; // // function InternalCreatePaintBmp(const ADC: HDC): IGMGetHandle; override; //end; TGMxResBmpArea = class(TGMxBmpImageAreaBase) // // A Bitmap loaded from resource // protected FResName: PGMChar; FResNameStr: TGMString; FInstance: THandle; public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AResModule: THandle; const AResName: PGMChar; const AAttributes: TImgAttributes = cDfltBmpAttributes; const ABkgndColor: COLORREF = cDfltColor; const ATransparentColor: COLORREF = clrAutoTransparent; const AHorizontalAlignment: TGMHorizontalAlignment = haCenter; const AVerticalAlignment: TGMVerticalAlignment = vaCenter; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; function InternalCreatePaintBmp(const ADC: HDC): IGMGetHandle; override; end; TGMxScreenShotBmpArea = class(TGMxBmpImageAreaBase) // // A Bitmap loaded from resource // protected FScreenShotWnd: HWnd; public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AScreenShotWnd: HWnd = 0; const AAttributes: TImgAttributes = [iaKeepAspectRatio, iaHalfTone]; const ABkgndColor: COLORREF = cDfltColor; const AHorizontalAlignment: TGMHorizontalAlignment = haCenter; const AVerticalAlignment: TGMVerticalAlignment = vaCenter; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; function InternalCreatePaintBmp(const ADC: HDC): IGMGetHandle; override; end; {$IFDEF PNGSUPPORT} TGMxPngImgArea = class(TGMxImageAreaBase) protected procedure AssignImageSize; override; function InternalPaintArea(const ADC: HDC; const ARect: TRect): Boolean; override; public PngImage: IGMPngImage; constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AResourceName: PGMChar = nil; const AResourceType: PGMChar = nil; const AAttributes: TImgAttributes = []; const ABkgndColor: COLORREF = cDfltColor; const AHorizontalAlignment: TGMHorizontalAlignment = haCenter; const AVerticalAlignment: TGMVerticalAlignment = vaCenter; const AVisible: Boolean = True; AResModule: THandle = INVALID_HANDLE_VALUE; const ARefLifeTime: Boolean = False); procedure LoadFromRes(const AResourceName: PGMChar = nil; const AResourceType: PGMChar = nil; const AResModule: THandle = INVALID_HANDLE_VALUE); end; {$ENDIF} TIconSize = (izSmall, izLarge, izCustom); TGMxIconAreaBase = class(TGMxImageAreaBase) protected FIcon: HICON; FDestroyIcon: Boolean; FIconSize: TIconSize; procedure SetIcon(const Value: HICON); public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AIcon: HICON; const ADestroyIcon: Boolean = False; const AAttributes: TImgAttributes = cDfltIconAttributes; const AIconSize: TIconSize = izLarge; const ABkgndColor: COLORREF = cDfltColor; const AHorizontalAlignment: TGMHorizontalAlignment = haCenter; const AVerticalAlignment: TGMVerticalAlignment = vaCenter; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; destructor Destroy; override; property Icon: HICON read FIcon write SetIcon; //property IconSize: TPoint read FImageSize; end; TGMxIconOnBmpArea = class(TGMxBmpImageAreaBase) // // A Icon drawn onto a Bitmap for display, this may be stretched, but when transparent // TransparentColor is applied to the bitmap instead of original icon mask used with DrawIcon // protected FIcon: HICON; FDestroyIcon: Boolean; FIconSize: TIconSize; procedure SetIcon(const Value: HICON); public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AIcon: HICON; const ADestroyIcon: Boolean = False; const AAttributes: TImgAttributes = cDfltIconAttributes; const AIconSize: TIconSize = izLarge; const ABkgndColor: COLORREF = cDfltColor; const AHorizontalAlignment: TGMHorizontalAlignment = haCenter; const AVerticalAlignment: TGMVerticalAlignment = vaCenter; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; destructor Destroy; override; property Icon: HICON read FIcon write SetIcon; function InternalCreatePaintBmp(const ADC: HDC): IGMGetHandle; override; end; TGMxIconArea = class(TGMxIconAreaBase) // // This won't stretch, but always paints with original icon mask using DrawIcon // public procedure AssignImageSize; override; function InternalPaintArea(const ADC: HDC; const ARect: TRect): Boolean; override; end; TGMxResIconArea = class(TGMxIconArea) // // A Icon loaded from resource // public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AResModule: THandle; const AResName: PGMChar; const AAttributes: TImgAttributes = cDfltIconAttributes; const AIconSize: TIconSize = izLarge; const ABkgndColor: COLORREF = cDfltColor; const AHorizontalAlignment: TGMHorizontalAlignment = haCenter; const AVerticalAlignment: TGMVerticalAlignment = vaCenter; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; end; TGMxSeverityIconArea = class(TGMxIconArea) // // The Windows system Icon corresponding to ASeverity // public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ASeverity: TGMSeverityLevel; const AAttributes: TImgAttributes = cDfltIconAttributes; const AIconSize: TIconSize = izLarge; const ABkgndColor: COLORREF = cDfltColor; const AHorizontalAlignment: TGMHorizontalAlignment = haCenter; const AVerticalAlignment: TGMVerticalAlignment = vaCenter; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; end; TGMxCachedImgArea = class(TGMxBmpImageAreaBase) // // First paint draws all childs into a bitmap. // Subequent paints simply draw the cached bitmap. // The cached bitmap is recreated via child drawing when the size of the area has changed. // public function InternalCreatePaintBmp(const ADC: HDC): IGMGetHandle; override; procedure PaintContainedAreas(const ADC: HDC; const ARect: TRect); override; procedure LayoutContainedAreas(const ARepaint: Boolean); override; // : TPoint; end; TObjArray = array of TObject; TGMxTableArea = class(TGMUiArea) // // Layouting contained controls as a Grid. Overrides standard layouting. // protected //FCells: TObjArray; //FTableSize: TPoint; FColumnCount: LongInt; //function GetCellArea(const Row, Col: LongInt): TObject; //procedure SetCellArea(const ARow, ACol: LongInt; const AValue: TObject); public PaddRect: TRect; StretchAllX, StretchAllY: Boolean; constructor Create(const AParent: TObject; const AColumnCount: LongInt; // const ATableSize: TPoint; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; virtual; function RowCount: LongInt; function CalcCellIdx(const ARow, ACol: LongInt): LongInt; function CellArea(const ARow, ACol: LongInt; const ACheckCellIdx: Boolean = False): TObject; function LayoutTable(const ASize: TPoint; const ARepaint: Boolean; const ACalcOnly: Boolean): TPoint; procedure LayoutContainedAreas(const Repaint: Boolean); override; // : TPoint; function InternalCalcHeight(const NewSize: TPoint): LongInt; override; function InternalCalcWidth(const NewSize: TPoint): LongInt; override; function RootForRelayout: TObject; override; //function AssignCellArea(const Row, Col: LongInt; const Area: TObject): TObject; //property CellArea[const Row, Col: LongInt]: TObject read GetCellArea write SetCellArea; default; //property Cells: TObjArray read FCells; end; TGMxLinePaintFragmentRec = record Text: PGMChar; TextLen: LongInt; Font: HFont; FontColor, BkgndColor: COLORREF; end; TGMxLinePaintFragments = array of TGMxLinePaintFragmentRec; TGMxLineAttribute = (laIsWrapped); TGMxLineAttributes = set of TGMxLineAttribute; TGMxEditorLineRec = record Attributes: TGMxLineAttributes; Line: TGMString; end; TGMxEditor = class(TGMUiArea, IGMGetText, IGMGetSetText) protected //FOuterSpace: TRect; FLines: array of TGMxEditorLineRec; // TGMStringArray; FSelStart, FSelEnd: TPoint; // <- Zero based selection as character indexes into FLines FSelectionKind: TGMSelectionKind; FLineSpace: LongInt; FMaxTextLength: LongInt; FCaretWidth: LongInt; FFontHeight: LongInt; FLineSeparator: TGMString; FEditPos: TPoint; // <- Zero based edit position as character indexes into FLines FAttributes: TGMxEditorAttributes; FMaxLineLength: LongInt; FMouseDown: Boolean; FCaretCreated: Boolean; procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR; procedure WMKeyDown(var Msg: TWMKey); message WM_KEYDOWN; procedure WMChar(var Msg: TWMKey); message WM_CHAR; procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS; procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS; procedure WMLButtonDown(var Msg: TWMMouse); message WM_LBUTTONDOWN; procedure WMMouseMove(var Msg: TWMMouse); message WM_MOUSEMOVE; procedure WMLButtonUp(var Msg: TWMMouse); message WM_LBUTTONUP; procedure WMLButtonDblClick(var Msg: TWMMouse); message WM_LBUTTONDBLCLK; procedure WMMouseWheel(var Msg: TWMMouseWheel); message WM_MOUSEWHEEL; function FontHeight: LongInt; function CharPosFromClientPos(const AClientPos: TPoint): TPoint; // // The cursor moves between characters. So there is one more cursor position than characters in a line. // Therefore the last cursor position in a line is NOT a valid character position! // function LimitCursorPos(const ACursorPos: TPoint; const AMinBased: Boolean = True): TPoint; function NextCursorPos(const ACursorPos: TPoint): TPoint; function PrevCursorPos(const ACursorPos: TPoint): TPoint; function IsFirstCursorPos(const ACharPos: TPoint): Boolean; function IsLastCursorPos(const ACharPos: TPoint): Boolean; function CharAt(ACursorPos: TPoint): TGMChar; function CallOnBeforeTextChange: Boolean; procedure CallOnAfterTextChange; procedure RangeOrderSwap(var ARangeStart, ARangeEnd: TPoint); function IsEmptyRange(ARangeStart, ARangeEnd: TPoint): Boolean; function RangeAsText(ARangeStart, ARangeEnd: TPoint): TGMString; procedure InternalDeleteRange(var ARangeStart, ARangeEnd: TPoint); procedure InternalDeleteLines(const AStartLnIdx, ALnClount: LongInt; const PCaretUpdateNeeded: PBoolean = nil); procedure Deleteselection; // function InsertTextAt(AInsertPos: TPoint; const AText: TGMString): Boolean; function InsertLine(const ALine: TGMString; const EndsWithLineBreak: Boolean): Boolean; function InsertText(const AText: TGMString): Boolean; procedure InternalSetVisible(const Value: Boolean{; const Relayout: Boolean}); override; procedure BuildLineFragments(const ALineIdx: LongInt; var ALineFragments: TGMxLinePaintFragments); virtual; procedure PaintLineFragments(const ADC: HDC; const APos: TPoint; const ALineFragments: TGMxLinePaintFragments); virtual; function LimitVScrollPos(const AScrollPos: LongInt): LongInt; function LimitHScrollPos(const AScrollPos: LongInt): LongInt; procedure OnHScrollPosChange(const AOldPos, ANewPos: LongInt); virtual; procedure OnVScrollPosChange(const AOldPos, ANewPos: LongInt); virtual; procedure SetScrollposition(AScrollPos: TPoint); procedure SetAttributes(const AAttributes: TGMxEditorAttributes); function GetText: TGMString; stdcall; procedure SetText(const AText: TGMString); stdcall; procedure UpdateCaretPos(const AScrollCaretVisible: Boolean); procedure AdjustScrollRange(const ADirections: TGM2DDirections); procedure ScrollCharPosVisible(const ACharPos: TPoint); public VScrollBar, HScrollBar: IUnknown; OnBeforeTextChange: TGMObjNotifyBoolFunc; OnAfterTextChange: TGMObjNotifyProc; constructor Create(const ARefLifeTime: Boolean = False); override; constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString = ''; const AAttributes: TGMxEditorAttributes = cDfltEditorAttributes; const ABkgndColor: COLORREF = clrWindow; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; virtual; function InternalCalcHeight(const NewSize: TPoint): LongInt; override; function PaintArea(const ADC: HDC; const ARect: TRect): Boolean; override; function IsTabStop: Boolean; override; function IsDialogKeyMsg(const Msg: TMessage): Boolean; override; procedure SetLayoutBounds(const AValue: TRect; const ARepaint: Boolean); override; //function SelectionIsEmpty: Boolean; function DeleteRange(var ARangeStart, ARangeEnd: TPoint): Boolean; //procedure ClearSelection; procedure WrapLine(const ALineIdx: Integer; const PCaretUpdateNeeded: PBoolean = nil); procedure WrapAllLines; property Text: TGMString read GetText write SetText; property Attributes: TGMxEditorAttributes read FAttributes write SetAttributes; end; TGMxButtonArea = class(TGMUiArea, IGMIsDefaultDlgBtn) protected FMouseDown: Boolean; FOnClick: TGMObjNotifyProc; FAutoRepeat: Boolean; FRepeatTimer: IGMTimer; procedure WMLButtonDown(var Msg: TWMMouse); message WM_LBUTTONDOWN; procedure WMLButtonUp(var Msg: TWMMouse); message WM_LBUTTONUP; procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS; procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS; procedure WMKeyDown(var Msg: TWMKey); message WM_KEYDOWN; public constructor Create(const ARefLifeTime: Boolean = False); override; constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AOnClick: TGMObjNotifyProc = nil; const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const AAutoRepeat: Boolean = False; const ARefLifeTime: Boolean = False); reintroduce; overload; procedure Click(const ASender: TObject = nil); virtual; function IsDefaultDlgBtn: Boolean; virtual; function Down: Boolean; virtual; function FontBkgndColor: COLORREF; override; //property MouseDown: Boolean read FMouseDown write FMouseDown; property OnClick: TGMObjNotifyProc read FOnClick write FOnClick; end; TGMxHooverBtnArea = class(TGMxButtonArea) protected procedure WMMouseEnter(var Msg: TWMMouse); message UM_MOUSEENTER; procedure WMMouseLeave(var Msg: TWMMouse); message UM_MOUSELEAVE; function HooverWhenDisabled: Boolean; virtual; end; TGMxToolBtnAreaBase = class(TGMxHooverBtnArea, IGMGetSetEnabled) protected FDownBrush: IGMGetHandle; // FFrameColor: COLORREF; FDisabled: Boolean; public constructor Create(const ARefLifeTime: Boolean); override; function GetEnabled: Boolean; override; procedure SetEnabled(const AEnabled: Boolean); stdcall; function AreaFiller: IGMAreaFiller; override; function FrameColor: COLORREF; override; function HBkgndBrush: THandle; override; function BkgndColor: COLORREF; override; function PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; override; property Enabled: Boolean read GetEnabled write SetEnabled; end; TGMxToolBtnArea = class(TGMxToolBtnAreaBase, IGMLanguageChanged) protected FResTextRef: RGMResTextRefData; FText: TGMString; FTextDrawFlags: LongWord; FTextSide: TEdge; FImageList: IUnknown; FImageIdx: PtrInt; // LongInt; // FIcon: HIcon; FImageSize: TPoint; FFreeIcon: Boolean; FHAlignment: TGMHorizontalAlignment; FIconSpace: LongInt; // FLRSpace FFontColor: COLORREF; procedure AssignImage; virtual; public ImageDrawOffset: TPoint; 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 ABkgndColor: COLORREF = cDfltColor; const ATextSide: TEdge = edgRight; const AHAlignment: TGMHorizontalAlignment = haCenter; const AFontColor: COLORREF = clrWindowText; // const AFrameColor: COLORREF = clDfltHoverFrameColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; destructor Destroy; override; procedure ReleaseIcon; procedure LanguageChanged(const ANewLanguage: LParam); function ExecuteOperation(const Operation: Integer; const Parameter: IUnknown): Boolean; override; function PaintArea(const ADC: HDC; const ARSurface: TRect): Boolean; override; function InternalCalcWidth(const ANewSize: TPoint): LongInt; override; function InternalCalcHeight(const ANewSize: TPoint): LongInt; override; function FontColor: COLORREF; override; procedure SetImageIdx(const AImageIdx: LongInt); procedure SetText(const AText: TGMString; const AReLayout: Boolean = True); end; TGMxBoldToolBtnArea = class(TGMxToolBtnArea) public function FontHandle: THandle; override; end; {$IFDEF PNGSUPPORT} TGMxPngToolBtnArea = class(TGMxToolBtnAreaBase) protected FDisabledImage: IGMPngImage; public Image: IGMPngImage; function PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; override; end; {$ENDIF} //TGMxImgToolBtnArea = class(TGMxToolBtnAreaBase) // public // Image: TGMxImageAreaBase; // // constructor Create(const AParent: TObject; // const APosition: TRect; // const AAreaAlign: TGMAreaAlignRec; // const AOnClick: TGMObjNotifyProc = nil; // const AText: TGMString = ''; // const AImage: IGMGetHandle = nil; // const AHintTitle: TGMString = ''; // const AHintText: TGMString = ''; // const ABkgndColor: COLORREF = cDfltColor; // const AFrameColor: COLORREF = clDfltHoverFrameColor; // const AVisible: Boolean = True; // const ARefLifeTime: Boolean = False); reintroduce; overload; // // function PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; override; //end; TGMxCloseBtnArea = class(TGMxHooverBtnArea, IGMGetSetEnabled) protected FDisabled: 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 ARefLifeTime: Boolean = False); override; function PaintArea(const ADC: HDC; const ARect: TRect): Boolean; override; function BkgndColor: COLORREF; override; function GetEnabled: Boolean; override; procedure SetEnabled(const AValue: Boolean); stdcall; end; TGMxWinXPButtonArea = class(TGMxHooverBtnArea) protected FText: TGMString; public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString = ''; const AOnClick: TGMObjNotifyProc = nil; const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; function IsDialogKeyMsg(const Msg: TMessage): Boolean; override; function PaintArea(const ADC: HDC; const ARect: TRect): Boolean; override; function FontBkgndColor: COLORREF; override; function CalculateWidth(const NewSize: TPoint): LongInt; override; function CalculateHeight(const NewSize: TPoint): LongInt; override; end; TGMxToolAreaState = class(TGMRefCountedObj, IGMGetHandle, IGMAssignFromObj, IGMAssignToObj, IGMAssignFromIntf, IGMAssignToIntf) protected FArea: TObject; FParent: TObject; FVisible: Boolean; FBkgndColor: COLORREF; //FAreaAlign: TGMAreaAlignRec; FLayoutBounds: TRect; FLayoutStaceSpace: TRect; public function GetHandle: THandle; stdcall; procedure AssignFromObj(const Source: TObject); stdcall; procedure AssignToObj(const Dest: TObject); stdcall; procedure AssignFromIntf(const Source: IUnknown); stdcall; procedure AssignToIntf(const Dest: IUnknown); stdcall; public constructor Create(const AArea: TObject; const ArefLifetime: Boolean = False); reintroduce; end; TGMxChevronBtnBase = class(TGMxHooverBtnArea) protected procedure WMMouseEnter(var Msg: TWMMouse); message UM_MOUSEENTER; procedure WMMouseLeave(var Msg: TWMMouse); message UM_MOUSELEAVE; public constructor Create(const ARefLifeTime: Boolean = False); override; overload; {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 Frame: IGMAreaFrameDrawer; override; function BkgndColor: COLORREF; override; function FrameColor: COLORREF; override; function Direction: TGM2DDirection; virtual; abstract; function PaintArea(const ADC: HDC; const ARect: TRect): Boolean; override; end; TGMxChevronPopup = class(TGMWinControl) protected FAreaStates: IGMObjArrayCollection; FOrgParent: IGMUiArea; FRow: TGMUiArea; procedure WMMouseActivate(var Msg: TWMMouseActivate); message WM_MOUSEACTIVATE; public constructor Create(const ArefLifetime: Boolean = False); override; 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 TakeControls(const Source: TObject): TPoint; procedure ReturnControls(const Dest: TObject); function ClosePopupState(const RestoreActiveCtrl: Boolean = False): Boolean; override; property Row: TGMUiArea read FRow; property AreaStates: IGMObjArrayCollection read FAreaStates; end; TGMxToolBar = class; TGMxToolBarChevronBtn = class(TGMxChevronBtnBase) protected FToolBar: TGMxToolBar; 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(const ASender: TObject = nil); override; property ToolBar: TGMxToolBar read FToolBar; property Popup: TGMxChevronPopup read FPopup; end; // // Most Toolbar elements use HintWindows. HintWindows hook its parent WndProc. // If the Toolbar does not have a window handle of its own the Mainwindow // may become hooked many times, making it slow. // TGMxToolBar = class(TGMWinControl) // TGMUiArea protected FChevronBtn: TGMxToolBarChevronBtn; FDirection: TGM2DDirection; procedure HideOrShowChildAreas; //procedure WMMouseActivate(var Msg: TWMMouseActivate); message WM_MOUSEACTIVATE; public constructor Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ADirection: TGM2DDirection = d2dHorizontal; const ABkgndColor: COLORREF = cDfltColor; const AWndStyle: DWORD = WS_VISIBLE; const AWndExStyle: DWORD = cDfltWndExStyle; const ARefLifeTime: Boolean = False); overload; //function Direction: TGM2DDirection; procedure LayoutContainedAreas(const ARepaint: Boolean); override; // : TPoint; property Direction: TGM2DDirection read FDirection; property ChevronBtn: TGMxToolBarChevronBtn read FChevronBtn; end; TGMxSplitter = class(TGMUiArea) protected FDragOrigin: TPoint; FStartValue: LongInt; FResizeDirection: TGM2DDirection; FResizeArea: TObject; FRestFillArea: TObject; FResizeAreaAlign: TGMAreaAlignRec; procedure SetResizeArea(const Value: TObject); procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR; procedure WMLButtonDown(var Msg: TWMMouse); message WM_LBUTTONDOWN; procedure WMLButtonUp(var Msg: TWMMouse); message WM_LBUTTONUP; procedure WMMouseMove(var Msg: TWMMouseMove); message WM_MOUSEMOVE; //function ReSizeArea: IGMUiArea; procedure FindOppositeArea; public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AResizeArea: TObject = nil; //const AResizeDirection: TGM2DDirection = Low(TGM2DDirection); const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; function IsDragging: Boolean; function PaintArea(const ADC: HDC; const ARect: TRect): Boolean; override; procedure CreateHandle; override; property ResizeArea: TObject read FResizeArea write SetResizeArea; end; TGMxGradientArea = class(TGMUiArea) protected FGradientFiller: IGMAreaFiller; public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AColor1, AColor2: COLORREF; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; virtual; function AreaFiller: IGMAreaFiller; override; end; { -------------------- } { ---- Assemblies ---- } { -------------------- } TGMxCheckBoxArea = class; TGMxCheckBoxImgArea = class(TGMUiArea) protected FCheckBoxArea: TGMxCheckBoxArea; public constructor Create(const ARefLifeTime: Boolean = False); override; constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; function PaintArea(const ADC: HDC; const ARect: TRect): Boolean; override; function InternalCalcWidth(const NewSize: TPoint): LongInt; override; function InternalCalcHeight(const NewSize: TPoint): LongInt; override; end; TGMxCheckBoxArea = 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 ARefLifeTime: Boolean = False); override; constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString = ''; const AOnClick: TGMObjNotifyProc = nil; const ABkgndColor: COLORREF = cDfltColor; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; procedure Click; virtual; procedure Clear(const ANotify: Boolean = True); override; function AreaFiller: IGMAreaFiller; override; function PaintArea(const ADC: HDC; const ARect: TRect): Boolean; override; function ExecuteOperation(const Operation: Integer; const Parameter: IUnknown): Boolean; override; function GetEnabled: Boolean; override; function BkgndColor: COLORREF; override; procedure SetEnabled(const AEnabled: Boolean); stdcall; property Checked: Boolean read FChecked write SetChecked; property Enabled: Boolean read GetEnabled write SetEnabled; end; TGMxIconOnResBmp = class(TGMxCachedImgArea) public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AIcon: HICON; const ADestroyIcon: Boolean; const AResModule: THandle; const ABmpResName: PGMChar; const AIconSize: TIconSize = izLarge; const ABkgndColor: COLORREF = cDfltColor; const ARefLifeTime: Boolean = False); reintroduce; overload; constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ASeverity: TGMSeverityLevel; const AResModule: THandle; const ABmpResName: PGMChar; const AIconSize: TIconSize = izLarge; const ABkgndColor: COLORREF = cDfltColor; const ARefLifeTime: Boolean = False); reintroduce; overload; end; {TGMResBmpOnResBmp = class(TGMxCachedImgArea) public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AResModule: THandle; const ABmpResName: PGMChar; const ABkgndBmpResName: PGMChar; const ABkgndColor: COLORREF = cDfltColor; const ARefLifeTime: Boolean = False); reintroduce; overload; end;} TGMMessageAreaAttribute = (maaClosable); TGMMessageAreaAttributes = set of TGMMessageAreaAttribute; const cDefaultMessageAreaAttributes = []; type TGMxMessageArea = class(TGMSurroundingUiArea) protected //FRounded: Boolean; FShrinkDelta: LongInt; //procedure CreateFrame; override; procedure OnCloseBtnClick(const Sender: TObject); public constructor Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString; const ATitle: TGMString = ''; const AAttributes: TGMMessageAreaAttributes = cDefaultMessageAreaAttributes; const AIcon: TGMSeverityLevel = svInformation; const ABkgndColor: COLORREF = clrInfoBkgnd; const AVisible: Boolean = True; const ARefLifeTime: Boolean = False); reintroduce; overload; //function CreateAreaRegion(const ABoundingRect: TRect; const ARegionKind: TGMAreaRegionKind): IGMGetHandle; override; //function FrameColor: COLORREF; override; function InternalCalcHeight(const NewSize: TPoint): LongInt; override; end; TGMLabelAndCtrlRec = record Label_, Ctrl: TObject; end; function GMToolBtnAreaFrame: IGMAreaFrameDrawer; function GMDlgBtnTitle(const ABtnKind: TDlgBtnKind): TGMString; procedure GMPaintDot(const ADC: HDC; const X, Y, SZ: LongInt); procedure GMPaintBtnCross(const ADC: HDC; const ARect: TRect); function GMToolBtnFiller: IGMAreaFiller; function GMEditorLine(const ALine: TGMString = ''; const AAttributes: TGMxLineAttributes = []): TGMxEditorLineRec; //function SetWindowTheme(hwnd: HWND; pszSubAppName: PWideChar; pszSubIdList: PWideChar): HRESULT; stdcall; external 'UxTheme.dll'; resourcestring RStrBtnOk = '&Ok'; RStrBtnCancel = '&Cancel'; RStrBtnClose = '&Close'; RStrBtnHelp = '&Help'; RStrBtnYes = '&Yes'; RStrBtnNo = '&No'; RStrBtnAbort = '&Abort'; RStrBtnIgnore = '&Ignore'; RStrBtnRetry = '&Retry'; RStrBtnContinue = '&Continue'; var //TDlgBtnKind = (dbkNone, dbkCancel, dbkOk, dbkClose, dbkHelp, dbkNo, dbkYes, dbkAbort, dbkIgnore, dbkRetry, dbkContinue); vDlgBtnMessage: array [TDlgBtnKind] of LongInt = (0, WM_CLOSE, WM_CLOSE, WM_CLOSE, WM_HELP, WM_CLOSE, WM_CLOSE, WM_CLOSE, WM_CLOSE, WM_CLOSE, WM_CLOSE); vDlgBtnModalResult: array [TDlgBtnKind] of LongInt = (0, IDCANCEL, IDOK, IDCLOSE, IDHELP, IDNO, IDYES, IDABORT, IDIGNORE, IDRETRY, IDIGNORE); vGMSmallBtnRounding: TPoint = (X:2; Y:2); const cScrollArrowStates: array [TGM2DDirection] of TGMScrollArrowStates = (((ESB_ENABLE_BOTH, ESB_DISABLE_RIGHT), (ESB_DISABLE_LEFT, ESB_DISABLE_BOTH)), ((ESB_ENABLE_BOTH, ESB_DISABLE_DOWN), (ESB_DISABLE_UP, ESB_DISABLE_BOTH))); cCharAtLineBreak = #13; implementation {$IFDEF JEDIAPI}uses jwaWinBase, jwaWinGdi;{$ENDIF} const cIconDrawFlags: array [Boolean] of DWORD = (DI_IMAGE, DI_NORMAL); cSpc2 = 2; var vGMToolBtnAreaFrame: IGMAreaFrameDrawer = nil; //vGMHighLightBkgndBrush: IGMGetHandle = nil; vGMToolBtnFiller: IGMAreaFiller = nil; {$IFDEF FPC} {$EXTERNALSYM TransparentBlt} function TransparentBlt(dcDest: HDC; xoriginDest, yoriginDest, wDest, hDest: Integer; hdcSrc: HDC; xoriginSrc, yoriginSrc, wSrc, hSrc: Integer; crTransparent: UINT): BOOL; stdcall; external 'msimg32.dll' name 'TransparentBlt'; {$ENDIF} { ------------------------- } { ---- Global Routines ---- } { ------------------------- } //procedure AdjustWndEditRect(const Handle: HWnd; const FontHeight: LongInt; const RightSpace: LongInt = 0); //const CSpace = 1; //var REdit, RClient: TRect; //begin // if not IsWindow(Handle) or (GetWindowLong(Handle, GWL_STYLE) and ES_MULTILINE = 0) then Exit; // Windows.GetClientRect(Handle, RClient); // SendMessage(FHandle, EM_GETRECT, 0, LongInt(@REdit)); // REdit := GMCenterRectInRect(Rect(RClient.Left + CSpace, 0, RClient.Right - CSpace - RightSpace, // Max(GMAbsInt(FontHeight) + 1, GMRectSize(REdit).y)), RClient); // SendMessage(FHandle, EM_SETRECTNP, 0, LongInt(@REdit)); //end; {function GMHighLightBkgndBrush: HBrush; begin if vGMHighLightBkgndBrush = nil then vGMHighLightBkgndBrush := TGMGdiBrush.Create(0, clrHighLight); Result := vGMHighLightBkgndBrush.Handle; end;} function GMDlgBtnTitle(const ABtnKind: TDlgBtnKind): TGMString; begin case ABtnKind of dbkCancel: Result := GMMakeResRefText(@RStrBtnCancel); dbkOk: Result := GMMakeResRefText(@RStrBtnOk); dbkClose: Result := GMMakeResRefText(@RStrBtnClose); dbkHelp: Result := GMMakeResRefText(@RStrBtnHelp); dbkYes: Result := GMMakeResRefText(@RStrBtnYes); dbkNo: Result := GMMakeResRefText(@RStrBtnNo); dbkAbort: Result := GMMakeResRefText(@RStrBtnAbort); dbkIgnore: Result := GMMakeResRefText(@RStrBtnIgnore); dbkRetry: Result := GMMakeResRefText(@RStrBtnRetry); dbkContinue: Result := GMMakeResRefText(@RStrBtnContinue); else Result := ''; end; end; procedure GMPaintDot(const ADC: HDC; const X, Y, SZ: LongInt); const clShadow = $A0A0A0; var R: TRect; Brush: IGMGetHandle; begin Brush := TGMGdiBrush.Create(ADC, clWhite); // clrBtnHighlight R := GMRect(X+1, Y+1, X+SZ, Y+SZ); FillRect(ADC, R, Brush.Handle); OffsetRect(R, -1, -1); Brush := nil; Brush := TGMGdiBrush.Create(ADC, clShadow); // clrBtnShadow FillRect(ADC, R, Brush.Handle); end; procedure GMPaintBtnCross(const ADC: HDC; const ARect: TRect); const cxr = 0; begin MoveToEx(ADC, ARect.Left, ARect.Top, nil); LineTo(ADC, ARect.Right-2-cxr, ARect.Bottom-cxr); MoveToEx(ADC, ARect.Left+1, ARect.Top, nil); LineTo(ADC, ARect.Right-1-cxr, ARect.Bottom-cxr); MoveToEx(ADC, ARect.Left+2, ARect.Top, nil); LineTo(ADC, ARect.Right-cxr, ARect.Bottom-cxr); MoveToEx(ADC, ARect.Left, ARect.Bottom-1-cxr, nil); LineTo(ADC, ARect.Right-2-cxr, ARect.Top-1); MoveToEx(ADC, ARect.Left+1, ARect.Bottom-1-cxr, nil); LineTo(ADC, ARect.Right-1-cxr, ARect.Top-1); MoveToEx(ADC, ARect.Left+2, ARect.Bottom-1-cxr, nil); LineTo(ADC, ARect.Right-cxr, ARect.Top-1); end; function GMToolBtnFiller: IGMAreaFiller; begin // $f7d0a1 [$ffe8b9, $cd8c2e] //if vGMToolBtnFiller = nil then vGMToolBtnFiller := TGMAreaGradientFiller.Create(d2dVertical, [$fdf3ed, $E19975]); // $f8b08c //if vGMToolBtnFiller = nil then vGMToolBtnFiller := TGMGlassLookFiller.Create([$FFFAF7, $FEECE3, $FDDCCC, $FFF9F5, $FCCCB6]); // Rahmen: $FBBEA1 //if vGMToolBtnFiller = nil then vGMToolBtnFiller := TGMSimpleGlassLookFiller.Create(clrGlassBlue); // vGMGlassFillColors// [$FFFDFB, $FEECE3, $FDDCCB, $FFFBF9, $FAB08d] // Rahmen: $FAA881 // Result := TGMSimpleGlassLookFiller.Create(True); // clrGlassBlue if vGMToolBtnFiller = nil then vGMToolBtnFiller := TGMSimpleGlassLookFiller.Create(True); Result := vGMToolBtnFiller; end; function GMEditorLine(const ALine: TGMString; const AAttributes: TGMxLineAttributes): TGMxEditorLineRec; begin Result.Attributes := AAttributes; Result.Line := ALine; end; function IsWordBreakchar(const ACh: TGMChar): Boolean; begin //Result := ACh in cWordBreakChars; case ACh of #0..#32, '.', ',', ';', ':', '"', '�', '^', '!', '?', '&', '$', '@', '%', '#', '~', '[', ']', '(', ')', '{', '}', '<', '>', '-', '=', '+', '*', '/', '\', '|': Result := True; else Result := False; end; //case Ch of // 'a'..'z', 'A'..'Z', '0'..'9', '_', '�', '�', '�', '�', '�', '�', '�': Result := False; // else Result := True; //end; end; function GMToolBtnAreaFrame: IGMAreaFrameDrawer; begin if vGMToolBtnAreaFrame = nil then vGMToolBtnAreaFrame := TGMAreaFakeFrame.Create(1, cAllEdges); Result := vGMToolBtnAreaFrame; end; { ------------------- } { ---- TGMxLabel ---- } { ------------------- } constructor TGMxLabel.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const APaddSpace: TRect; const AText: TGMString; const ABkgndColor: COLORREF; const AFont: HFONT; const AFontColor: COLORREF; const ADrawFlags: DWORD; const ATextHAlignment: TGMHorizontalAlignment; const AtextVAlignment: TGMVerticalAlignment; const AVisible: Boolean; const ARefLifeTime: Boolean); begin {inherited} Create(AParent, APosition, AAreaAlign, ABkgndColor, AVisible, ARefLifeTime); FText := GMResolveTextResData(AText, FResTextRef); //FText := AText; FTextVAlignment := AtextVAlignment; FTextHAlignment := ATextHAlignment; FDrawFlags := ADrawFlags; if AFont <> 0 then FFont := AFont else FFont := GetStockObject(DEFAULT_GUI_FONT); FFontColor := AFontColor; FPaddSpace := APaddSpace; end; function TGMxLabel.FontHandle: THandle; begin Result := FFont; end; function TGMxLabel.FontColor: COLORREF; begin if Assigned(OnGetFontColor) then Result := OnGetFontColor else Result := FFontColor; end; function TGMxLabel.GetText: TGMString; stdcall; begin Result := FText; end; //function TGMxLabel.PaintsComplete: Boolean; //begin //Result := BkgndColor <> clrTransparent; //end; procedure TGMxLabel.LanguageChanged(const ANewLanguage: LParam); begin FText := GMBuildTextFromResRef(FResTextRef, FText); end; function TGMxLabel.TextRect(const ASize: TPoint): TRect; begin // ASize is client area size => Area - Frame ! Result.TopLeft := cNullPoint; Result.BottomRight := GMPoint(Max(0, ASize.x - FPaddSpace.Left - FPaddSpace.Right), Max(0, ASize.y - FPaddSpace.Top - FPaddSpace.Bottom)); end; procedure TGMxLabel.SetText(const AText: TGMString); stdcall; var font: IUnknown; oldTextSize, newTextSize: TPoint; rText: TRect; memDC: IGMGetHandle; begin if FText = AText then Exit; if not Visible or not (FAutoCalcSize[d2dHorizontal] or FAutoCalcSize[d2dVertical]) then begin FText := AText; if Visible then ScheduleRepaint; Exit; // <- Note: May exit here! end; rText := TextRect(ClientAreaSize); //SyncLock := TGMCriticalSectionLock.Create(UICalcMemDC); memDC := TGMGdiCompatibleDC.Create(0, 0, True); font := TGMGdiObjSelector.Create(memDC.Handle, FontHandle); oldTextSize := GMMultiLineTextSize(memDC.Handle, FText, rText, FDrawFlags); FText := AText; newTextSize := GMMultiLineTextSize(memDC.Handle, AText, rText, FDrawFlags); if (((GMRectSize(rText).x <> oldTextSize.x) or (oldTextSize.x = newTextSize.x)) or not FAutoCalcSize[d2dHorizontal]) and (((GMRectSize(rText).y <> oldTextSize.y) or (oldTextSize.y = newTextSize.y)) or not FAutoCalcSize[d2dVertical]) then ScheduleRepaint else GMReLayoutContainedAreas(Parent); end; function TGMxLabel.ExecuteOperation(const AOperation: LongInt; const AParameter: IUnknown): Boolean; begin case AOperation of Ord(goDisable): begin SetEnabled(False); Result := True; end; Ord(goEnable): begin SetEnabled(True); Result := True; end; else Result := inherited ExecuteOperation(AOperation, AParameter); end; end; procedure TGMxLabel.SetTextValue(const ATextValue: TGMString); begin FText := ATextValue; end; function TGMxLabel.GetEnabled: Boolean; begin Result := not FDisabled; end; procedure TGMxLabel.SetEnabled(const AEnabled: Boolean); stdcall; begin if AEnabled = not FDisabled then Exit; FDisabled := not AEnabled; ScheduleRepaint; end; procedure TGMxLabel.SetFDrawFlags(const ADrawFlags: DWORD); begin if ADrawFlags = FDrawFlags then Exit; FDrawFlags := ADrawFlags; GMReLayoutContainedAreas(Parent); end; procedure TGMxLabel.SetPaddSpace(const APaddSpace: TRect); begin if EqualRect(FPaddSpace, APaddSpace) then Exit; FPaddSpace := APaddSpace; GMReLayoutContainedAreas(Parent); end; procedure TGMxLabel.SetFontHandle(const AValue: HFont; const ARelayout: Boolean); begin if AValue = FontHandle then Exit; FFont := AValue; if ARelayout then GMReLayoutContainedAreas(Parent); end; procedure TGMxLabel.SetFontColor(const AColor: COLORREF; const ARepaint: Boolean); begin if AColor = FFontColor then Exit; FFontColor := AColor; if ARepaint then ScheduleRepaint; end; //procedure TGMxLabel.PaintBackground(const ADC: HDC; const AClientRect: TRect; const ARegion: IGMGetHandle); //begin // // inherited PaintBackground(ADC, AClientRect, ARegion); //end; function TGMxLabel.PaintArea(const ADC: HDC; const ARect: TRect): Boolean; var RText: TRect; // rgnFill, rgnText: IGMGetHandle; // BoundsRgn, DrawRgn: IGMGetHandle; RDraw begin // ARect is client area => Area - Frame ! Result := inherited PaintArea(ADC, ARect); if ADC = 0 then Exit; RText := GMRect(ARect.Left + FPaddSpace.Left, ARect.Top + FPaddSpace.Top, ARect.Right - FPaddSpace.Right, ARect.Bottom - FPaddSpace.Bottom); //RDraw := RText := GMPaintText(ADC, Text, RText, not FDisabled, FTextHAlignment, FTextVAlignment, FDrawFlags); //rgnText := TGMGdiRegion.CreateRect(0, RText); //rgnFill := TGMGdiRegion.CreateRect(0, ARect); //if not (CombineRgn(rgnFill.Handle, rgnFill.Handle, rgnText.Handle, RGN_DIFF) in [ERROR, NULLREGION]) then // FillRgn(ADC, rgnFill.Handle, HBkgndBrush); {BoundsRgn := CreateAreaRegion(ARect); DrawRgn := TGMGdiRegion.CreateRect(0, RDraw); if not (CombineRgn(BoundsRgn.Handle, BoundsRgn.Handle, DrawRgn.Handle, RGN_DIFF) in [ERROR, NULLREGION]) then begin rgnFill(ADC, BoundsRgn.Handle, HBkgndBrush); //FloodFill(ADC, ARect.Right-3, ARect.Bottom-3, BkgndColor); end;} end; function TGMxLabel.InternalCalcWidth(const ANewSize: TPoint): LongInt; //var Font: IUnknown; MemDC: IGMGetHandle; FrameSize: TPoint; begin {FrameSize := GMFrameExtent(Frame); MemDC := TGMGdiCompatibleDC.Create(0, True); Font := TGMGdiObjSelector.Create(MemDC.Handle, FontHandle); Result := GMMultiLineTextSize(MemDC.Handle, FText, TextRect(GMAddPoints(ANewSize, FrameSize, -1)), FDrawFlags).x + FrameSize.x + FPaddSpace.Left + FPaddSpace.Right;} with FPaddSpace do Result := GMCalcTextAreaSize(Text, ANewSize, GMFrameExtent(Frame), GMPoint(Left + Right, Top + Bottom), FontHandle, FDrawFlags).x; end; function TGMxLabel.InternalCalcHeight(const ANewSize: TPoint): LongInt; //var Font: IUnknown; MemDC: IGMGetHandle; FrameSize: TPoint; begin {FrameSize := GMFrameExtent(Frame); MemDC := TGMGdiCompatibleDC.Create(0, True); Font := TGMGdiObjSelector.Create(MemDC.Handle, FontHandle); Result := GMMultiLineTextSize(MemDC.Handle, FText, TextRect(GMAddPoints(ANewSize, FrameSize, -1)), FDrawFlags).y + FrameSize.y + FPaddSpace.Top + FPaddSpace.Bottom;} with FPaddSpace do Result := GMCalcTextAreaSize(Text, ANewSize, GMFrameExtent(Frame), GMPoint(Left + Right, Top + Bottom), FontHandle, FDrawFlags).y; end; { ----------------------- } { ---- TGMxTextLabel ---- } { ----------------------- } constructor TGMxTextLabel.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const APaddSpace: TRect; const AText: TGMString; const ABkgndColor: COLORREF; const AFont: HFONT; const AFontColor: COLORREF; const ADrawFlags: DWORD; const ATextHAlignment: TGMHorizontalAlignment; const AtextVAlignment: TGMVerticalAlignment; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, Aposition, AAreaAlign, APaddSpace, AText, ABkgndColor, AFont, AFontColor, ADrawFlags, ATextHAlignment, ATextVAlignment, AVisible, ARefLifeTime); end; { ---------------------- } { ---- TGMxUrlLabel ---- } { ---------------------- } constructor TGMxUrlLabel.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const APaddSpace: TRect; const AText: TGMString; const AUrl: TGMString; const ABkgndColor: COLORREF; // cDfltColor; clrTransparent const AOnClick: TGMObjNotifyProc; const AFont: HFONT; const AFontColor: COLORREF; const ATextHAlignment: TGMHorizontalAlignment; const AtextVAlignment: TGMVerticalAlignment; const ADrawFlags: DWORD; const AVisible: Boolean; const ARefLifeTime: Boolean); begin inherited Create(AParent, Aposition, AAreaAlign, APaddSpace, AText, ABkgndColor, AFont, AFontColor, ADrawFlags, ATextHAlignment, ATextVAlignment, AVisible, ARefLifeTime); if AUrl = '' then FUrl := AText else FUrl := AUrl; OnClick := AOnClick; end; {constructor TGMxUrlLabel.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const APaddSpace: TRect; const AText, AUrl: TGMString; const ATextHAlignment: TGMHorizontalAlignment; const AtextVAlignment: TGMVerticalAlignment; const ABkgndColor: COLORREF; const ADrawFlags: DWORD; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, Aposition, AAreaAlign, APaddSpace, AText, ABkgndColor, 0, clBlue, ATextHAlignment, ATextVAlignment, ADrawFlags, AVisible, ARefLifeTime); if AUrl = '' then FUrl := AText else FUrl := AUrl; end;} {function TGMxUrlLabel.MouseOverText: Boolean; var Font: IUnknown; MemDC: IGMGetHandle; RText: TRect; // FrameSize: TPoint; begin RText := CalculateSurfaceRect(LayoutBounds); MemDC := TGMGdiCompatibleDC.Create(0, True); Font := TGMGdiObjSelector.Create(MemDC.Handle, FontHandle); DrawText(MemDC.Handle, PGMChar(Text), Length(Text), RText, FDrawFlags or DT_CALCRECT); Result := PtInRect(RText, GMScreenToClient(Self, GMMousePosition)); end;} procedure TGMxUrlLabel.WMSetCursor(var Msg: TWMSetCursor); begin inherited; SetCursor(LoadCursor(0, Pointer(IDC_HAND))); Msg.Result := 1; end; procedure TGMxUrlLabel.WMLButtonDown(var Msg: TWMMouse); begin inherited; //if not Enabled then Exit; FMouseDown := True; GMCaptureMouseInput(Self); end; procedure TGMxUrlLabel.WMLButtonUp(var Msg: TWMMouse); var MouseDn: Boolean; begin MouseDn := FMouseDown; FMouseDown := False; GMReleaseMouseCapture; inherited; if {Enabled and} MouseDn and MouseInside then Click; end; procedure TGMxUrlLabel.WMMouseEnter(var Msg: TWMMouse); begin inherited; ScheduleRepaint; //GMReLayoutContainedAreas(Parent); <- needed for FW_BOLD end; procedure TGMxUrlLabel.WMMouseLeave(var Msg: TWMMouse); begin inherited; ScheduleRepaint; //GMReLayoutContainedAreas(Parent); <- needed for FW_BOLD end; procedure TGMxUrlLabel.Click(const ASender: TObject); begin if Assigned(OnClick) then OnClick(Self) else if GMIsUrl(FUrl) then GMShowURL(FUrl) else if GMIsUrl(Text) then GMShowURL(Text); end; function TGMxUrlLabel.FontHandle: THandle; var fontData: TLogFont; begin if MouseInside then begin if (FHoverFont = nil) and (FFont <> 0) then begin FHoverFont := TGMGdiFont.Create(0, dfUIFont); FillByte(fontData, SizeOf(fontData), 0); GMApiCheckObj('GetFontData', '', GetLastError, GetObject(FFont, SizeOf(fontData), @fontData) <> 0, Self); fontData.lfUnderline := 1; FHoverFont.fontData := fontData; end; if FHoverFont = nil then Result := inherited FontHandle else Result := FHoverFont.Handle; end else Result := inherited FontHandle; end; { ---------------------- } { ---- TGMxSizeGrip ---- } { ---------------------- } constructor TGMxSizeGrip.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AAppearance: TGMGripSizeAppearance; const ABkgndColor: COLORREF; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, ABkgndColor, AVisible, ARefLifeTime); FAppearance := AAppearance; FDragOrigin := cInvalidUIPoint; FStartBounds := cInvalidUIRect; end; function TGMxSizeGrip.GetResizeArea(var Area: IGMUiArea): Boolean; var ParentObj: TObject; PIParent: IGMGetParentObj; begin Result := False; ParentObj := Parent; while ParentObj <> nil do begin if ParentObj.GetInterface(IGMUiArea, Area) and not Area.IsLayoutChild then begin Result := True; Exit; end; GMCheckgetInterface(ParentObj, IGMGetParentObj, PIParent, {$I %CurrentRoutine%}); ParentObj := PIParent.ParentObj; end; Area := nil; end; function TGMxSizeGrip.MouseIsOnCorner: Boolean; var R: TRect; MousePos: TPoint; begin MousePos := GMScreenToClient(Self, GMMousePosition); R := CalculateSurfaceRect(LayoutBounds); Result := MousePos.x + MousePos.y >= (R.Left + R.Right + R.Top + R.Bottom) div 2; end; procedure TGMxSizeGrip.WMLButtonDown(var Msg: TWMMouse); var Area: IGMUiArea; // PIHandle: IGMGetHandle; begin inherited; if not MouseIsOnCorner then Exit; // Use global mouse position instead of position inside Msg for resizing // Msg.Pos is relative to windowed parent client rect! if GetResizeArea(Area) then StartSizing(Area); end; procedure TGMxSizeGrip.StartSizing(const ATargetArea: IGMUiArea); begin FDragOrigin := GMMousePosition; // GMClientToScreen(Self, SmallPointToPoint(Msg.Pos)); FStartBounds := ATargetArea.LayoutBounds; GMCaptureMouseInput(Self); end; procedure TGMxSizeGrip.CancelSizing; begin FDragOrigin := cInvalidUIPoint; FStartBounds := cInvalidUIRect; if vGMMouseCaptureArea = self then GMReleaseMouseCapture; end; procedure TGMxSizeGrip.WMCancelMode(var Msg: TWMCancelMode); begin CancelSizing; inherited; end; procedure TGMxSizeGrip.WMLButtonUp(var Msg: TWMLButtonUp); begin //GMCallObjWindowProc(Self, WM_CANCELMODE, 0, 0); CancelSizing; inherited; end; procedure TGMxSizeGrip.WMMouseMove(var Msg: TWMMouseMove); var Area: IGMUiArea; MousePos: TPoint; SizeLimit: IGMGetSizeConstraints; NewBounds: TRect; SizeConstraints: TGMSizeConstraintsRec; begin inherited; {ToDo: Resize in other corners than right-bottom} if (FDragOrigin.Y <> cInvalidUIPos) and (FDragOrigin.X <> cInvalidUIPos) and GetResizeArea(Area) then begin MousePos := GMMousePosition; // GMClientToScreen(Self, SmallPointToPoint(Msg.Pos)); with FStartBounds do NewBounds := GMRect(Left, Top, Right + MousePos.x - FDragOrigin.x, Bottom + MousePos.y - FDragOrigin.y); if GMQueryInterface(Area, IGMGetSizeConstraints, SizeLimit) then begin SizeConstraints := SizeLimit.GetSizeContraints; if SizeConstraints.MinWidth > 0 then with NewBounds do Right := Max(Right, Left + SizeConstraints.MinWidth); if SizeConstraints.MinHeight > 0 then with NewBounds do Bottom := Max(Bottom, Top + SizeConstraints.MinHeight); if SizeConstraints.MaxWidth > 0 then with NewBounds do Right := Min(Right, Left + SizeConstraints.MaxWidth); if SizeConstraints.MaxHeight > 0 then with NewBounds do Bottom := Min(Bottom, Top + SizeConstraints.MaxHeight); end; Area.SetLayoutBounds(NewBounds, True); GMExecPendingPainting(Self); end; end; procedure TGMxSizeGrip.WMSetCursor(var Msg: TWMSetCursor); begin if MouseIsOnCorner then begin SetCursor(LoadCursor(0, Pointer(IDC_SIZENWSE))); Msg.Result := 1; end else inherited; end; procedure TGMxSizeGrip.PaintLines(const ADC: HDC; const ARect: TRect); var n, x: LongInt; procedure DrawDiagonale(const n: LongInt; const Color: COLORREF); var Pen: IUnknown; begin Pen := TGMGdiPen.Create(ADC, Color); MoveToEx(ADC, ARect.Right - x + n, ARect.Bottom, nil); LineTo(ADC, ARect.Right, ARect.Bottom - x + n); end; begin x := Max(Min(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top), 0); n := 0; DrawDiagonale(n, clrBtnFace); Inc(n); while n < x do begin DrawDiagonale(n, clrBtnFace); Inc(n); DrawDiagonale(n, clrBtnHighlight); Inc(n); DrawDiagonale(n, clrBtnShadow); Inc(n); DrawDiagonale(n, clrBtnShadow); Inc(n); end; end; procedure TGMxSizeGrip.PaintDots(const ADC: HDC; const ARect: TRect); const CSquare = 4; c1 = 1; var i, j: LongInt; begin for i:= 1 to 3 do if ARect.Left <= ARect.Right - i * CSquare then for j:=1 to 4-i do if ARect.Top <= ARect.Bottom - j * CSquare then GMPaintDot(ADC, ARect.Right - i * CSquare + c1, ARect.Bottom - j * CSquare + c1, 3); end; function TGMxSizeGrip.PaintArea(const ADC: HDC; const ARect: TRect): Boolean; begin {ToDo: Paint in other corners than right-bottom} Result := inherited PaintArea(ADC, ARect); case FAppearance of sgaLines: PaintLines(ADC, ARect); sgaDots: PaintDots(ADC, ARect); end; end; {procedure TGMxSizeGrip.PaintArea(const ADC: HDC; var RClient: TRect): Boolean; const CGripStyle: array [Boolean] of LongWord = (DFCS_SCROLLSIZEGRIP, DFCS_SCROLLSIZEGRIPRIGHT); begin inherited Paint; DrawFrameControl(Canvas.Handle, ClientRect, DFC_SCROLL, CGripStyle[akLeft in Anchors]); end;} { --------------------------- } { ---- TGMxImageAreaBase ---- } { --------------------------- } constructor TGMxImageAreaBase.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AAttributes: TImgAttributes; const ABkgndColor: COLORREF; const AHorizontalAlignment: TGMHorizontalAlignment; const AVerticalAlignment: TGMVerticalAlignment; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, ABkgndColor, AVisible, ARefLifeTime); FAttributes := AAttributes; FHorizontalAlignment := AHorizontalAlignment; FVerticalAlignment := AVerticalAlignment; end; function TGMxImageAreaBase.PaintsComplete: Boolean; var SurfaceSize: TPoint; begin if iaTransparent in FAttributes then begin Result := False; Exit; end; AssignImageSize; SurfaceSize := ClientAreaSize; Result := // not (iaTransparent in FAttributes) and (((iaStretched in FAttributes) and (FImageSize.x > 0) and (FImageSize.y > 0)) or ((SurfaceSize.x <= FImageSize.x) and (SurfaceSize.y <= FImageSize.y))); end; function TGMxImageAreaBase.InternalCalcHeight(const NewSize: TPoint): LongInt; begin AssignImageSize; if ([iaStretched, iaKeepAspectRatio] - FAttributes = []) and (FImageSize.x > 0) then Result := Round((FImageSize.y / FImageSize.x) * NewSize.x) else Result := Max(0, FImageSize.y) + GMFrameExtent(Frame).y; end; function TGMxImageAreaBase.InternalCalcWidth(const NewSize: TPoint): LongInt; begin AssignImageSize; if ([iaStretched, iaKeepAspectRatio] - FAttributes = []) and (FImageSize.y > 0) then Result := Round((FImageSize.x / FImageSize.y) * NewSize.y) else Result := Max(0, FImageSize.x) + GMFrameExtent(Frame).x; end; function TGMxImageAreaBase.PaintArea(const ADC: HDC; const ARect: TRect): Boolean; var RDraw: TRect; oldStrechMode: LongInt; begin Result := inherited PaintArea(ADC, ARect); AssignImageSize; if (FImageSize.x <= 0) or (FImageSize.y <= 0) then Exit; if iaStretched in FAttributes then RDraw := ARect else RDraw := GMLayoutRect(ARect, FImageSize, FHorizontalAlignment, FVerticalAlignment); if iaHalfTone in FAttributes then oldStrechMode := GMSetBmpStretchMode(ADC, HALFTONE, Self) else oldStrechMode := 0; try InternalPaintArea(ADC, RDraw); finally if iaHalfTone in FAttributes then GMSetBmpStretchMode(ADC, oldStrechMode, Self); end; end; { ------------------------------- } { ---- TGMxCollectionImgArea ---- } { ------------------------------- } constructor TGMxCollectionImgArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AImageCollection: IGMImageCollection; const AImageIndex: Integer; const AAttributes: TImgAttributes; const ABkgndColor: COLORREF; const ADisabled: Boolean; const AHorizontalAlignment: TGMHorizontalAlignment; const AVerticalAlignment: TGMVerticalAlignment; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, AAttributes, ABkgndColor, AHorizontalAlignment, AVerticalAlignment, AVisible, ARefLifeTime); FImageCollection := AImageCollection; FImageIndex := AImageIndex; FDisabled := ADisabled; end; procedure TGMxCollectionImgArea.AssignImageSize; begin if (FImageCollection <> nil) and (FImageIndex >= Ord(Low(FImageCollection.Obj.ImageDescs))) and (FImageIndex <= Ord(High(FImageCollection.Obj.ImageDescs))) then FImageSize := FImageCollection.Obj.ImageDescs[FImageIndex].Size; end; function TGMxCollectionImgArea.InternalPaintArea(const ADC: HDC; const ARect: TRect): Boolean; begin if FImageCollection <> nil then FImageCollection.Obj.DrawImage(FImageIndex, ADC, ARect, FDisabled); Result := True; end; procedure TGMxCollectionImgArea.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; procedure TGMxCollectionImgArea.SetDisabled(const ADisabled, ARepaint: Boolean); begin if FDisabled = ADisabled then Exit; FDisabled := ADisabled; if ARepaint then ScheduleRepaint; end; { ------------------------------ } { ---- TGMxBmpImageAreaBase ---- } { ------------------------------ } constructor TGMxBmpImageAreaBase.Create(const ARefLifeTime: Boolean = False); begin inherited Create(ARefLifeTime); FTransparentColor := clrAutoTransparent; end; procedure TGMxBmpImageAreaBase.AssignImageSize; begin if FPaintBmp <> nil then Exit; if FPaintBmpDC = nil then FPaintBmpDC := TGMGdiCompatibleDC.Create; FPaintBmp := InternalCreatePaintBmp(FPaintBmpDC.Handle); if FPaintBmp = nil then Exit; FImageSize := GMBitmapSize(FPaintBmp.Handle); //if iaTransparent in FAttributes then FTransparentColor := GetPixel(FPaintBmpDC.Handle, 0, FImageSize.y-1); end; function TGMxBmpImageAreaBase.TransparentColor: COLORREF; begin if FTransparentColor = clrAutoTransparent then // Result := GetPixel(FPaintBmpDC.Handle, 0, FImageSize.y-1) // Result := GMFindMajorityColor(FPaintBmpDC.Handle, GMRect(cNullPoint, FImageSize)) FTransparentColor := GMFindMajorityColor(FPaintBmpDC.Handle, GMRect(cNullPoint, FImageSize)); //else Result := FTransparentColor; end; function TGMxBmpImageAreaBase.InternalPaintArea(const ADC: HDC; const ARect: TRect): Boolean; begin Result := True; //Result := inherited PaintArea(ADC, ARect); if FPaintBmpDC = nil then Exit; if iaTransparent in FAttributes then TransparentBlt(ADC, ARect.Left, ARect.Top, GMRectSize(ARect).x, GMRectSize(ARect).y, FPaintBmpDC.Handle, 0, 0, FImageSize.x, FImageSize.y, TransparentColor) // <- dont check! else StretchBlt(ADC, ARect.Left, ARect.Top, GMRectSize(ARect).x, GMRectSize(ARect).y, FPaintBmpDC.Handle, 0, 0, FImageSize.x, FImageSize.y, SRCCOPY); // <- dont check! end; { ------------------------ } { ---- TGMxResBmpArea ---- } { ------------------------ } constructor TGMxResBmpArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AResModule: THandle; const AResName: PGMChar; const AAttributes: TImgAttributes; const ABkgndColor: COLORREF; const ATransparentColor: COLORREF; const AHorizontalAlignment: TGMHorizontalAlignment; const AVerticalAlignment: TGMVerticalAlignment; const AVisible: Boolean; const ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, AAttributes, ABkgndColor, AHorizontalAlignment, AVerticalAlignment, AVisible, ARefLifeTime); FTransparentColor := ATransparentColor; if HiWord(DWORD(PtrUInt(AResName))) = 0 then FResName := AResName else begin FResNameStr := AResName; FResName := PGMChar(FResNameStr); end; FInstance := AResModule; end; function TGMxResBmpArea.InternalCreatePaintBmp(const ADC: HDC): IGMGetHandle; begin Result := TGMGdiBitmap.CreateFromRes(ADC, FResName, FInstance, False, True); end; { ------------------------------- } { ---- TGMxScreenShotBmpArea ---- } { ------------------------------- } constructor TGMxScreenShotBmpArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AScreenShotWnd: HWnd; 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); FScreenShotWnd := AScreenShotWnd; end; function TGMxScreenShotBmpArea.InternalCreatePaintBmp(const ADC: HDC): IGMGetHandle; var rWnd: TRect; begin if not IsWindow(FScreenShotWnd) then Exit{$IFDEF FPC}(nil){$ENDIF}; GMApiCheckObj('GetWindowRect', '', GetLastError, GetWindowRect(FScreenShotWnd, rWnd), Self); Result := TGMGdiBitmap.CreateCompatibleBmp(ADC, 0, GMRectSize(rWnd)); SendMessage(FScreenShotWnd, WM_PRINT, WPARAM(ADC), PRF_CHILDREN or PRF_CLIENT or PRF_NONCLIENT or PRF_ERASEBKGND); end; { ------------------------ } { ---- TGMxPngImgArea ---- } { ------------------------ } {$IFDEF PNGSUPPORT} constructor TGMxPngImgArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AResourceName: PGMChar; const AResourceType: PGMChar; const AAttributes: TImgAttributes; const ABkgndColor: COLORREF; const AHorizontalAlignment: TGMHorizontalAlignment; const AVerticalAlignment: TGMVerticalAlignment; const AVisible: Boolean; AResModule: THandle; const ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, AAttributes, ABkgndColor, AHorizontalAlignment, AVerticalAlignment, AVisible, ARefLifeTime); LoadFromRes(AResourceName, AResourceType, AResModule); end; procedure TGMxPngImgArea.LoadFromRes(const AResourceName: PGMChar = nil; const AResourceType: PGMChar = nil; const AResModule: THandle = INVALID_HANDLE_VALUE); begin if AResourceName <> nil then PngImage := GMLoadPngImgFromRes(AResourceName, AResourceType, AResModule); end; procedure TGMxPngImgArea.AssignImageSize; begin if PngImage <> nil then FImageSize := GMPoint(PngImage.Obj.Width, PngImage.Obj.Height); end; function TGMxPngImgArea.InternalPaintArea(const ADC: HDC; const ARect: TRect): Boolean; begin Result := True; if PngImage <> nil then PngImage.Obj.Draw(ADC, ARect); end; {$ENDIF} { -------------------------- } { ---- TGMxIconAreaBase ---- } { -------------------------- } constructor TGMxIconAreaBase.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AIcon: HICON; const ADestroyIcon: Boolean; const AAttributes: TImgAttributes; const AIconSize: TIconSize; 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); FIcon := AIcon; FIconSize := AIconSize; FDestroyIcon := ADestroyIcon; end; destructor TGMxIconAreaBase.Destroy; begin if (FIcon <> 0) and FDestroyIcon then begin DestroyIcon(FIcon); FIcon := 0; end; inherited; end; procedure TGMxIconAreaBase.SetIcon(const Value: HICON); begin if Value = FIcon then Exit; if (FIcon <> 0) and FDestroyIcon then DestroyIcon(FIcon); FIcon := Value; end; { --------------------------- } { ---- TGMxIconOnBmpArea ---- } { --------------------------- } constructor TGMxIconOnBmpArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AIcon: HICON; const ADestroyIcon: Boolean; const AAttributes: TImgAttributes; const AIconSize: TIconSize; 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); FIcon := AIcon; FIconSize := AIconSize; FDestroyIcon := ADestroyIcon; end; destructor TGMxIconOnBmpArea.Destroy; begin if (FIcon <> 0) and FDestroyIcon then begin DestroyIcon(FIcon); FIcon := 0; end; inherited; end; function TGMxIconOnBmpArea.InternalCreatePaintBmp(const ADC: HDC): IGMGetHandle; var BmpSize: TPoint; begin if ADC = 0 then Exit; if FIcon = 0 then Exit; try case FIconSize of izSmall: BmpSize := GMPoint(GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON)); else BmpSize := GMPoint(GetSystemMetrics(SM_CXICON), GetSystemMetrics(SM_CYICON)); end; Result := TGMGdiBitmap.CreateCompatibleBmp(ADC, 0, BmpSize); FillRect(ADC, GMRect(0, 0, BmpSize.x, BmpSize.y), HBkgndBrush); DrawIconEx(ADC, 0, 0, FIcon, BmpSize.x, BmpSize.y, 0, 0, cIconDrawFlags[iaTransparent in FAttributes]); finally DestroyIcon(FIcon); end; end; procedure TGMxIconOnBmpArea.SetIcon(const Value: HICON); begin if Value = FIcon then Exit; if (FIcon <> 0) and FDestroyIcon then DestroyIcon(FIcon); FIcon := Value; end; { ---------------------- } { ---- TGMxIconArea ---- } { ---------------------- } procedure TGMxIconArea.AssignImageSize; begin case FIconSize of izSmall: FImageSize := GMPoint(GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON)); izLarge: FImageSize := GMPoint(GetSystemMetrics(SM_CXICON), GetSystemMetrics(SM_CYICON)); end; end; function TGMxIconArea.InternalPaintArea(const ADC: HDC; const ARect: TRect): Boolean; //var oldStrechMode: LongInt; begin Result := True; if FIcon = 0 then Exit; //if (ProdSize.x < 6700) and (ProdSize.y < 6700) then // SetBmpStretchMode(ADC, HALFTONE, Self) //else // SetBmpStretchMode(BmpDst.Obj.ADC, COLORONCOLOR, Self); //oldStrechMode := SetStretchBltMode(ADC, HALFTONE); DrawIconEx(ADC, ARect.Left, ARect.Top, FIcon, FImageSize.x, FImageSize.y, 0, 0, cIconDrawFlags[iaTransparent in FAttributes]); //DrawState(ADC, 0, nil, LongInt(FIcon), 0, ARect.Left, ARect.Top, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top, DST_ICON); // DSS_DISABLED //SetStretchBltMode(ADC, oldStrechMode); //DrawIcon(ADC, ARect.Left, ARect.Top, FIcon); end; { ------------------------- } { ---- TGMxResIconArea ---- } { ------------------------- } constructor TGMxResIconArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AResModule: THandle; const AResName: PGMChar; const AAttributes: TImgAttributes; const AIconSize: TIconSize; const ABkgndColor: COLORREF; const AHorizontalAlignment: TGMHorizontalAlignment; const AVerticalAlignment: TGMVerticalAlignment; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, LoadIcon(AResModule, AResName), False, AAttributes, AIconSize, ABkgndColor, AHorizontalAlignment, AVerticalAlignment, AVisible, ARefLifeTime); end; { ------------------------------ } { ---- TGMxSeverityIconArea ---- } { ------------------------------ } constructor TGMxSeverityIconArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ASeverity: TGMSeverityLevel; const AAttributes: TImgAttributes; const AIconSize: TIconSize; const ABkgndColor: COLORREF; const AHorizontalAlignment: TGMHorizontalAlignment; const AVerticalAlignment: TGMVerticalAlignment; const AVisible: Boolean; const ARefLifeTime: Boolean); //var IconSize: TPoint; begin inherited Create(AParent, APosition, AAreaAlign, LoadIcon(0, vGMSevrityIcons[ASeverity]), False, AAttributes, AIconSize, ABkgndColor, AHorizontalAlignment, AVerticalAlignment, AVisible, ARefLifeTime); //case FIconSize of // izSmall: IconSize := GMPoint(GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON)); // else IconSize := GMPoint(GetSystemMetrics(SM_CXICON), GetSystemMetrics(SM_CYICON)); //end; // //inherited Create(AParent, APosition, AAreaAlign, // LoadImage(0, vGMSevrityIcons[ASeverity], IMAGE_ICON, IconSize.x, IconSize.y, LR_SHARED), // False, AAttributes, AIconSize, ABkgndColor, AHorizontalAlignment, AVerticalAlignment, AVisible, ARefLifeTime); end; { --------------------------- } { ---- TGMxCachedImgArea ---- } { --------------------------- } function TGMxCachedImgArea.InternalCreatePaintBmp(const ADC: HDC): IGMGetHandle; begin Result := nil; end; procedure TGMxCachedImgArea.LayoutContainedAreas(const ARepaint: Boolean); //: TPoint; begin if FPaintBmp = nil then inherited LayoutContainedAreas(ARepaint); end; procedure TGMxCachedImgArea.PaintContainedAreas(const ADC: HDC; const ARect: TRect); begin if FImageSize <> GMRectSize(ARect) then FPaintBmp := nil; if FPaintBmp <> nil then Exit; if FPaintBmpDC = nil then FPaintBmpDC := TGMGdiCompatibleDC.Create; //inherited PaintContainedAreas(ADC, ARect); FImageSize := GMRectSize(ARect); FPaintBmp := TGMGdiBitmap.CreateCompatibleBmp(FPaintBmpDC.Handle, 0, FImageSize); inherited; // PaintContainedAreas(FPaintBmpDC.Handle, GMRect(cNullPoint, FImageSize)); BitBlt(ADC, ARect.Left, ARect.Top, FImageSize.x, FImageSize.y, FPaintBmpDC.Handle, 0, 0, SRCCOPY); //BitBlt(FPaintBmpDC.Handle, 0, 0, FImageSize.x, FImageSize.y, ADC, ARect.Left, ARect.Top, SRCCOPY); end; { ----------------------- } { ---- TGMxTableArea ---- } { ----------------------- } constructor TGMxTableArea.Create(const AParent: TObject; const AColumnCount: LongInt; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ABkgndColor: COLORREF; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, ABkgndColor, AVisible, ARefLifeTime); //SetLength(FCells, ATableSize.x * ATableSize.y); //FTableSize := ATableSize; FColumnCount := AColumnCount; end; function TGMxTableArea.CalcCellIdx(const ARow, ACol: LongInt): LongInt; begin Result := FColumnCount * ARow + ACol; end; function TGMxTableArea.CellArea(const ARow, ACol: LongInt; const ACheckCellIdx: Boolean): TObject; var CellIdx: LongInt; begin CellIdx := CalcCellIdx(ARow, ACol); if not ACheckCellIdx and (CellIdx >= ContainedAreas.Count) then begin Result := nil; Exit; end; Result := ContainedAreas[CellIdx]; end; {procedure TGMxTableArea.SetCellArea(const ARow, ACol: LongInt; const AValue: TObject); var Obj: TObject; begin Obj := GetCellArea(ARow, ACol); if Obj = AValue then Exit; if Obj <> nil then OwnedAreas.Remove(Obj); // <- will free obj if AValue <> nil then OwnArea(AValue); // <- hold the control here FCells[FTableSize.x * ARow + ACol] := AValue; end;} {function TGMxTableArea.AssignCellArea(const Row, Col: LongInt; const Area: TObject): TObject; begin CellArea[Row, Col] := Area; Result := Area; end;} function TGMxTableArea.InternalCalcHeight(const NewSize: TPoint): LongInt; var FrameSize: TPoint; begin FrameSize := GMFrameExtent(Frame); Result := LayoutTable(GMAddPoints(NewSize, FrameSize, -1), False, True).y + FrameSize.y + GMRectSize(PaddRect).y; end; function TGMxTableArea.InternalCalcWidth(const NewSize: TPoint): LongInt; var FrameSize: TPoint; begin FrameSize := GMFrameExtent(Frame); Result := LayoutTable(GMAddPoints(NewSize, FrameSize, -1), False, True).x + FrameSize.x + GMRectSize(PaddRect).x; end; function TGMxTableArea.RootForRelayout: TObject; begin Result := GMParentRootForRelayout(Self); end; procedure TGMxTableArea.LayoutContainedAreas(const Repaint: Boolean); //: TPoint; begin //if not GMUseCalcHeight(FAreaAlign.EdgeAlign) and not GMUseCalcWidth(FAreaAlign.EdgeAlign) then LayoutTable(GMRectSize(LayoutBounds), Repaint, False); //else //if Repaint then ScheduleRepaint; end; function TGMxTableArea.RowCount: LongInt; begin Result := (ContainedAreas.Count + FColumnCount - 1) div FColumnCount; end; function TGMxTableArea.LayoutTable(const ASize: TPoint; const ARepaint: Boolean; const ACalcOnly: Boolean): TPoint; var i: LongInt; Area: IGMUiArea; RClient: TRect; function EdgeSpace(const AArea: IGMUiArea; const AEdge: TEdge): LongInt; begin Result := 0; if AArea = nil then Exit; if AArea.EdgeAlign[AEdge] = ealAligned then case AEdge of edgLeft: Result := AArea.LayoutSpace.Left; edgTop: Result := AArea.LayoutSpace.Top; edgRight: Result := AArea.LayoutSpace.Right; edgBottom: Result := AArea.LayoutSpace.Bottom; end; end; function CalcColWidth(const Col, XPos: LongInt): LongInt; var Row, SpcL, W: LongInt; RBounds: TRect; StretchAreas: array of IGMUiArea; begin Result := 0; for Row:=0 to RowCount-1 do begin if not GMGetInterface(CellArea(Row, Col), IGMUiArea, area) or not area.Visible then Continue; RBounds := area.LayoutBounds; W := GMRectSize(RBounds).x; SpcL := EdgeSpace(area, edgLeft); RBounds.Left := XPos + SpcL; RBounds.Right := RBounds.Left + W; RBounds.Right := RBounds.Left + area.CalculateWidth(GMRectSize(RBounds)); area.SetLayoutBounds(RBounds, ARepaint); if not ACalcOnly then begin if StretchAllX or ((area.EdgeAlign[edgLeft] = ealAligned) and (area.EdgeAlign[edgRight] = ealAligned)) then begin SetLength(StretchAreas, Length(StretchAreas)+1); StretchAreas[High(StretchAreas)] := area; end; end; Result := Max(Result, RBounds.Right - RBounds.Left + SpcL + EdgeSpace(area, edgRight)); end; if not ACalcOnly then for Row:=Low(StretchAreas) to High(StretchAreas) do begin area := StretchAreas[Row]; RBounds := area.LayoutBounds; RBounds.Right := XPos + Result - EdgeSpace(area, edgRight); area.SetLayoutBounds(RBounds, ARepaint); end; end; procedure SetupRestCol(const Col, X, W: LongInt); var row: LongInt; rBounds: TRect; area: IGMUiArea; begin for row:=0 to RowCount - 1 do // FTableSize.y - 1 do begin if not GMGetInterface(CellArea(row, Col), IGMUiArea, area) or not area.Visible then Continue; rBounds := area.LayoutBounds; rBounds.Left := X + EdgeSpace(area, edgLeft); rBounds.Right := X + W - EdgeSpace(area, edgRight); area.SetLayoutBounds(rBounds, ARepaint); end; end; function CalcRowHeight(const Row, YPos: LongInt): LongInt; var Col, SpcTop, H: LongInt; RBounds: TRect; area: IGMUiArea; StretchAreas: array of IGMUiArea; begin Result := 0; for Col:=0 to FColumnCount-1 do begin if not GMGetInterface(CellArea(Row, Col), IGMUiArea, area) or not area.Visible then Continue; RBounds := area.LayoutBounds; H := GMRectSize(RBounds).y; SpcTop := EdgeSpace(area, edgTop); RBounds.Top := YPos + SpcTop; RBounds.Bottom := RBounds.Top + H; if (EdgeAlign[edgBottom] = ealAligned) and (area.EdgeAlign[edgBottom] = ealAligned) then RBounds.Bottom := FLayoutBounds.Bottom - EdgeSpace(area, edgBottom) else if area.AutoCalcSize[d2dVertical] then RBounds.Bottom := RBounds.Top + area.CalculateHeight(GMRectSize(RBounds)); if not ACalcOnly then begin area.SetLayoutBounds(RBounds, ARepaint); if StretchAllY or ((area.EdgeAlign[edgTop] = ealAligned) and (area.EdgeAlign[edgBottom] = ealAligned)) then begin SetLength(StretchAreas, Length(StretchAreas)+1); StretchAreas[High(StretchAreas)] := area; end; end; Result := Max(Result, RBounds.Bottom - RBounds.Top + SpcTop + EdgeSpace(area, edgBottom)); end; if not ACalcOnly then for Col:=Low(StretchAreas) to High(StretchAreas) do begin area := StretchAreas[Col]; RBounds := area.LayoutBounds; RBounds.Bottom := YPos + Result - EdgeSpace(area, edgBottom); area.SetLayoutBounds(RBounds, ARepaint); end; end; begin Result := cNullPoint; //if Length(FCells) = 0 then Exit; if ContainedAreas.IsEmpty or (FColumnCount = 0) then Exit; //RClient := GMCalculateClientRect(Frame, GMRect(0, 0, ASize.x, ASize.y)); RClient := GMRect(0, 0, ASize.x, ASize.y); with PaddRect do RClient := GMRectModifiedBy(RClient, Left, Top, -Right, -Bottom); Result.x := RClient.Left; for i:=0 to FColumnCount - 2 do Inc(Result.x, CalcColWidth(i, Result.x)); //if GMUseCalcWidth(FAreaAlign.EdgeAlign) then Inc(Result.x, CalcColWidth(FColumnCount - 1, Result.x)) else if FAutoCalcSize[d2dHorizontal] then Inc(Result.x, CalcColWidth(FColumnCount - 1, Result.x)) else begin //if not ACalcOnly then SetupRestCol(FColumnCount - 1, Result.x, RClient.Right - Result.x); Result.x := RClient.Right; end; Result.y := RClient.Top; for i:=0 to RowCount-1 do Inc(Result.y, CalcRowHeight(i, Result.y)); end; { -------------------- } { ---- TGMxEditor ---- } { -------------------- } constructor TGMxEditor.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); //FLineSpace := 1; FCaretWidth := 2; FLineSeparator := cNewLine; FMaxTextLength := cUnlimitedTextLength; //FSelStart := cInvalidSelPos; //FSelEnd := cInvalidSelPos; //ClearSelection; end; constructor TGMxEditor.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString; const AAttributes: TGMxEditorAttributes; const ABkgndColor: COLORREF; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, ABkgndColor, AVisible, ARefLifeTime); FAttributes := AAttributes; SetText(AText); end; function TGMxEditor.IsTabStop: Boolean; begin Result := True; end; procedure TGMxEditor.WMSetCursor(var Msg: TWMSetCursor); begin inherited; SetCursor(LoadCursor(0, Pointer(IDC_IBEAM))); Msg.Result := 1; end; function TGMxEditor.InternalCalcHeight(const NewSize: TPoint): LongInt; begin Result := FontHeight; end; function TGMxEditor.CallOnBeforeTextChange: Boolean; begin if Assigned(OnBeforeTextChange) then Result := OnBeforeTextChange(Self) else Result := True; end; procedure TGMxEditor.CallOnAfterTextChange; begin if Assigned(OnAfterTextChange) then OnAfterTextChange(Self); end; procedure TGMxEditor.SetLayoutBounds(const AValue: TRect; const ARepaint: Boolean); var OldWidth: LongInt; begin OldWidth := FLayoutBounds.Right - FLayoutBounds.Left; inherited; if Visible and (OldWidth <> FLayoutBounds.Right - FLayoutBounds.Left) then WrapAllLines; end; procedure TGMxEditor.InternalSetVisible(const Value: Boolean); begin inherited; if Value and GMAreaIsShowing(Self) then WrapAllLines; end; procedure TGMxEditor.WMSetFocus(var Msg: TWMSetFocus); var PrntWnd: HWnd; begin inherited; if GMFindAllocatedParentHandle(Self, PrntWnd) then begin CreateCaret(PrntWnd, 0, 2, FontHeight); FCaretCreated := True; UpdateCaretPos(False); ShowCaret(PrntWnd); end; ScheduleRepaint; end; procedure TGMxEditor.WMKillFocus(var Msg: TWMKillFocus); begin inherited; DestroyCaret; FCaretCreated := False; ScheduleRepaint; end; //procedure TGMxEditor.ClearSelection; //begin //FSelStart := GMPoint(0, Low(FLines)); FSelEnd := FSelStart; //end; //function TGMxEditor.SelectionIsEmpty: Boolean; //begin //Result := IsEmptyRange(FSelStart, FSelEnd); //end; function TGMxEditor.FontHeight: LongInt; begin if FFontHeight = 0 then FFontHeight := GMTextExtent('Fg', FontHandle).y; Result := FFontHeight; end; function TGMxEditor.LimitCursorPos(const ACursorPos: TPoint; const AMinBased: Boolean = True): TPoint; begin Result := ACursorPos; Result.y := GMBoundedInt(Result.y, Low(FLines), High(FLines), AMinBased); if Length(FLines) = 0 then Result.x := 0 else Result.x := GMBoundedInt(Result.x, 0, Length(FLines[Result.y].Line)); end; procedure TGMxEditor.RangeOrderSwap(var ARangeStart, ARangeEnd: TPoint); var pt: TPoint; begin if (ARangeEnd.y < ARangeStart.y) or ((ARangeEnd.x < ARangeStart.x) and (ARangeEnd.y = ARangeStart.y)) then begin pt := ARangeEnd; ARangeEnd := ARangeStart; ARangeStart := pt; end; ARangeStart := LimitCursorPos(ARangeStart); ARangeEnd := LimitCursorPos(ARangeEnd, False); end; function TGMxEditor.IsEmptyRange(ARangeStart, ARangeEnd: TPoint): Boolean; begin RangeOrderSwap(ARangeStart, ARangeEnd); // <- Asserts: ARangeStart.y <= ARangeEnd.y! Result := not ((ARangeStart.y < ARangeEnd.y) or ((ARangeStart.y = ARangeEnd.y) and (ARangeStart.x < ARangeEnd.x))); end; function TGMxEditor.NextCursorPos(const ACursorPos: TPoint): TPoint; // // The cursor moves between characters. So there is one more cursor position than characters in a line. // Therefore the last cursor position in a line is not a valis character position! // begin Result := LimitCursorPos(ACursorPos); if Length(FLines) > 0 then if Result.x < Length(FLines[Result.y].Line) then Inc(Result.x) else if Result.y < High(FLines) then Result := GMPoint(0, Result.y+1); end; function TGMxEditor.PrevCursorPos(const ACursorPos: TPoint): TPoint; // // The cursor moves between characters. So there is one more cursor position than characters in a line. // Therefore the last cursor position in a line is not a valis character position! // begin Result := LimitCursorPos(ACursorPos); if Result.x > 0 then Dec(Result.x) else if Result.y > Low(FLines) then Result := GMPoint(Length(FLines[Result.y-1].Line), Result.y-1); end; function TGMxEditor.IsFirstCursorPos(const ACharPos: TPoint): Boolean; begin Result := (Length(FLines) = 0) or ((ACharPos.x <= 0) and (ACharPos.y <= 0)); end; function TGMxEditor.IsLastCursorPos(const ACharPos: TPoint): Boolean; begin Result := (ACharPos.y > High(FLines)) or ((ACharPos.y = High(FLines)) and (ACharPos.x >= Length(FLines[High(FLines)].Line))); end; function TGMxEditor.CharAt(ACursorPos: TPoint): TGMChar; begin if Length(FLines) = 0 then Result := #0 else begin ACursorPos := LimitCursorPos(ACursorPos); if (ACursorPos.x < Length(FLines[ACursorPos.y].Line)) or (ACursorPos.y >= High(FLines)) then Result := FLines[ACursorPos.y].Line[ACursorPos.x+1] else if laIsWrapped in FLines[ACursorPos.y+1].Attributes then Result := CharAt(NextCursorPos(ACursorPos)) else Result := cCharAtLineBreak; end; end; function TGMxEditor.CharPosFromClientPos(const AClientPos: TPoint): TPoint; var DC, Font: IGMGetHandle; SplitLen: LongInt; sz: TSize; begin Result.y := GMBoundedInt(AClientPos.y div (FontHeight + FLineSpace), Low(FLines), High(FLines)); Result.x := 0; if GMIsInRange(Result.y, Low(FLines), High(FLines)) then begin DC := TGMGdiCompatibleDC.Create; Font := TGMGdiObjSelector.Create(DC.Handle, FontHandle); if GetTextExtentExPoint(DC.Handle, PGMChar(FLines[Result.y].Line), Length(FLines[Result.y].Line), Max(1, AClientPos.x+1), @SplitLen, nil, Sz) then Result.x := Min(SplitLen, Length(FLines[Result.y].Line)); end; end; procedure TGMxEditor.WMLButtonDown(var Msg: TWMMouse); begin inherited; FMouseDown := True; FSelStart := CharPosFromClientPos(GMAddPoints(GMPoint(Msg.XPos, Msg.YPos), ClientAreaOrigin, -1)); if FSelStart <> FSelEnd then ScheduleRepaint; FEditPos := FSelStart; FSelEnd := FSelStart; UpdateCaretPos(True); GMCaptureMouseInput(Self); end; procedure TGMxEditor.WMMouseMove(var Msg: TWMMouse); var ClientPos: TPoint; // ScrollPos: TPoint; ClientSz: TPoint; begin inherited; if not FMouseDown then Exit; ClientPos := GMAddPoints(GMPoint(Msg.XPos, Msg.YPos), ClientAreaOrigin, -1); FSelEnd := CharPosFromClientPos(ClientPos); FEditPos := FSelEnd; UpdateCaretPos(True); ScrollCharPosVisible(ClientPos); ScheduleRepaint; end; procedure TGMxEditor.WMLButtonUp(var Msg: TWMMouse); begin inherited; FMouseDown := False; GMReleaseMouseCapture; end; procedure TGMxEditor.WMLButtonDblClick(var Msg: TWMMouse); var StartPos: TPoint; begin FSelStart := CharPosFromClientPos(GMAddPoints(GMPoint(Msg.XPos, Msg.YPos), ClientAreaOrigin, -1)); FSelEnd := FSelStart; StartPos := FSelStart; while not IsFirstCursorPos(StartPos) and not IsWordBreakchar(CharAt(StartPos)) do begin StartPos := PrevCursorPos(StartPos); if not IsWordBreakchar(CharAt(StartPos)) then FSelStart := StartPos; end; while not IsLastCursorPos(FSelEnd) and not IsWordBreakchar(CharAt(FSelEnd)) do FSelEnd := NextCursorPos(FSelEnd); FEditPos := FSelEnd; UpdateCaretPos(True); ScheduleRepaint; end; procedure TGMxEditor.WMMouseWheel(var Msg: TWMMouseWheel); begin SetScrollPosition(GMPoint(-ScrollOffset.x, -ScrollOffset.y - GMWheelScrollDelta(ClientAreaSize.y, Msg.WheelDelta))); Msg.Result := 1; end; procedure TGMxEditor.SetAttributes(const AAttributes: TGMxEditorAttributes); var OldText: TGMString; // OldAttributes: TGMxEditorAttributes; begin //OldAttributes := FAttributes; OldText := Text; FAttributes := AAttributes; SetText(OldText); // <- Re-wrap, Adjust scrolling, etc. end; function TGMxEditor.GetText: TGMString; var i: LongInt; line: TGMString; begin line := ''; Result := ''; for i:=Low(FLines) to High(FLines) do if laIsWrapped in FLines[i].Attributes then line := line + FLines[i].Line else begin Result := GMStringJoin(Result, FLineSeparator, line); line := FLines[i].Line; end; GMStringJoin(Result, FLineSeparator, line); end; function AppendEditorLine(const ALine: TGMString; const ALastLine: Boolean; const AData: Pointer): Boolean; var Editor: TGMxEditor; procedure AddLine; begin SetLength(Editor.FLines, Length(Editor.FLines)+1); end; begin if AData = nil then begin Result := False; Exit; end; Editor := TGMxEditor(AData); if Length(Editor.FLines) <= 0 then AddLine; Editor.FLines[High(Editor.FLines)] := GMEditorLine(ALine); if not ALastLine then AddLine; Result := True; end; procedure TGMxEditor.SetText(const AText: TGMString); begin if not (edMultiLine in Attributes) then begin SetLength(FLines, 1); FLines[Low(FLines)] := GMEditorLine(AText); end else begin SetLength(FLines, 0); GMParseLines(AText, AppendEditorLine, Self, True); WrapAllLines; end; end; procedure TGMxEditor.InternalDeleteLines(const AStartLnIdx, ALnClount: LongInt; const PCaretUpdateNeeded: PBoolean); var i: LongInt; begin //AStartLnIdx := GMBoundedInt(AStartLnIdx, Low(FLines), High(FLines)); if (ALnClount <= 0) or not GMIsInRange(AStartLnIdx, Low(FLines), High(FLines)) then Exit; for i:=AStartLnIdx to High(FLines)-ALnClount do FLines[i] := FLines[i + ALnClount]; SetLength(FLines, Length(FLines) - ALnClount); if FSelStart.y >= AStartLnIdx then Dec(FSelStart.y, ALnClount); // <- Line has been moved if FSelEnd.y >= AStartLnIdx then Dec(FSelEnd.y, ALnClount); // <- Line has been moved if FEditPos.y >= AStartLnIdx then // <- Line has been moved begin Dec(FEditPos.y, ALnClount); if PCaretUpdateNeeded <> nil then PCaretUpdateNeeded^ := True else UpdateCaretPos(False); end; end; procedure TGMxEditor.WrapLine(const ALineIdx: Integer; const PCaretUpdateNeeded: PBoolean); // ; const AAdjustScrollRange: Boolean type TEditPosDataRec = record Pt: PPoint; LinePos: LongInt; UpdateCaret: Boolean; end; var i, LnStartIdx, LnEndIdx, W, SplitLen, BreakLen, RestLen, ChunkChIdx: LongInt; Line: TGMString; DC, Font: IGMGetHandle; Sz: TSize; ChunkPtr: PGMChar; MovePts: array of TEditPosDataRec; CaretUpdateNeeded: Boolean; procedure MoveEditPos(var APosData: TEditPosDataRec; const ALineIdx, ALnStartPos, ALineLen: LongInt); begin if (APosData.LinePos >= ALnStartPos) and (APosData.LinePos <= ALnStartPos + ALineLen) then with APosData do begin Pt^ := GMPoint(LinePos - ALnStartPos, ALineIdx); if UpdateCaret then CaretUpdateNeeded := True; end; end; procedure MoveEditPositions(const ALineIdx, ALnStartPos, ALineLen: LongInt); var i: LongInt; begin for i:=Low(MovePts) to High(MovePts) do MoveEditPos(MovePts[i], ALineIdx, ALnStartPos, ALineLen); end; procedure RememberPosToMove(var APos: TPoint; const ALineIdx, ALineStartPos: LongInt; IsCaretPos: Boolean); begin if APos.y = ALineIdx then begin SetLength(MovePts, Length(MovePts)+1); with MovePts[High(MovePts)] do begin Pt := @APos; LinePos := ALineStartPos + APos.x; UpdateCaret := IsCaretPos; end; end; end; procedure RememberPositionsToMove(const ALineIdx: LongInt; const ALineStartPos: LongInt); begin RememberPosToMove(FEditPos, ALineIdx, ALineStartPos, True); RememberPosToMove(FSelStart, ALineIdx, ALineStartPos, False); RememberPosToMove(FSelEnd, ALineIdx, ALineStartPos, False); end; begin if not (edWrapLines in Attributes) then Exit; W := ClientAreaSize.x; if (W <= 0) or not GMIsInRange(ALineIdx, Low(FLines), High(FLines)) then Exit; CaretUpdateNeeded := False; Line := ''; // // Concatenate all wrapings of the line and store edit positions that lie inside it // LnStartIdx := ALineIdx; while (LnStartIdx > Low(Flines)) and (laIsWrapped in FLines[LnStartIdx].Attributes) do Dec(LnStartIdx); if laIsWrapped in FLines[LnStartIdx].Attributes then Exit; LnEndIdx := LnStartIdx; // Line := ''; repeat RememberPositionsToMove(LnEndIdx, Length(Line)); Line := Line + FLines[LnEndIdx].Line; Inc(LnEndIdx); until (LnEndIdx > High(FLines)) or not (laIsWrapped in FLines[LnEndIdx].Attributes); // // Re-wrap the line inserting additional wrapings if needed // DC := TGMGdiCompatibleDC.Create; Font := TGMGdiObjSelector.Create(DC.Handle, FontHandle); ChunkPtr := PGMChar(Line); RestLen := Length(Line); ChunkChIdx := 1; repeat if not GetTextExtentExPoint(DC.Handle, ChunkPtr, RestLen, W, @SplitLen, nil, Sz) then Exit; BreakLen := SplitLen; if BreakLen < RestLen then begin while (BreakLen > 0) and not IsWordBreakchar(Line[ChunkChIdx + BreakLen - 1]) do Dec(BreakLen); if BreakLen = 0 then BreakLen := SplitLen; end; if LnStartIdx >= LnEndIdx then begin // Insert an addtitional wrapping line SetLength(FLines, Length(FLines)+1); {TODO: Why does move cause corrupt results here?} //System.Move(FLines[LnStartIdx], FLines[LnStartIdx+1], (High(FLines) - LnStartIdx) * SizeOf(FLines[LnStartIdx])); for i:=High(FLines) downto LnStartIdx+1 do FLines[i] := FLines[i-1]; Include(FLines[LnStartIdx].Attributes, laIsWrapped); if FEditPos.y >= LnStartIdx then begin Inc(FEditPos.y); CaretUpdateNeeded := True; end; // <- Line has been moved if FSelStart.y >= LnStartIdx then Inc(FSelStart.y); // <- Line has been moved if FSelEnd.y >= LnStartIdx then Inc(FSelEnd.y); // <- Line has been moved Inc(LnEndIdx); end; FLines[LnStartIdx].Line := Copy(Line, ChunkChIdx, BreakLen); MoveEditPositions(LnStartIdx, ChunkChIdx-1, BreakLen); ChunkPtr := ChunkPtr + BreakLen; Dec(RestLen, BreakLen); Inc(ChunkChIdx, BreakLen); Inc(LnStartIdx); until RestLen <= 0; // // Remove surplus wrapings if any // InternalDeleteLines(LnStartIdx, LnEndIdx - LnStartIdx, @CaretUpdateNeeded); if CaretUpdateNeeded then if PCaretUpdateNeeded = nil then UpdateCaretPos(False) else PCaretUpdateNeeded^ := True; //if AAdjustScrollRange then AdjustScrollRange(cAll2DDirections); end; procedure TGMxEditor.WrapAllLines; var i: LongInt; begin if not (edWrapLines in Attributes) then Exit; i:=Low(FLines); while i<=High(FLines) do // <- WrapLine calls may change the size of FLines! begin if not (laIsWrapped in FLines[i].Attributes) then WrapLine(i); Inc(i); end; AdjustScrollRange(cAll2DDirections); end; function TGMxEditor.LimitHScrollPos(const AScrollPos: Integer): LongInt; begin Result := GMBoundedInt(AScrollPos, 0, FMaxLineLength - ClientAreaSize.x); end; function TGMxEditor.LimitVScrollPos(const AScrollPos: Integer): LongInt; begin Result := GMBoundedInt(AScrollPos, 0, ((FontHeight + FLineSpace) * Length(FLines)) - ClientAreaSize.y); end; procedure TGMxEditor.OnHScrollPosChange(const AOldPos, ANewPos: Integer); var Wnd: HWnd; R, RUpdate: Trect; begin if not Visible or (AOldPos = ANewPos) or not GMFindAllocatedParentHandle(Parent, Wnd) then Exit; // not GMAreaIsShowing(Self) .. not Visible or R := GMCalculateClientRect(Frame, PaintingRect); // CalculateSurfaceRect(LayoutBounds)); ScrollWindowEx(Wnd, AOldPos - ANewPos, 0, @R, @R, 0, @RUpdate, SW_INVALIDATE or SW_ERASE or SW_SCROLLCHILDREN); ScrollOffset.x := -ANewPos; SurfaceOriginChanged; InvalidateRect(Wnd, @RUpdate, False); end; procedure TGMxEditor.OnVScrollPosChange(const AOldPos, ANewPos: Integer); var Wnd: HWnd; R, RUpdate: Trect; begin if not Visible or (AOldPos = ANewPos) or not GMFindAllocatedParentHandle(Parent, Wnd) then Exit; R := GMCalculateClientRect(Frame, PaintingRect); // CalculateSurfaceRect(LayoutBounds)); ScrollWindowEx(Wnd, 0, AOldPos - ANewPos, @R, @R, 0, @RUpdate, SW_INVALIDATE or SW_ERASE or SW_SCROLLCHILDREN); // MakeLong(SW_INVALIDATE or SW_ERASE or SW_SCROLLCHILDREN or SW_SMOOTHSCROLL, 50) ScrollOffset.y := -ANewPos; SurfaceOriginChanged; InvalidateRect(Wnd, @RUpdate, False); end; procedure TGMxEditor.SetScrollposition(AScrollPos: TPoint); var PIPos: IGMGetSetPosition; begin AScrollPos.x := LimitHScrollPos(AScrollPos.x); AScrollPos.y := LimitVScrollPos(AScrollPos.y); if -ScrollOffset.x <> AScrollPos.x then if GMQueryInterface(HScrollBar, IGMGetSetPosition, PIPos) then PIPos.Position := AScrollPos.x else OnHScrollPosChange(-ScrollOffset.x, AScrollPos.x); if -ScrollOffset.y <> AScrollPos.y then if GMQueryInterface(VScrollBar, IGMGetSetPosition, PIPos) then PIPos.Position := AScrollPos.y else OnVScrollPosChange(-ScrollOffset.y, AScrollPos.y); end; procedure TGMxEditor.AdjustScrollRange(const ADirections: TGM2DDirections); var ScrollPos: LongInt; begin if d2dHorizontal in ADirections then begin ScrollPos := LimitHScrollPos(-ScrollOffset.x); if ScrollPos <> -ScrollOffset.x then OnHScrollPosChange(-ScrollOffset.x, ScrollPos); end; if d2dVertical in ADirections then begin ScrollPos := LimitVScrollPos(-ScrollOffset.y); if ScrollPos <> -ScrollOffset.y then OnVScrollPosChange(-ScrollOffset.y, ScrollPos); end; end; procedure TGMxEditor.ScrollCharPosVisible(const ACharPos: TPoint); //const cAutoScrollX = 15; var ScrollPos: TPoint; ClientSz: TPoint; begin ScrollPos := GMPoint(-ScrollOffset.x, -ScrollOffset.y); ClientSz := ClientAreaSize; ScrollPos.y := GMBoundedInt(ScrollPos.y, ACharPos.y - ClientSz.y + FontHeight + FLineSpace, ACharPos.y); ScrollPos.x := GMBoundedInt(ScrollPos.x, ACharPos.x - ClientSz.x, ACharPos.x); SetScrollposition(ScrollPos); end; procedure TGMxEditor.UpdateCaretPos(const AScrollCaretVisible: Boolean); var NewPos: TPoint; LnHgt: LongInt; begin if not AScrollCaretVisible and not FCaretCreated then Exit; // <- leave eearly when there is nothing to do LnHgt := FontHeight + FLineSpace; NewPos.y := LnHgt * (FEditPos.y - Low(FLines)); if not GMIsInRange(FEditPos.y, Low(FLines), High(FLines)) then NewPos.x := 0 else NewPos.x := GMTextExtent(Copy(FLines[FEditPos.y].Line, 1, FEditPos.x), FontHandle).x; if AScrollCaretVisible then ScrollCharPosVisible(NewPos); if FCaretCreated then GMSetCaretPos(GMAddPoints(NewPos, ClientAreaOrigin)); end; function TGMxEditor.RangeAsText(ARangeStart, ARangeEnd: TPoint): TGMString; var i, x: LongInt; procedure AppendLine(const ALineAttrs: TGMxLineAttributes; const ALine: TGMString); // TGMxEditorLineRec begin if (laIsWrapped in ALineAttrs) or (Length(Result) <= 0) then Result := Result + ALine else Result := Result + FLineSeparator + ALine; // GMStringJoin(Result, FLineSeparator, ALine); end; begin if Length(FLines) <= 0 then Exit; RangeOrderSwap(ARangeStart, ARangeEnd); // <- Asserts: ARangeStart.y <= ARangeEnd.y! with FLines[ARangeStart.y] do begin if ARangeStart.y = ARangeEnd.y then x := ARangeEnd.x else x := Length(Line); AppendLine(Attributes, Copy(Line, ARangeStart.x+1, x - ARangeStart.x)); end; for i:=ARangeStart.y+1 to ARangeEnd.y-1 do with FLines[i] do AppendLine(Attributes, Line); if ARangeEnd.y > ARangeStart.y then with FLines[ARangeEnd.y] do AppendLine(Attributes, Copy(Line, 1, ARangeEnd.x)); end; procedure TGMxEditor.InternalDeleteRange(var ARangeStart, ARangeEnd: TPoint); var X, i: LongInt; CaretUpdateNeeded: Boolean; begin RangeOrderSwap(ARangeStart, ARangeEnd); // <- Asserts: ARangeStart.y <= ARangeEnd.y! if ARangeEnd.y > ARangeStart.y then X := Length(FLines[ARangeStart.y].Line) else X := ARangeEnd.x; Delete(FLines[ARangeStart.y].Line, ARangeStart.x+1, X - ARangeStart.x); CaretUpdateNeeded := False; if ARangeEnd.y > ARangeStart.y then // WrapLine(ARangeStart.y) else begin Delete(FLines[ARangeEnd.y].Line, 1, ARangeEnd.x); InternalDeleteLines(ARangeStart.y+1, ARangeEnd.y-ARangeStart.y-1, @CaretUpdateNeeded); FLines[ARangeStart.y].Line := FLines[ARangeStart.y].Line + FLines[ARangeStart.y+1].Line; for i:=ARangeStart.y+1 to High(FLines)-1 do FLines[i] := FLines[i+1]; {TODO: Use System.Move instead?} SetLength(FLines, Length(FLines)-1); end; WrapLine(ARangeStart.y, @CaretUpdateNeeded); if CaretUpdateNeeded then UpdateCaretPos(False); end; function TGMxEditor.DeleteRange(var ARangeStart, ARangeEnd: TPoint): Boolean; begin Result := False; if (edReadOnly in Attributes) or IsEmptyRange(ARangeStart, ARangeEnd) or not CallOnBeforeTextChange then Exit; FEditPos := ARangeStart; InternalDeleteRange(ARangeStart, ARangeEnd); // <- may swap ARangeStart, ARangeEnd! ARangeEnd := ARangeStart; AdjustScrollRange(cAll2DDirections); //UpdateCaretPos(True); CallOnAfterTextChange; ScheduleRepaint; Result := True; end; procedure TGMxEditor.Deleteselection; begin InternalDeleteRange(FSelStart, FSelEnd); FSelEnd := FSelStart; FEditPos := FSelStart; UpdateCaretPos(True); end; //function TGMxEditor.InsertTextAt(AInsertPos: TPoint; const AText: TGMString): Boolean; //begin //end; function TGMxEditor.InsertLine(const ALine: TGMString; const EndsWithLineBreak: Boolean): Boolean; var i: LongInt; CaretUpdateNeeded: Boolean; begin //FEditPos := LimitCursorPos(FEditPos); Result := True; CaretUpdateNeeded := False; Insert(ALine, FLines[FEditPos.y].Line, FEditPos.x+1); Inc(FEditPos.x, Length(ALine)); WrapLine(FEditPos.y, @CaretUpdateNeeded); if EndsWithLineBreak then begin SetLength(FLines, Length(FLines)+1); for i:=High(FLines) downto FEditPos.y+2 do FLines[i] := FLines[i-1]; FLines[FEditPos.y+1] := GMEditorLine(Copy(FLines[FEditPos.y].Line, FEditPos.x+1, Length(FLines[FEditPos.y].Line) - FEditPos.x)); FLines[FEditPos.y].Line := Copy(FLines[FEditPos.y].Line, 1, FEditPos.x); FEditPos := GMPoint(0, FEditPos.y+1); WrapLine(FEditPos.y-1, @CaretUpdateNeeded); WrapLine(FEditPos.y, @CaretUpdateNeeded); end; if CaretUpdateNeeded then UpdateCaretPos(False); end; function InsertEditorLine(const ALine: TGMString; const EndsWithLineBreak: Boolean; const AData: Pointer): Boolean; begin if AData = nil then begin Result := False; Exit; end; Result := TGMxEditor(AData).InsertLine(ALine, EndsWithLineBreak); end; function TGMxEditor.InsertText(const AText: TGMString): Boolean; var TxtLen: LongInt; BeforeChangeCalled: Boolean; begin Result := False; if (Length(AText) = 0) or (edReadOnly in Attributes) then Exit; FEditPos := LimitCursorPos(FEditPos); BeforeChangeCalled := False; if not IsEmptyRange(FSelStart, FSelEnd) then begin if not CallOnBeforeTextChange then Exit; BeforeChangeCalled := True; InternalDeleteRange(FSelStart, FSelEnd); FSelEnd := FSelstart; FEditPos := LimitCursorPos(FSelStart); end; if FMaxTextLength <> cUnlimitedTextLength then TxtLen := Length(Text) else TxtLen := 0; // <- avoid getting Text property if ((FMaxTextLength = cUnlimitedTextLength) or (TxtLen < FMaxTextLength)) and (BeforeChangeCalled or CallOnBeforeTextChange) then begin GMParseLines(AText, InsertEditorLine, Self, True); CallOnAfterTextChange; UpdateCaretPos(True); ScheduleRepaint; Result := True; end; end; function TGMxEditor.IsDialogKeyMsg(const Msg: TMessage): Boolean; begin Result := ((Msg.Msg = WM_SYSKEYDOWN) or (Msg.Msg = WM_SYSKEYUP) or (Msg.Msg = WM_SYSCHAR) or (Msg.Msg = WM_SYSDEADCHAR)) or (((Msg.Msg = WM_KEYDOWN) or (Msg.Msg = WM_KEYUP) or (Msg.Msg = WM_CHAR)) and (// not (Msg.WParamLo in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN]) or (Msg.WParamLo = VK_TAB) or ((Msg.WParamLo in [VK_RETURN, VK_UP, VK_DOWN]) and not (edMultiLine in FAttributes)) or ((Msg.WParamLo = VK_ESCAPE) and not IsPopupWindow))); end; procedure TGMxEditor.WMKeyDown(var Msg: TWMKey); var KeyState: SGMKeyStates; ExtendSelection: Boolean; oldEditPos: TPoint; function NextMoveCharPos(const ACharPos: TPoint): TPoint; begin Result := NextCursorPos(ACharPos); if (Length(FLines) > 0) and (Result.x >= Length(FLines[Result.y].Line)) and (Result.y < High(FLines)) and (laIsWrapped in FLines[Result.y+1].Attributes) then Result := NextCursorPos(Result); end; //function PrevMoveCharPos(const ACharPos: TPoint): TPoint; //begin // Result := PrevCursorPos(ACharPos); // if (Length(FLines) > 0) and (Result.x = 0) and (laIsWrapped in FLines[Result.y].Attributes) then Result := PrevCursorPos(Result); //end; function NextDelCharPos(const ACharPos: TPoint): TPoint; begin Result := NextCursorPos(ACharPos); if (Length(FLines) > 0) and (Result.y > ACharPos.y) and (laIsWrapped in FLines[Result.y].Attributes) then Result := NextCursorPos(Result); end; function PrevDelCharPos(const ACharPos: TPoint): TPoint; begin Result := PrevCursorPos(ACharPos); if (Length(FLines) > 0) and (ACharPos.y > Result.y) and (laIsWrapped in FLines[ACharPos.y].Attributes) then Result := PrevCursorPos(Result); end; procedure DelRange(ARangeStart, ARangeEnd: TPoint); begin DeleteRange(ARangeStart, ARangeEnd); end; function Copy: Boolean; var Clipbaord: IGMClipboard; begin if IsEmptyRange(FSelStart, FSelEnd) then begin Result := False; Exit; end; Clipbaord := TGMClipboard.Create(0); Clipbaord.Obj.AsText := RangeAsText(FSelStart, FSelEnd); Result := True; end; procedure Paste; var Clipbaord: IGMClipboard; begin Clipbaord := TGMClipboard.Create(0); InsertText(Clipbaord.Obj.AsText); end; begin inherited; oldEditPos := FEditPos; KeyState := GMKeyDataToKeyState(Msg.KeyData); ExtendSelection := ksShift in KeyState; KeyState := KeyState - [ksShift]; if KeyState = [] then case Msg.CharCode of VK_UP: Dec(FEditPos.y); VK_DOWN: Inc(FEditPos.y); VK_LEFT: FEditPos := PrevCursorPos(FEditPos); VK_RIGHT: FEditPos := NextCursorPos(FEditPos); VK_BACK: if IsEmptyRange(FSelStart, FSelEnd) then DelRange(PrevDelCharPos(FEditPos), FEditPos) else DeleteRange(FSelStart, FSelEnd); VK_DELETE: if IsEmptyRange(FSelStart, FSelEnd) then DelRange(FEditPos, NextDelCharPos(FEditPos)) else DeleteRange(FSelStart, FSelEnd); VK_PRIOR: Dec(FEditPos.y, ClientAreaSize.y div (Fontheight + FLineSpace)); VK_NEXT: Inc(FEditPos.y, ClientAreaSize.y div (Fontheight + FLineSpace)); VK_HOME: FEditPos.x := 0; VK_END: if Length(FLines) > 0 then FEditPos.x := Length(FLines[FEditPos.y].Line); // GMIsInRange(FEditPos.y, Low(FLines), High(FLines)) end; if KeyState = [ksCtrl] then case Msg.CharCode of Ord('a'), Ord('A'): if Length(FLines) > 0 then begin FSelStart := GMPoint(0, Low(FLines)); FSelEnd := GMPoint(Length(FLines[High(FLines)].Line), High(FLines)); ScheduleRepaint; end; Ord('c'), Ord('C'): Copy; Ord('x'), Ord('X'): if Copy then DeleteRange(FSelStart, FSelEnd); Ord('v'), Ord('V'): Paste; VK_HOME: FEditPos := GMPoint(0, Low(FLines)); VK_END: if Length(FLines) <= 0 then FEditPos := GMPoint(0, Low(FLines)) else FEditPos := GMPoint(Length(FLines[High(FLines)].Line), High(FLines)); VK_LEFT: begin FEditPos := PrevCursorPos(FEditPos); while not IsFirstCursorPos(FEditPos) and IsWordBreakchar(CharAt(FEditPos)) do FEditPos := PrevCursorPos(FEditPos); while not IsFirstCursorPos(FEditPos) and not IsWordBreakchar(CharAt(FEditPos)) do FEditPos := PrevCursorPos(FEditPos); if IsWordBreakchar(CharAt(FEditPos)) then FEditPos := NextCursorPos(FEditPos); end; VK_RIGHT: begin while not IsLastCursorPos(FEditPos) and not IsWordBreakchar(CharAt(FEditPos)) do FEditPos := NextMoveCharPos(FEditPos); while not IsLastCursorPos(FEditPos) and IsWordBreakchar(CharAt(FEditPos)) do FEditPos := NextMoveCharPos(FEditPos); end; end; FEditPos := LimitCursorPos(FEditPos); if oldEditPos = FEditPos then Exit; if ExtendSelection then begin FSelEnd := FEditPos; ScheduleRepaint; end else begin if FSelStart <> FSelEnd then ScheduleRepaint; FSelStart := FEditPos; FSelEnd := FSelStart; end; UpdateCaretPos(True); end; //StartPos := FSelStart; //while not IsFirstCursorPos(StartPos) and not IsWordBreakchar(CharAt(StartPos)) do // begin // StartPos := PrevCursorPos(StartPos); // if not IsWordBreakchar(CharAt(StartPos)) then FSelStart := StartPos; // end; procedure TGMxEditor.WMChar(var Msg: TWMKey); var i: LongInt; procedure InsertFirstLine; begin if Length(FLines) <= 0 then begin SetLength(FLines, Length(FLines)+1); FLines[High(FLines)] := GMEditorLine(''); end; end; begin case Msg.CharCode of 0..VK_RETURN-1:; VK_RETURN: begin InsertFirstLine; InsertText(cNewLine); end; VK_RETURN+1..31:; else begin InsertFirstLine; InsertText(Chr(Byte(Msg.CharCode))); end; end; end; procedure TGMxEditor.BuildLineFragments(const ALineIdx: LongInt; var ALineFragments: TGMxLinePaintFragments); var Line: TGMString; StartX, EndX: LongInt; LSelStart, LSelEnd: TPoint; HiLiteBkgnd: COLORREF; procedure AddLineFragment(AText: PGMChar; ATextLen: LongInt; AFontHandle: HFont; AFontColor, ABkgndColor: COLORREF); var FragIdx: LongInt; begin SetLength(ALineFragments, Length(ALineFragments)+1); FragIdx := High(ALineFragments); ALineFragments[FragIdx].Text := AText; ALineFragments[FragIdx].TextLen := ATextLen; ALineFragments[FragIdx].Font := AFontHandle; ALineFragments[FragIdx].FontColor := AFontColor; ALineFragments[FragIdx].BkgndColor := ABkgndColor; end; begin if not GMISInRange(ALineIdx, Low(FLines), High(FLines)) then Exit; Line := FLines[ALineIdx].Line; LSelStart := FSelStart; LSelEnd := FSelEnd; RangeOrderSwap(LSelStart, LSelEnd); // <- Asserts: LSelStart.y <= LSelEnd.y! if not GMIsInRange(ALineIdx, LSelStart.y, LSelEnd.y) then begin StartX := 0; EndX := 0; end else begin if ALineIdx > LSelStart.y then StartX := 0 else StartX := Max(0, LSelStart.x); if ALineIdx < LSelEnd.y then EndX := Length(Line) else EndX := Min(LSelEnd.x, Length(Line)); end; if vGMKeyboardFocusArea = Self then HiLiteBkgnd := clrHighlight else HiLiteBkgnd := clDkGray; if StartX > 0 then AddLineFragment(PGMChar(Line), StartX, FontHandle, FontColor, FontBkgndColor); if EndX > StartX then AddLineFragment(PGMChar(Line)+StartX, EndX - StartX, FontHandle, clrHighlightText, HiLiteBkgnd); if EndX < Length(Line) then AddLineFragment(PGMChar(Line)+EndX, Length(Line)-EndX, FontHandle, FontColor, FontBkgndColor); end; procedure TGMxEditor.PaintLineFragments(const ADC: HDC; const APos: TPoint; const ALineFragments: TGMxLinePaintFragments); var i: LongInt; begin if ADC = 0 then Exit; MoveToEx(ADC, APos.x, APos.y, nil); for i:=Low(ALineFragments) to High(ALineFragments) do with ALineFragments[i] do begin SetTextColor(ADC, GMRGBColor(FontColor)); if BkgndColor = clrTransparent then SetBkMode(ADC, TRANSPARENT) else begin SetBkMode(ADC, OPAQUE); SetBkColor(ADC, GMRGBColor(BkgndColor)); end; TextOut(ADC, 0, 0, Text, TextLen); end; end; function TGMxEditor.PaintArea(const ADC: HDC; const ARect: TRect): Boolean; const cLastLine: array [Boolean] of LongInt = (0, 1); var i, H, L: LongInt; LnHgt, YPos, StartLine, EndLine: LongInt; LineFragments: TGMxLinePaintFragments; OldTextAlign: UINT; begin Result := inherited PaintArea(ADC, ARect); LnHgt := FontHeight + FLineSpace; if LnHgt = 0 then Exit; StartLine := -ScrollOffset.y div LnHgt; H := ARect.Bottom - ARect.Top; EndLine := Min(High(FLines), StartLine + (H div LnHgt) + cLastLine[H mod LnHgt <> 0]); YPos := ARect.Top + StartLine * LnHgt + ScrollOffset.y; L := ARect.Left + ScrollOffset.x; OldTextAlign := GetTextAlign(ADC); try SetTextAlign(ADC, TA_TOP or TA_LEFT or TA_UPDATECP); for i:=StartLine to EndLine do begin SetLength(LineFragments, 0); BuildLineFragments(i, LineFragments); if Length(LineFragments) > 0 then PaintLineFragments(ADC, GMPoint(L, YPos), LineFragments); Inc(YPos, LnHgt); end; finally SetTextAlign(ADC, OldTextAlign); end; end; { ------------------------ } { ---- TGMxButtonArea ---- } { ------------------------ } constructor TGMxButtonArea.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); CornerRounding := vGMDfltCornerRounding; end; constructor TGMxButtonArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AOnClick: TGMObjNotifyProc; const ABkgndColor: COLORREF; const AVisible, AAutoRepeat, ARefLifeTime: Boolean); begin {inherited} Create(AParent, APosition, AAreaAlign, ABkgndColor, AVisible, ARefLifeTime); FOnClick := AOnClick; FAutoRepeat := AAutoRepeat; HBkgndBrush; // <- Needed if created with down := True end; procedure TGMxButtonArea.WMLButtonDown(var Msg: TWMMouse); begin // GMCancelPopup; inherited; if not GetEnabled then Exit; FMouseDown := True; ScheduleRepaint; GMCaptureMouseInput(Self); if FAutoRepeat then FRepeatTimer := TGMWndTimerWithHandle.Create(Click, Self, 300, True); end; procedure TGMxButtonArea.WMLButtonUp(var Msg: TWMMouse); var MouseDn: Boolean; begin FRepeatTimer := nil; MouseDn := FMouseDown; FMouseDown := False; {if Enabled then} GMReleaseMouseCapture; inherited; if GetEnabled and MouseDn then begin ScheduleRepaint; if MouseInside then Click; end; end; procedure TGMxButtonArea.WMKeyDown(var Msg: TWMKey); begin if GMKeyDataToKeyState(Msg.KeyData) = [] then case Msg.CharCode of VK_RETURN, Ord(' '): if GetEnabled then Click; end; inherited; end; function TGMxButtonArea.FontBkgndColor: COLORREF; begin Result := clrTransparent; end; function TGMxButtonArea.IsDefaultDlgBtn: Boolean; begin Result := False; end; function TGMxButtonArea.Down: Boolean; begin Result := False; end; procedure TGMxButtonArea.Click(const ASender: TObject); begin //SendMessage(GetFocus, WM_CANCELMODE, 0, 0); if FRepeatTimer <> nil then FRepeatTimer.Interval := 50; if Assigned(FOnClick) then FOnClick(Self); end; procedure TGMxButtonArea.WMKillFocus(var Msg: TWMKillFocus); begin inherited; if GetEnabled then ScheduleRepaint; end; procedure TGMxButtonArea.WMSetFocus(var Msg: TWMSetFocus); begin inherited; if GetEnabled then ScheduleRepaint; end; { --------------------------- } { ---- TGMxHooverBtnArea ---- } { --------------------------- } function TGMxHooverBtnArea.HooverWhenDisabled: Boolean; begin Result := False; end; procedure TGMxHooverBtnArea.WMMouseEnter(var Msg: TWMMouse); begin if FRepeatTimer <> nil then FRepeatTimer.Start; inherited; if HooverWhenDisabled or GetEnabled then ScheduleRepaint; end; procedure TGMxHooverBtnArea.WMMouseLeave(var Msg: TWMMouse); begin if FRepeatTimer <> nil then FRepeatTimer.Stop; inherited; if HooverWhenDisabled or GetEnabled then ScheduleRepaint; end; { ----------------------------- } { ---- TGMxToolBtnAreaBase ---- } { ----------------------------- } constructor TGMxToolBtnAreaBase.Create(const ARefLifeTime: Boolean); begin inherited; //FFrameColor := clDfltHoverFrameColor; FFrame := GMToolBtnAreaFrame; end; function TGMxToolBtnAreaBase.FrameColor: COLORREF; begin if MouseInside and GetEnabled then Result := GMFrameColorFromBkgndColor(BkgndColor) // FFrameColor else Result := BKgndColor; end; function TGMxToolBtnAreaBase.AreaFiller: IGMAreaFiller; begin //Result := inherited AreaFiller; if MouseInside and GetEnabled then Result := GMToolBtnFiller else Result := GMAreaRectFiller; end; function TGMxToolBtnAreaBase.BkgndColor: COLORREF; begin if MouseInside and GetEnabled then Result := clrGlassBlue else Result := inherited BkgndColor; //if Result = FBkgndColor then Exit; //FBkgndColor := Result; //FBkgndBrush := nil; end; function TGMxToolBtnAreaBase.HBkgndBrush: THandle; begin {if MouseInside then begin if FHooverBrush = nil then FHooverBrush := TGMGdiBrush.Create(0, FHooverColor); Result := FHooverBrush.Handle; end else} if Down then begin // // create the "normal" brush here too if it has not yet been created // When a button is created with Down state the "normal" brush would stay nil // When the button goes up the first time then the "normal" brush gets created with BkgndColor // but the mouse will propably be inside at that moment and BkgndColor will return the HooverColoer! // if FBkgndBrush = nil then inherited HBkgndBrush; if FDownBrush = nil then FDownBrush := GMGetCachedBrush(cToolBtnDownColor); // TGMGdiBrush.Create(0, cToolBtnDownColor); Result := FDownBrush.Handle; end else Result := inherited HBkgndBrush; end; function TGMxToolBtnAreaBase.GetEnabled: Boolean; begin Result := not FDisabled; end; procedure TGMxToolBtnAreaBase.SetEnabled(const AEnabled: Boolean); begin if AEnabled <> not FDisabled then begin FDisabled := not AEnabled; ScheduleRepaint; end; end; function TGMxToolBtnAreaBase.PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; begin Result := inherited PaintArea(ADC, RSurface); if Down then GMDrawRoundFrame(ADC, GMInflateRect(RSurface, 1, 1), clDkGray, clWhite) else GMDrawRoundFrame(ADC, GMInflateRect(RSurface, 1, 1), FrameColor, CLR_INVALID); end; { ------------------------- } { ---- TGMxToolBtnArea ---- } { ------------------------- } constructor TGMxToolBtnArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AOnClick: TGMObjNotifyProc; const AText: TGMString; const AImgIdx: LongInt; const AImgList: IUnknown; //const AHintTitle, AHintText: TGMString; const ABkgndColor: COLORREF; const ATextSide: TEdge; const AHAlignment: TGMHorizontalAlignment; const AFontColor: COLORREF; const AVisible, ARefLifeTime: Boolean); begin {inherited} Create(AParent, APosition, AAreaAlign, AOnClick, ABkgndColor, AVisible, ARefLifeTime); //FFrameColor := AFrameColor; FText := GMResolveTextResData(AText, FResTextRef); FTextSide := ATextSide; FImageList := AImgList; FImageIdx := AImgIdx; FHAlignment := AHAlignment; FTextDrawFlags := cDfltTextLabelDrawFlags; // cDfltTextDrawFlags; //FLRSpace := c2CtlSpace; FIconSpace := cIconSpace; FFontColor := AFontColor; end; destructor TGMxToolBtnArea.Destroy; begin ReleaseIcon; inherited; end; procedure TGMxToolBtnArea.ReleaseIcon; begin if FFreeIcon and (FIcon <> 0) then DestroyIcon(FIcon); FIcon := 0; end; procedure TGMxToolBtnArea.LanguageChanged(const ANewLanguage: LParam); begin FText := GMBuildTextFromResRef(FResTextRef, FText); end; function TGMxToolBtnArea.FontColor: COLORREF; begin Result := FFontColor; end; function TGMxToolBtnArea.ExecuteOperation(const Operation: Integer; const Parameter: IUnknown): Boolean; begin case Operation of Ord(goDisable): begin SetEnabled(False); Result := True; end; Ord(goEnable): begin SetEnabled(True); Result := True; end; else Result := inherited ExecuteOperation(Operation, Parameter); end; end; procedure TGMxToolBtnArea.SetText(const AText: TGMString; const AReLayout: Boolean); begin if GMSameText(AText, FText) then Exit; FText := AText; if AReLayout then GMReLayoutContainedAreas(Parent); end; procedure TGMxToolBtnArea.SetImageIdx(const AImageIdx: Integer); begin if AImageIdx = FImageIdx then Exit; FImageIdx := AImageIdx; ReleaseIcon; ScheduleRepaint; end; procedure TGMxToolBtnArea.AssignImage; var imgCollection: IGMImageCollection; begin if (FImageIdx >= 0) and (FImageIdx < cImgIdxHigh) and GMQueryInterface(FImageList, IGMImageCollection, imgCollection) then FImageSize := imgCollection.Obj.ImageDescs[FImageIdx].Size else if FIcon = 0 then if (FImageList <> nil) and (FImageIdx > cImgIdxHigh) then FIcon := LoadIcon(0, MakeIntResource(FImageIdx)) else if (FImageList = nil) and (FImageIdx > cImgIdxHigh) then begin FIcon := HIcon(FImageIdx); FFreeIcon := True; end; if (FIcon <> 0) and (FImageSize.x = 0) or (FImageSize.y = 0) then FImageSize := GMIconSize(FIcon); end; function TGMxToolBtnArea.InternalCalcWidth(const ANewSize: TPoint): LongInt; begin AssignImage; if Length(FText) <= 0 then Result := c2CtlSpace else begin if (FImageSize.x > 0) and (FImageSize.y > 0) then Result := c2Ctlspace + cCtlSpace + FIconSpace else Result := 2 * c2Ctlspace; Inc(Result, GMTextExtent(FText, FontHandle).x); end; Inc(Result, Max(FImageSize.x, 0) + GMFrameExtent(Frame).x); end; function FontToIconOffs(AIconY: LongInt; const AFont: HFont): LongInt; var fontY: LongInt; begin Inc(AIconY); fontY := GMTextExtent('Hy', AFont).y; if fontY >= AIconY then Result := 0 else Result := (AIconY - fontY) div 2; end; function TGMxToolBtnArea.InternalCalcHeight(const ANewSize: TPoint): LongInt; var w, fontHeight: LongInt; begin AssignImage; w := ANewSize.x; if (FImageSize.x > 0) and (FImageSize.y > 0) then Dec(w, cCtlSpace + FImageSize.x + FIconSpace + c2CtlSpace) else Dec(w, 2 * c2CtlSpace); if w < 0 then w := 0; Result := c2CtlSpace; fontHeight := GMCalcTextAreaSize(FText, GMPoint(w, 1), cNullPoint, cNullPoint, FontHandle, FTextDrawFlags).y + FontToIconOffs(FImageSize.y, FontHandle); Inc(Result, Max(FImageSize.y, fontHeight) + GMFrameExtent(Frame).y); end; function TGMxToolBtnArea.PaintArea(const ADC: HDC; const ARSurface: TRect): Boolean; //const cDownOffs: array [Boolean] of TPoint = ((x: 0; y: 0), (x: 1; y: 1)); function AddSpaced(const ACurrentValue, ASpace, AAddValue: LongInt): LongInt; begin if ACurrentValue = 0 then Result := AAddValue else Result := ACurrentValue + ASpace + AAddValue; end; var rImg, rTxt, rInner: TRect; realSz, txtSz, tmpSz: TPoint; imgCollection: IGMImageCollection; hasImage, hasText: Boolean; begin AssignImage; hasImage := (FImageSize.x > 0) and (FImageSize.y > 0); hasText := Length(FText) > 0; realSz := cNullPoint; txtSz := GMTextExtent(FText, FontHandle); if hasImage and not hasText then rImg := GMCenterExtentInRect(FImageSize, ARSurface) else begin case FTextSide of edgLeft, edgRight: begin if hasImage then Inc(realSz.x, FImageSize.x); if hasText then realSz.x := AddSpaced(realSz.x, FIconSpace, txtSz.x); // realSz.y := Max(txtSz.y, FImageSize.y); end; end; case FHAlignment of haCenter: rInner := GMCenterExtentInRect(realSz, ARSurface); haLeft: begin // tmpSz := GMCenterExtent(realSz.y, GMPoint(ARSurface.top, ARSurface.Bottom)); rInner := GMRect(ARSurface.Left + cCtlSpace, 0, ARSurface.Left + cCtlSpace + realSz.x, 0); end; haRight: begin // tmpSz := GMCenterExtent(realSz.y, GMPoint(ARSurface.top, ARSurface.Bottom)); rInner := GMRect(ARSurface.Right - cCtlSpace - realSz.x, 0, ARSurface.Right - cCtlSpace, 0); end; end; case FTextSide of edgLeft: begin tmpSz := GMCenterExtent(txtSz.y, GMPoint(ARSurface.top, ARSurface.Bottom)); rTxt := GMRect(rInner.Left, tmpSz.x, rInner.Left + txtSz.x, tmpSz.y); tmpSz := GMCenterExtent(FImageSize.y, GMPoint(ARSurface.top, ARSurface.Bottom)); rImg := GMRect(rInner.Right - FImageSize.x, tmpSz.x, rInner.Right, tmpSz.y); end; edgRight: begin tmpSz := GMCenterExtent(txtSz.y, GMPoint(ARSurface.top, ARSurface.Bottom)); rTxt := GMRect(rInner.Right - txtSz.x, tmpSz.x, rInner.Right, tmpSz.y); tmpSz := GMCenterExtent(FImageSize.y, GMPoint(ARSurface.top, ARSurface.Bottom)); rImg := GMRect(rInner.Left, tmpSz.x, rInner.Left + FImageSize.x, tmpSz.y); end; end; end; rImg := GMMoveRect(rImg, ImageDrawOffset); if (MouseInside and FMouseDown) or Down then begin rTxt := GMMoveRect(rTxt, 1, 1); rImg := GMMoveRect(rImg, 1, 1); end; if hasImage then begin if (FImageIdx < cImgIdxHigh) and GMQueryInterface(FImageList, IGMImageCollection, imgCollection) then imgCollection.Obj.DrawImage(FImageIdx, ADC, rImg, not GetEnabled) else if FIcon <> 0 then GMDrawIcon(ADC, FIcon, rImg, not GetEnabled); end; if hasText then GMPaintText(ADC, FText, rTxt, GetEnabled, haLeft, vaTop, FTextDrawFlags); Result := inherited PaintArea(ADC, ARSurface); end; //function TGMxToolBtnArea.CreateAreaRegion(const ABoundingRect: TRect; const ARegionKind: TGMAreaRegionKind): IGMGetHandle; ////const c2=2; //begin //Result := TGMGdiRegion.CreateRoundRect(0, ABoundingRect, cGMAreaRoundings[ARegionKind]); // ////with ABoundingRect do //// Result := TGMGdiRegion.CreatePolygon(0, [GMPoint(Left+c2, Top), GMPoint(Right-c2, Top), //GMPoint(Right-c2+1, Top+1), //// GMPoint(Right, Top+c2), GMPoint(Right, Bottom-c2-1), //// GMPoint(Right-c2-1, Bottom), GMPoint(Left+c2, Bottom), //// GMPoint(Left, Bottom-c2-1), GMPoint(Left, Top+c2)], WINDING); //end; //function TGMxToolBtnArea.Frame: IGMAreaFrameDrawer; //begin //if Down then // begin // if FDownFrame = nil then // begin // FDownFrame := TGMAreaMultiFrame.Create(nil, True); // GMSetIntfMultifFrame(FDownFrame, frsNone, frsLowered); // end; // Result := FDownFrame; // end //else // // //begin // //if FFrame = nil then FFrame := TGMAreaSimpleFrame.Create(Self, 1, cAllEdges); // if FFrame = nil then FFrame := TGMAreaFakeFrame.Create(1, cAllEdges); // //if FFrame = nil then FFrame := TGMAreaRegionFrame.Create(1, 1); // Result := FFrame; // //end; //end; {------------------------------ } { ---- TGMxBoldToolBtnArea ---- } { ----------------------------- } function TGMxBoldToolBtnArea.FontHandle: THandle; begin Result := GMBoldUIFont; end; { ---------------------------- } { ---- TGMxPngToolBtnArea ---- } { ---------------------------- } {$IFDEF PNGSUPPORT} function TGMxPngToolBtnArea.PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; var RImg: TRect; DrawImg: IGMPngImage; //ColorType: Cardinal; begin if Image <> nil then if not FDisabled then DrawImg := Image else begin if FDisabledImage = nil then begin //if Image.Obj.TransparencyMode = ptmNone then ColorType := COLOR_GRAYSCALE else ColorType := COLOR_GRAYSCALEALPHA; FDisabledImage := TGMPngImage.CreateBlank(COLOR_GRAYSCALE, 8, Image.Obj.Width, Image.Obj.Height); Image.Obj.Draw(FDisabledImage.Obj.Header.ImageDC_, GMRect(cNullPoint, Image.Obj.Size)); end; DrawImg := FDisabledImage; end; if DrawImg <> nil then begin RImg := GMCenterExtentInRect(GMPoint(DrawImg.Obj.Width, DrawImg.Obj.Height), RSurface); if (MouseInside and FMouseDown) or Down then RImg := GMMoveRect(RImg, 1, 1); DrawImg.Obj.Draw(ADC, RImg); end; Result := inherited PaintArea(ADC, RSurface); end; {$ENDIF} { ---------------------------- } { ---- TGMxImgToolBtnArea ---- } { ---------------------------- } //constructor TGMxImgToolBtnArea.Create(const AParent: TObject; //const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; //const AOnClick: TGMObjNotifyProc; const AText: TGMString; //const AImage: IGMGetHandle; const AHintTitle, AHintText: TGMString; //const ABkgndColor, AFrameColor: COLORREF; const AVisible, //ARefLifeTime: Boolean); //begin //inherited Create(AParent, APosition, AAreaAlign, AOnClick, ABkgndColor, AVisible, ARefLifeTIme); //end; // //function TGMxImgToolBtnArea.PaintArea(const ADC: HDC; const RSurface: TRect): Boolean; //begin // //end; { -------------------------- } { ---- TGMxCloseBtnArea ---- } { -------------------------- } constructor TGMxCloseBtnArea.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); CornerRounding := vGMSmallBtnRounding; end; function TGMxCloseBtnArea.BkgndColor: COLORREF; //const cBkColor = $ECEBEA; const cBkColor = cCloseCrossColor; // $42b4ff; begin if not MouseInside or not GetEnabled then Result := clrTransparent else //if not GetEnabled then Result := clSilver else if FMouseDown then Result := GMChangeColorLightness(cBkColor, 300) else Result := cBkColor; end; function TGMxCloseBtnArea.GetEnabled: Boolean; begin Result := not FDisabled; end; procedure TGMxCloseBtnArea.WMMouseEnter(var Msg: TWMMouse); begin FBkgndBrush := nil; inherited; end; procedure TGMxCloseBtnArea.WMMouseLeave(var Msg: TWMMouse); begin FBkgndBrush := nil; inherited; end; procedure TGMxCloseBtnArea.WMLButtonDown(var Msg: TWMMouse); begin FBkgndBrush := nil; inherited; end; procedure TGMxCloseBtnArea.WMLButtonUp(var Msg: TWMMouse); begin FBkgndBrush := nil; inherited; end; procedure TGMxCloseBtnArea.SetEnabled(const AValue: Boolean); begin if AValue = not FDisabled then Exit; FDisabled := not AValue; ScheduleRepaint; end; //function TGMxCloseBtnArea.PaintArea(const ADC: HDC; const ARect: TRect): Boolean; ////const cFillColor = $807eff; cFrameColor = $4b47ee; cx = 2; cy = 0; // $4744ed //var pen: IGMGetHandle; rDraw: TRect; // Points: array [0..16] of TPoint; , Brush //begin // Result := inherited PaintArea(ADC, ARect); // // if MouseInside then //FrameRgn(ADC); // begin // //pen := TGMGdiPen.Create(ADC, $969696); // pen := TGMGdiPen.Create(ADC, clSilver); // with ARect do RoundRect(ADC, Left, Top, Right, Bottom, vGMSmallBtnRounding.x, vGMSmallBtnRounding.y); // pen := TGMGdiPen.Create(ADC, clWhite); // with ARect do Rectangle(ADC, Left+1, Top+1, Right-1, Bottom-1); // //pen := nil; // end; // // rDraw := ARect; // InflateRect(rDraw, -3, -3); // //if FMouseDown and MouseInside then //OffsetRect(rDraw, 1, 1); // // if not GetEnabled then // pen := TGMGdiPen.Create(ADC, clDkGray) // else // if MouseInside then //OffsetRect(rDraw, 1, 1); // pen := TGMGdiPen.Create(ADC, clWhite) // //pen := TGMGdiPen.Create(ADC, $4b47ee) // else // pen := TGMGdiPen.Create(ADC, cCloseCrossColor); // // GMPaintBtnCross(ADC, rDraw); //end; function TGMxCloseBtnArea.PaintArea(const ADC: HDC; const ARect: TRect): Boolean; //const cFillColor = $807eff; cFrameColor = $4b47ee; cx = 2; cy = 0; // $4744ed var pen: IGMGetHandle; rDraw: TRect; // Points: array [0..16] of TPoint; , Brush begin Result := inherited PaintArea(ADC, ARect); if MouseInside and GetEnabled then //FrameRgn(ADC); begin //pen := TGMGdiPen.Create(ADC, $969696); pen := TGMGdiPen.Create(ADC, clSilver); with ARect do RoundRect(ADC, Left, Top, Right, Bottom, vGMSmallBtnRounding.x, vGMSmallBtnRounding.y); //pen := TGMGdiPen.Create(ADC, clWhite); //with ARect do Rectangle(ADC, Left+1, Top+1, Right-1, Bottom-1); //pen := nil; end; rDraw := ARect; InflateRect(rDraw, -3, -3); if FMouseDown and MouseInside then OffsetRect(rDraw, 1, 1); if not GetEnabled then pen := TGMGdiPen.Create(ADC, clDkGray) else if MouseInside then //OffsetRect(rDraw, 1, 1); pen := TGMGdiPen.Create(ADC, clWhite) //pen := TGMGdiPen.Create(ADC, $4b47ee) else pen := TGMGdiPen.Create(ADC, cCloseCrossColor); GMPaintBtnCross(ADC, rDraw); end; { -------------------------- } { ---- TGMxWinXPButtonArea ---- } { -------------------------- } constructor TGMxWinXPButtonArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString; const AOnClick: TGMObjNotifyProc; const ABkgndColor: COLORREF; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, AOnClick, ABkgndColor, AVisible, ARefLifeTime); FText := AText; end; function TGMxWinXPButtonArea.FontBkgndColor: COLORREF; begin Result := clrTransparent; end; function TGMxWinXPButtonArea.CalculateHeight(const NewSize: TPoint): LongInt; begin Result := Max(GMCalcTextAreaSize(FText, NewSize, GMFrameExtent(Frame), GMPoint(2*cDlgSpace, 0), FontHandle, cDfltLabelDrawFlags).y, inherited CalculateHeight(NewSize)); end; function TGMxWinXPButtonArea.CalculateWidth(const NewSize: TPoint): LongInt; begin Result := Max(GMCalcTextAreaSize(FText, NewSize, GMFrameExtent(Frame), GMPoint(2*cDlgSpace, 0), FontHandle, cDfltLabelDrawFlags).x, inherited CalculateWidth(NewSize)); end; function TGMxWinXPButtonArea.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)) and inherited IsDialogKeyMsg(Msg); end; function TGMxWinXPButtonArea.PaintArea(const ADC: HDC; const ARect: TRect): Boolean; const cXPBtnColors: array [Boolean] of COLORREF = ($EEF3F3, $DAE1E2); var Brush, Pen: IGMGetHandle; H, Y1, Y2: LongInt; BkColor: COLORREF; Colors: array [0..2] of COLORREF; RText: TRect; begin Result := inherited PaintArea(ADC, ARect); H := GMRectSize(ARect).y-2; Y1 := Round(H * 0.25); Y2 := Round(H * 0.75); BkColor := cXPBtnColors[MouseInside and FMouseDown]; Colors[1] := BkColor; if MouseInside and FMouseDown then begin Colors[2] := clWhite; Colors[0] := GMChangeColorLightness(BkColor, -30); end else begin Colors[0] := clWhite; Colors[2] := GMChangeColorLightness(BkColor, -30); end; with ARect do begin GMGradientFillRect(ADC, Colors[0], Colors[1], GMRect(Left+1, Top+1, Right-1, Top+Y1), d2dVertical); Brush := TGMGdiBrush.Create(0, Colors[1]); FillRect(ADC, GMRect(Left+1, Top+Y1, Right-1, Top+Y2), Brush.Handle); GMGradientFillRect(ADC, Colors[1], Colors[2], GMRect(Left+1, Top+Y2, Right-1, Bottom-1), d2dVertical); // end; RText := GMInflateRect(ARect, -1, -1); if MouseInside and FMouseDown then RText := GMMoveRect(RText, 1, 1); GMDrawText(ADC, FText, RText, haCenter, vaCenter, cDfltLabelDrawFlags); Brush := nil; Brush := TGMGdiBrush.Create(ADC, 0, BS_NULL); Pen := TGMGdiPen.Create(ADC, $473C00); with ARect do RoundRect(ADC, Left, Top, Right, Bottom, 6, 6); if MouseInside and not FMouseDown then with ARect do begin Pen := TGMGdiPen.Create(ADC, $61C7FB); Rectangle(ADC, Left+1, Top+2, Right-1, Bottom-2); Rectangle(ADC, Left+2, Top+1, Right-2, Bottom-1); end; if vGMKeyboardFocusArea = Self then DrawFocusRect(ADC, GMInflateRect(RText, -1, -1)); end; { --------------------------- } { ---- TGMxToolAreaState ---- } { --------------------------- } constructor TGMxToolAreaState.Create(const AArea: TObject; const ArefLifetime: Boolean); begin inherited Create(ArefLifetime); FArea := AArea; if AArea <> nil then AssignFromObj(AArea); end; function TGMxToolAreaState.GetHandle: THandle; begin Result := THandle(FArea); end; procedure TGMxToolAreaState.AssignFromObj(const Source: TObject); begin AssignFromIntf(GMObjAsIntf(Source)); end; procedure TGMxToolAreaState.AssignToObj(const Dest: TObject); begin AssignToIntf(GMObjAsIntf(Dest)); end; procedure TGMxToolAreaState.AssignFromIntf(const Source: IUnknown); var PIParent: IGMGetParentObj; PIArea: IGMUiArea; PIBkColor: IGMBkgndColor; begin if Source = nil then Exit; if GMQueryInterface(Source, IGMGetParentObj, PIParent) then FParent := PIParent.ParentObj; if GMQueryInterface(Source, IGMBkgndColor, PIBkColor) then FBkgndColor := PIBkColor.BkgndColor; if GMQueryInterface(Source, IGMUiArea, PIArea) then begin FVisible := PIArea.Visible; //FAreaAlign := PIarea.AreaAlign; FLayoutBounds := PIArea.LayoutBounds; //FLayoutStaceSpace := .. end; end; procedure TGMxToolAreaState.AssignToIntf(const Dest: IUnknown); var PIArea: IGMUiArea; PIBkColor: IGMGetSetBkgndColor; PIParent: IGMGetSetParentObj; begin if Dest = nil then Exit; //if GMQueryInterface(Dest, IGMGetSetParentObj, PIParent) then PIParent.ParentObj := FParent; if GMQueryInterface(Dest, IGMGetSetBkgndColor, PIBkColor) then PIBkColor.SetBkgndColor(FBkgndColor, False); if GMQueryInterface(Dest, IGMUiArea, PIArea) then begin if GMQueryInterface(PIArea, IGMGetSetParentObj, PIParent) then PIParent.SetParentObj(FParent, False); PIArea.SetVisible(FVisible, False); //PIArea.AreaAlign := FAreaAlign; PIArea.SetLayoutBounds(FLayoutBounds, False); //FLayoutStaceSpace := .. end; end; { ---------------------------- } { ---- TGMxChevronBtnBase ---- } { ---------------------------- } constructor TGMxChevronBtnBase.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); CornerRounding := vGMSmallBtnRounding; FFrame := TGMAreaSimpleFrame.Create(1); end; procedure TGMxChevronBtnBase.WMMouseEnter(var Msg: TWMMouse); begin FBkgndBrush := nil; inherited; end; procedure TGMxChevronBtnBase.WMMouseLeave(var Msg: TWMMouse); begin FBkgndBrush := nil; inherited; end; {function TGMxChevronBtnBase.Frame: IGMAreaFrameDrawer; begin if FFrame = nil then FFrame := TGMAreaSimpleFrame.Create(1); Result := FFrame; end;} function TGMxChevronBtnBase.BkgndColor: COLORREF; begin if MouseInside then Result := clBlack else Result := GMChangeColorLightness(cDfltColor, 200); end; function TGMxChevronBtnBase.FrameColor: COLORREF; begin Result := GMRGBColor(clDkGray); end; function TGMxChevronBtnBase.PaintArea(const ADC: HDC; const ARect: TRect): Boolean; const CS = 3; cSzCh: TSize = (cx: 8; cy: 5); cSzDa: TSize = (cx: 5; cy: 3); var PCh, PDa: TPoint; DnOffs: Integer; Pen: IUnknown; PenColor: COLORREF; procedure DrawChevron(const x, y: Integer); const C4 = 4; var i: Integer; begin for i:=0 to C4 do if i <= C4 div 2 then begin MoveToEx(ADC, x+i, y+i, nil); LineTo(ADC, x+i+2, y+i); end else begin MoveToEx(ADC, x+C4-i, y+i, nil); LineTo(ADC, x+C4+2-i, y+i); end; end; begin Result := inherited PaintArea(ADC, ARect); DnOffs := cDownOffs[MouseInside and FMouseDown]; if MouseInside then PenColor := clWhite else PenColor := clBlack; Pen := TGMGdiPen.Create(ADC, PenColor); case Direction of d2dHorizontal: begin PCh := GMPointOffsBy(GMPoint(ARect.Left + ((ARect.Right - ARect.Left - cSzCh.cx) div 2), ARect.Top + CS), DnOffs); PDa := GMPointOffsBy(GMPoint(ARect.Left + ((ARect.Right - ARect.Left - cSzDa.cx) div 2), ARect.Bottom - cSzDa.cy - CS - 2), DnOffs); end; d2dVertical: begin PCh := GMPointOffsBy(GMPoint(CS, ARect.Top + ((ARect.Bottom - ARect.Top - cSzCh.cy) div 2)), DnOffs); PDa := GMPointOffsBy(GMPoint(ARect.Right - cSzDa.cx - CS - 2, ARect.Top + ((ARect.Bottom - ARect.Top - cSzDa.cy) div 2)), DnOffs); end; end; DrawChevron(PCh.x, PCh.y); DrawChevron(PCh.x + 4, PCh.y); GMDrawDropArrow(ADC, GetEnabled, True, GMRect(PDa.x, PDa.y, PDa.x + cSzDa.cx, PDa.y + cSzDa.cy), [clDkGray, PenColor]); end; { -------------------------- } { ---- TGMxChevronPopup ---- } { -------------------------- } constructor TGMxChevronPopup.Create(const ArefLifetime: Boolean); begin inherited Create(ARefLifeTime); FAreaStates := TGMObjArrayCollection.Create(True, True, True, GMCompareByHandle, True); end; constructor TGMxChevronPopup.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); FRow := OwnArea(TGMSurroundingUiArea.Create(Self, GMRect(cSpc2, cSpc2, 0, GMRectSize(FLayoutBounds).y), cTopLeftX, ABkgndColor)) as TGMUiArea; end; procedure TGMxChevronPopup.WMMouseActivate(var Msg: TWMMouseActivate); begin //inherited; Msg.Result := MA_NOACTIVATE; FPassMessageToOriginalHandler := False; end; function TGMxChevronPopup.TakeControls(const Source: TObject): TPoint; var i, LSpc: LongInt; PIChild: IGMUiArea; PIBkColor: IGMGetSetBkgndColor; PIParent: IGMGetSetParentObj; begin if (Source = nil) or not Source.GetInterface(IGMUiArea, FOrgParent) then Exit(Default(TPoint)); i:=0; while i < FOrgParent.ContainedAreas.Count do begin if FOrgParent.ContainedAreas[i].GetInterface(IGMUiArea, PIChild) and not PIChild.Visible then begin AreaStates.Add(TGMxToolAreaState.Create(FOrgParent.ContainedAreas[i])); if GMQueryInterface(PIChild, IGMGetSetParentObj, PIParent) then PIParent.SetParentObj(Row, False); if GMQueryInterface(PIChild, IGMGetSetBkgndColor, PIBkColor) then PIBkColor.SetBkgndColor(BkgndColor, False); PIChild.SetVisible(True, False); end else Inc(i); end; GMreLayoutContainedAreas(Self, False, True); if not Row.ContainedAreas.IsEmpty and Row.ContainedAreas.First.GetInterface(IGMUiArea, PIChild) then LSpc := PIChild.LayoutSpace.Left else LSpc := cCtlSpace; Result := GMWndSizeFromClientSize(GMAddPoints(GMRectSize(Row.LayoutBounds), GMPoint(2*cSpc2 + LSpc, 2*cSpc2)), WndStyle, WndExStyle); end; function TGMxChevronPopup.ClosePopupState(const RestoreActiveCtrl: Boolean): Boolean; begin //GMReleaseMouseCapture; Result := inherited ClosePopupState(RestoreActiveCtrl); if Result then ReturnControls(nil); end; procedure TGMxChevronPopup.ReturnControls(const Dest: TObject); var PIHandle: IUnknown; State: TObject; begin if FOrgParent = nil then Exit; while not Row.ContainedAreas.IsEmpty do begin PIHandle := TGMHandleObj.Create(THandle(Row.ContainedAreas.First), True); if AreaStates.Find(PIHandle, State) then (State as TGMxToolAreaState).AssignToObj(Row.ContainedAreas.First); end; AreaStates.Clear; end; { ------------------------------- } { ---- TGMxToolBarChevronBtn ---- } { ------------------------------- } constructor TGMxToolBarChevronBtn.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, TGMxToolBar, FToolBar); end; function TGMxToolBarChevronBtn.Direction: TGM2DDirection; begin Result := ToolBar.Direction end; procedure TGMxToolBarChevronBtn.Click; var RPopup: TRect; Sz, PtScreen: TPoint; begin if FToolBar = nil then Exit; if FPopup = nil then FPopup := OwnArea(TGMxChevronPopup.Create(-Int64(Self), GMRect(0, 0, 0, GMRectSize(ToolBar.LayoutBounds).y), cFixedPlace, '', WS_BORDER or WS_POPUP, WS_EX_CONTROLPARENT, clrWindow)) as TGMxChevronPopup; vGMPopupArea := FPopup; Popup.Handle; // <- Create Handle before taking over controls to supply a parent for windowed controls Sz := Popup.TakeControls(ToolBar); PtScreen := GMClientToScreen(Self, GMAddPoints(LayoutBounds.BottomRight, (Parent as TGMUiAreaBase).ClientAreaOrigin)); Inc(PtScreen.y, 1); RPopup := GMRect(PtScreen.x - Sz.x, PtScreen.y, PtScreen.x, PtScreen.y + Sz.y); Popup.SetLayoutBounds(RPopup, False); {ToDo: Popup without Activation ..} //GMShowWindowAnimated(Popup.Handle, True, True); GMAnimateWindow(Popup.Handle, vGMPopupAniDuration, AW_BLEND); // or AW_ACTIVATE //SetFocus(Popup.Handle); //GMCaptureMouseInput(Popup); //inherited; end; { --------------------- } { ---- TGMxToolBar ---- } { --------------------- } constructor TGMxToolBar.Create(const AParent: TGMWndObj; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ADirection: TGM2DDirection; const ABkgndColor: COLORREF; const AWndStyle, AWndExStyle: DWORD; const ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, '', AWndStyle, AWndExStyle, ABkgndColor, ARefLifeTime); FChevronBtn := OwnArea(TGMxToolBarChevronBtn.Create(Self, GMRect(-cChevronBtnWidth, 0, 0, 0), cRightAligned, ABkgndColor, False)) as TGMxToolBarChevronBtn; FDirection := ADirection; end; {function TGMxToolBar.Direction: TGM2DDirection; begin if (FAreaAlign.EdgeAlign[edgTop] = ealAligned) and (FAreaAlign.EdgeAlign[edgBottom] = ealAligned) then Result := d2dVertical else Result := d2dHorizontal; end;} //procedure TGMxToolBar.WMMouseActivate(var Msg: TWMMouseActivate); //begin //// No call to inherited here! //Msg.Result := MA_NOACTIVATE; FPassMessageToOriginalHandler := False; //end; procedure TGMxToolBar.HideOrShowChildAreas; var i, XMax, WChev: LongInt; PIChild: IGMUiArea; begin XMax := 0; for i:=0 to ContainedAreas.Count-1 do if (ContainedAreas[i] <> FChevronBtn) and ContainedAreas[i].GetInterface(IGMUiArea, PIChild) then XMax := Max(XMax, PIChild.EdgePosition[edgright]); FChevronBtn.SetVisible(XMax > ClientAreaSize.x, True); if FChevronBtn.Visible then WChev := GMRectSize(FChevronBtn.LayoutBounds).x else WChev := 0; for i:=0 to ContainedAreas.Count-1 do if (ContainedAreas[i] <> FChevronBtn) and ContainedAreas[i].GetInterface(IGMUiArea, PIChild) then begin XMax := Max(XMax, PIChild.EdgePosition[edgright]); PIChild.SetVisible((PIChild.EdgePosition[edgright] <= ClientAreaSize.x - WChev), False); end; end; procedure TGMxToolBar.LayoutContainedAreas(const ARepaint: Boolean); // : TPoint; begin inherited LayoutContainedAreas(ARepaint); HideOrShowChildAreas; end; {procedure TGMxToolBar.SetLayoutBounds(const Value: TRect; const Repaint: Boolean); var WChange: Boolean; i, XMax, WChev: LongInt; PIChild: IGMUiArea; begin WChange := (Direction = d2dHorizontal) and (GMRectSize(Value).x <> GMRectSize(FLayoutBounds).x); inherited; if WChange then HideOrShowChildAreas; end;} { ---------------------- } { ---- TGMxSplitter ---- } { ---------------------- } constructor TGMxSplitter.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AResizeArea: TObject; //const AResizeDirection: TGM2DDirection; const ABkgndColor: COLORREF; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, ABkgndColor, AVisible, ARefLifeTime); FDragOrigin := cInvalidUIPoint; SetResizeArea(AResizeArea); //FResizeDirection := AResizeDirection; end; procedure TGMxSplitter.SetResizeArea(const Value: TObject); var PIArea: IGMUiArea; begin FResizeArea := Value; if (Value = nil) or not Value.GetInterface(IGMUiArea, PIArea) then Exit; FResizeAreaAlign := PIArea.AreaAlign; FResizeDirection := GMSplitDirectionFromAlign(FResizeAreaAlign.EdgeAlign, PIArea.LayoutSpace); end; procedure TGMxSplitter.CreateHandle; begin inherited; FindOppositeArea; end; procedure TGMxSplitter.FindOppositeArea; var prntArea, childArea: IGMUiArea; getParent: IGMGetParentObj; i: LongInt; begin if not GMGetInterface(ResizeArea, IGMGetParentObj, getParent) or not GMGetInterface(getParent.ParentObj, IGMUiArea, prntArea) then Exit; for i:=0 to prntArea.ContainedAreas.Count-1 do if GMGetInterface(prntArea.ContainedAreas[i], IGMUiArea, childArea) and childArea.Visible and GMIsEqualAlign(childArea.AreaAlign, cClientAligned) then FRestFillArea := prntArea.ContainedAreas[i]; end; function TGMxSplitter.PaintArea(const ADC: HDC; const ARect: TRect): Boolean; const dotsz = 3; dotratio = 0.1; var H, Y, X, N, i: LongInt; begin case FResizeDirection of d2dHorizontal: begin N := Round(GMRectSize(ARect).y * dotratio) div (dotsz + 1); H := (N * (dotsz + 1)) - 1; Y := (ARect.Top + ARect.Bottom - H) div 2; X := (ARect.Left + ARect.Right - dotsz) div 2; for i:=0 to N-1 do GMPaintDot(ADC, X, Y + (i * (dotsz + 1)), dotsz); end; d2dVertical: begin N := Round(GMRectSize(ARect).x * dotratio) div (dotsz + 1); H := (N * (dotsz + 1)) - 1; Y := (ARect.Top + ARect.Bottom - dotsz) div 2; X := (ARect.Left + ARect.Right - H) div 2; for i:=0 to N-1 do GMPaintDot(ADC, X + (i * (dotsz + 1)), Y, dotsz); end; end; Result := inherited PaintArea(ADC, ARect); end; procedure TGMxSplitter.WMSetCursor(var Msg: TWMSetCursor); const cCursor: array [TGM2DDirection] of PGMChar = (IDC_GMVSPLIT, IDC_GMHSPLIT); begin SetCursor(LoadCursor({$IFNDEF FPC}SysInit.{$ELSE}System.{$ENDIF}HInstance, cCursor[FResizeDirection])); Msg.Result := 1; end; function TGMxSplitter.IsDragging: Boolean; begin Result := FDragOrigin <> cInvalidUIPoint; end; procedure TGMxSplitter.WMLButtonDown(var Msg: TWMMouse); var resizeArea: IGMUiArea; areaAlign: TGMAreaAlignRec; rSpace: TRect; begin inherited; if (FResizeArea = nil) or not FResizeArea.GetInterface(IGMUiArea, resizeArea) then Exit; areaAlign := resizeArea.areaAlign; rSpace := resizeArea.LayoutSpace; case FResizeDirection of d2dHorizontal: if FResizeAreaAlign.EdgeAlign[edgRight] = ealAligned then begin if rSpace.Right < cQalign then FStartValue := resizeArea.LayoutBounds.Left else FStartValue := GMRectSize(resizeArea.GetLayoutBounds).x; end else if FResizeAreaAlign.EdgeAlign[edgLeft] = ealAligned then if rSpace.Left < cQalign then FStartValue := resizeArea.LayoutBounds.Right else FStartValue := GMRectSize(resizeArea.GetLayoutBounds).x; d2dVertical: if FResizeAreaAlign.EdgeAlign[edgBottom] = ealAligned then begin if rSpace.Bottom < cQalign then FStartValue := resizeArea.LayoutBounds.Top else FStartValue := GMRectSize(resizeArea.GetLayoutBounds).y; end else if FResizeAreaAlign.EdgeAlign[edgTop] = ealAligned then if rSpace.Top < cQalign then FStartValue := resizeArea.LayoutBounds.Bottom else FStartValue := GMRectSize(resizeArea.GetLayoutBounds).y; end; FDragOrigin := GMMousePosition; // GMClientToScreen(Self, SmallPointToPoint(Msg.Pos)); GMCaptureMouseInput(Self); end; procedure TGMxSplitter.WMMouseMove(var Msg: TWMMouseMove); var resizeArea, restArea, prntArea: IGMUiArea; rBounds, rSpace, rOppBounds, rOldRect: TRect; MousePos: TPoint; resizeParent: IGMGetParentObj; PISize, PIRestSz: IGMGetSizeConstraints; areaCnstr, RestSz: TGMSizeConstraintsRec; isQAligned: Boolean; function LimitWidth(const ANewWidth: LongInt): LongInt; begin Result := ANewWidth; if (areaCnstr.MinWidth <> cNoSizeCnstr) and (Result < areaCnstr.MinWidth) then Result := areaCnstr.MinWidth; if (areaCnstr.MaxWidth <> cNoSizeCnstr) and (Result > areaCnstr.MaxWidth) then Result := areaCnstr.MaxWidth; end; function LimitHeight(const ANewHeight: LongInt): LongInt; begin Result := ANewHeight; if (areaCnstr.MinHeight <> cNoSizeCnstr) and (Result < areaCnstr.MinHeight) then Result := areaCnstr.MinHeight; if (areaCnstr.MaxHeight <> cNoSizeCnstr) and (Result > areaCnstr.MaxHeight) then Result := areaCnstr.MaxHeight; end; begin inherited; MousePos := GMMousePosition; // GMClientToScreen(Self, SmallPointToPoint(Msg.Pos)); if not IsDragging or not GMGetInterface(FResizeArea,IGMUiArea, resizeArea) or not GMGetInterface(FResizeArea, IGMGetParentObj, resizeParent) then Exit; isQAligned := False; rBounds := resizeArea.LayoutBounds; rSpace := resizeArea.LayoutSpace; FillByte(areaCnstr, SizeOf(areaCnstr), cNoSizeCnstr); if FResizeArea.GetInterface(IGMGetSizeConstraints, PISize) then areaCnstr := PISize.GetSizeContraints; if GMGetInterface(FRestFillArea, IGMUiArea, restArea) and GMGetInterface(FRestFillArea, IGMGetSizeConstraints, PIRestSz) then begin RestSz := PIRestSz.GetSizeContraints; rOppBounds := restArea.LayoutBounds; case FResizeDirection of d2dHorizontal: begin if RestSz.MinWidth <> cNoSizeCnstr then areaCnstr.MaxWidth := GMRectSize(rBounds).x + GMRectSize(rOppBounds).x - RestSz.MinWidth; if RestSz.MaxWidth <> cNoSizeCnstr then areaCnstr.MinWidth := GMRectSize(rBounds).x + GMRectSize(rOppBounds).x - RestSz.MaxWidth; end; d2dVertical: begin if RestSz.MinHeight <> cNoSizeCnstr then areaCnstr.MaxHeight := GMRectSize(rBounds).y + GMRectSize(rOppBounds).y - RestSz.MinHeight; if RestSz.MaxHeight <> cNoSizeCnstr then areaCnstr.MinHeight := GMRectSize(rBounds).y + GMRectSize(rOppBounds).y - RestSz.MaxHeight; end; end; end; case FResizeDirection of d2dHorizontal: if FResizeAreaAlign.EdgeAlign[edgRight] = ealAligned then begin if rSpace.Right < cQalign then begin rOldRect := rBounds; rBounds.Left := LimitWidth(FStartValue + MousePos.x - FDragOrigin.x); end else begin if GMGetInterface(resizeParent.ParentObj, IGMUiArea, prntArea) then begin isQAligned := True; rOldRect := rSpace; rSpace.Right := Round((LimitWidth(FStartValue + MousePos.x - FDragOrigin.x) / GMRectSize(prntArea.LayoutBounds).x) * cQAlignDivisor); end; end; end else if FResizeAreaAlign.EdgeAlign[edgLeft] = ealAligned then if rSpace.Left < cQalign then begin rOldRect := rBounds; rBounds.Right := LimitWidth(FStartValue + MousePos.x - FDragOrigin.x); end else if GMGetInterface(resizeParent.ParentObj, IGMUiArea, prntArea) then begin isQAligned := True; rOldRect := rSpace; rSpace.Left := Round((LimitWidth(FStartValue + MousePos.x - FDragOrigin.x) / GMRectSize(prntArea.LayoutBounds).x) * cQAlignDivisor); end; d2dVertical: if FResizeAreaAlign.EdgeAlign[edgBottom] = ealAligned then begin if rSpace.Bottom < cQalign then begin rOldRect := rBounds; rBounds.Top := LimitHeight(FStartValue + MousePos.y - FDragOrigin.y); end else begin if GMGetInterface(resizeParent.ParentObj, IGMUiArea, prntArea) then begin isQAligned := True; rOldRect := rSpace; rSpace.Bottom := Round((LimitHeight(FStartValue + MousePos.y - FDragOrigin.y) / GMRectSize(prntArea.LayoutBounds).y) * cQAlignDivisor); end; end; end else if FResizeAreaAlign.EdgeAlign[edgTop] = ealAligned then if rSpace.Top < cQalign then begin rOldRect := rBounds; rBounds.Bottom := LimitHeight(FStartValue + MousePos.y - FDragOrigin.y); end else if GMGetInterface(resizeParent.ParentObj, IGMUiArea, prntArea) then begin isQAligned := True; rOldRect := rSpace; rSpace.Top := Round((LimitHeight(FStartValue + MousePos.y - FDragOrigin.y) / GMRectSize(prntArea.LayoutBounds).y) * cQAlignDivisor); end; end; if isQAligned then begin if EqualRect(rSpace, rOldRect) then Exit; resizeArea.SetLayoutSpace(rSpace) end else begin if EqualRect(rBounds, rOldRect) then Exit; resizeArea.SetLayoutBounds(rBounds, False); end; GMReLayoutContainedAreas(resizeParent.ParentObj, True); GMExecPendingPainting(Self); end; procedure TGMxSplitter.WMLButtonUp(var Msg: TWMMouse); begin FStartValue := 0; FDragOrigin := cInvalidUIPoint; GMReleaseMouseCapture; inherited; end; { -------------------------- } { ---- TGMxGradientArea ---- } { -------------------------- } constructor TGMxGradientArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AColor1, AColor2: COLORREF; const AVisible, ARefLifeTime: Boolean); begin inherited Create(AParent, APosition, AAreaAlign, cDfltColor, AVisible, ARefLifeTime); FGradientFiller := TGMAreaGradientFiller.Create(GMSplitDirectionFromAlign(AAreaAlign.EdgeAlign, FLayoutSpace), [AColor1, AColor2]); end; function TGMxGradientArea.AreaFiller: IGMAreaFiller; begin Result := FGradientFiller; end; { ----------------------------- } { ---- TGMxCheckBoxImgArea ---- } { ----------------------------- } constructor TGMxCheckBoxImgArea.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); CornerRounding := vGMSmallBtnRounding; end; constructor TGMxCheckBoxImgArea.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); GMFindParentObj(AParent, TGMxCheckBoxArea, FCheckBoxArea); end; function TGMxCheckBoxImgArea.InternalCalcHeight(const NewSize: TPoint): LongInt; begin Result := cDfltChkBoxSize; end; function TGMxCheckBoxImgArea.InternalCalcWidth(const NewSize: TPoint): LongInt; begin Result := cDfltChkBoxSize; end; //function TGMxCheckBoxImgArea.CreateAreaRegion(const ABoundingRect: TRect; const ARegionKind: TGMAreaRegionKind): IGMGetHandle; ////var RgnCorner: IGMGetHandle; //begin // with ABoundingRect do // begin // RgnCorner := TGMGdiRegion.CreateRect(0, GMRect(Left, Top, Left+1, Top+1)); // if CombineRgn(Result.Handle, Result.Handle, RgnCorner.Handle, RGN_DIFF) in [ERROR, NULLREGION] then Exit; // // RgnCorner := TGMGdiRegion.CreateRect(0, GMRect(Right-1, Top, Right, Top+1)); // if CombineRgn(Result.Handle, Result.Handle, RgnCorner.Handle, RGN_DIFF) in [ERROR, NULLREGION] then Exit; // // RgnCorner := TGMGdiRegion.CreateRect(0, GMRect(Right-1, Bottom-1, Right, Bottom)); // if CombineRgn(Result.Handle, Result.Handle, RgnCorner.Handle, RGN_DIFF) in [ERROR, NULLREGION] then Exit; // // RgnCorner := TGMGdiRegion.CreateRect(0, GMRect(Left, Bottom-1, Left+1, Bottom)); // if CombineRgn(Result.Handle, Result.Handle, RgnCorner.Handle, RGN_DIFF) in [ERROR, NULLREGION] then Exit; // end; //end; function TGMxCheckBoxImgArea.PaintArea(const ADC: HDC; const ARect: TRect): Boolean; const c3 = 3; var Pen, Brush: IGMGetHandle; x, y, y2, l: LongInt; Color: COLORREF; procedure DrawOuterRect(const ARect: TRect; const Brush: HBrush); begin with ARect do begin MoveToEx(ADC, Left+1, Top, nil); LineTo(ADC, Right-1, Top); MoveToEx(ADC, Right-1, Top+1, nil); LineTo(ADC, Right-1, Bottom-1); MoveToEx(ADC, Right-2, Bottom-1, nil); LineTo(ADC, Left, Bottom-1); MoveToEx(ADC, Left, Bottom-2, nil); LineTo(ADC, Left, Top); end; end; begin Result := inherited PaintArea(ADC, ARect); if (FCheckBoxArea <> nil) and not FCheckBoxArea.Enabled then DrawOuterRect(ARect, GetStockObject(GRAY_BRUSH)) //FrameRect(ADC, ARect, GetStockObject(GRAY_BRUSH)) else DrawOuterRect(ARect, GetStockObject(BLACK_BRUSH)); //FrameRect(ADC, ARect, GetStockObject(BLACK_BRUSH)); if FCheckBoxArea = nil then Color := clSilver else if FCheckBoxArea.MouseInside then Color := GMFrameColorFromBkgndColor(BkgndColor) else//clDfltHoverFrameColor else // clrColdBlue; // ; // clrOrange; if not FCheckBoxArea.Enabled or not FCheckBoxArea.Checked then Color := clSilver else Color := clDkGray; Brush := TGMGdiBrush.Create(0, Color); // clSilver FrameRect(ADC, GMInflateRect(ARect, -1, -1), Brush.Handle); // GetStockObject(GRAY_BRUSH) if FCheckBoxArea = nil then Brush := TGMGdiBrush.Create(0, clWhite) else if FCheckBoxArea.FMouseDown then Brush := TGMGdiBrush.Create(0, clSilver) else if not FCheckBoxArea.Checked then Brush := TGMGdiBrush.Create(0, clWhite) else if FCheckBoxArea.MouseInside then Brush := TGMGdiBrush.Create(0, clrDkOrange) else Brush := TGMGdiBrush.Create(0, clTeal); if (FCheckBoxArea = nil) or not FCheckBoxArea.Checked then FillRect(ADC, GMInflateRect(ARect, -2, -2), Brush.Handle) // GetStockObject(WHITE_BRUSH) else begin //if (FCheckBoxArea = nil) or not FCheckBoxArea.MouseInside then RColor := clTeal else RColor := clrDkOrange; // clrOrange; clDfltHoverFrameColor; //Brush := TGMGdiBrush.Create(0, RColor); // clTeal Pen := TGMGdiPen.Create(ADC, clWhite); FillRect(ADC, GMInflateRect(ARect, -2, -2), Brush.Handle); l := ((GMRectSize(ARect).x - 6) div 3); y2 := l; if l < 0 then Exit; for x := ARect.Left+3 to ARect.Right-4 do begin y := ARect.Bottom-3-y2-c3; MoveToEx(ADC, x, y, nil); LineTo(ADC, x, y+c3); if x - ARect.Left - 3 < l then Dec(y2) else Inc(Y2); end; end; end; { -------------------------- } { ---- TGMxCheckBoxArea ---- } { -------------------------- } constructor TGMxCheckBoxArea.Create(const ARefLifeTime: Boolean); begin inherited Create(ARefLifeTime); CornerRounding := vGMDfltCornerRounding; FPaddSpace := GMPoint(0, 1); end; constructor TGMxCheckBoxArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText: TGMString; const AOnClick: TGMObjNotifyProc; const ABkgndColor: COLORREF; const AVisible: Boolean; const 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(TGMxCheckBoxImgArea.Create(Self, GMRect(1, 1, 14, 14), cTopLeftX, clrTransparent)), cChkBoxMessages); FTextLabel := OwnArea(TGMxTextLabel.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); end; procedure TGMxCheckBoxArea.SetChecked(const Value: Boolean); begin if Value = FChecked then Exit; FChecked := Value; ScheduleRepaint; end; function TGMxCheckBoxArea.ExecuteOperation(const Operation: Integer; const Parameter: IUnknown): Boolean; begin case Operation of Ord(goDisable): begin SetEnabled(False); Result := True; end; Ord(goEnable): begin SetEnabled(True); Result := True; end; //Ord(opClear): begin Checked := False; Result := True; end; else Result := inherited ExecuteOperation(Operation, Parameter); end; end; function TGMxCheckBoxArea.BkgndColor: COLORREF; begin if not MouseInside then Result := inherited BkgndColor else Result := clrGlassBlue; end; function TGMxCheckBoxArea.AreaFiller: IGMAreaFiller; begin if not MouseInside then Result := inherited AreaFiller else Result := GMToolBtnFiller; end; function TGMxCheckBoxArea.PaintArea(const ADC: HDC; const ARect: TRect): Boolean; begin Result := inherited PaintArea(ADC, ARect); if MouseInside then GMDrawRoundFrame(ADC, ARect, GMFrameColorFromBkgndColor(BkgndColor), CLR_INVALID); // clDfltHoverFrameColor end; procedure TGMxCheckBoxArea.WMMouseEnter(var Msg: TWMMouse); begin inherited; ScheduleRepaint; end; procedure TGMxCheckBoxArea.WMMouseLeave(var Msg: TWMMouse); begin FBkgndBrush := nil; inherited; ScheduleRepaint; end; procedure TGMxCheckBoxArea.Click; begin FChecked := not FChecked; if Assigned(FOnClick) then FOnClick(Self); //SendMessage(GetFocus, WM_CANCELMODE, 0, 0); GMCancelPopup; end; procedure TGMxCheckBoxArea.Clear(const ANotify: Boolean); begin inherited Clear(ANotify); Checked := False; end; function TGMxCheckBoxArea.GetEnabled: Boolean; begin Result := not FDisabled; end; procedure TGMxCheckBoxArea.SetEnabled(const AEnabled: Boolean); stdcall; begin if AEnabled = not FDisabled then Exit; FDisabled := not AEnabled; if FTextLabel <> nil then FTextLabel.SetEnabled(AEnabled); ScheduleRepaint; end; procedure TGMxCheckBoxArea.WMLButtonDown(var Msg: TWMMouse); begin inherited; if not Enabled then Exit; FMouseDown := True; ScheduleRepaint; GMCaptureMouseInput(Self); end; procedure TGMxCheckBoxArea.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; { -------------------------- } { ---- TGMxIconOnResBmp ---- } { -------------------------- } constructor TGMxIconOnResBmp.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AIcon: HICON; const ADestroyIcon: Boolean; const AResModule: THandle; const ABmpResName: PGMChar; const AIconSize: TIconSize; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); var Area: TObject; begin inherited Create(AParent, APosition, AAreaAlign, [], ABkgndColor, haCenter, vaCenter, True, ARefLifeTime); Area := OwnArea(TGMxResBmpArea.Create(Self, cNullRect, cClientAligned, AResModule, ABmpResName, [iaStretched], ABkgndColor)); OwnArea(TGMxIconArea.Create(Area, cNullRect, cLeftAligned, AIcon, ADestroyIcon, [iaTransparent], AIconSize, clrTransparent)); end; constructor TGMxIconOnResBmp.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const ASeverity: TGMSeverityLevel; const AResModule: THandle; const ABmpResName: PGMChar; const AIconSize: TIconSize; const ABkgndColor: COLORREF; const ARefLifeTime: Boolean); begin Create(AParent, APosition, AAreaAlign, LoadIcon(0, vGMSevrityIcons[ASeverity]), False, AResModule, ABmpResName, AIconSize, ABkgndColor, ARefLifeTime); end; { ------------------------- } { ---- TGMxMessageArea ---- } { ------------------------- } constructor TGMxMessageArea.Create(const AParent: TObject; const APosition: TRect; const AAreaAlign: TGMAreaAlignRec; const AText, ATitle: TGMString; const AAttributes: TGMMessageAreaAttributes; const AIcon: TGMSeverityLevel; const ABkgndColor: COLORREF; const AVisible, ARefLifeTime: Boolean); var TopArea: TObject; begin inherited Create(AParent, APosition, AAreaAlign, ABkgndColor, AVisible, ARefLifeTime); //FRounded := maaRounded in AAttributes; TopArea := OwnArea(TGMSurroundingUiArea.Create(Self, cNullRect, cTopAligned, cNullPoint, ABkgndColor)); if (AIcon <> svNone) and (ATitle <> '') then OwnArea(TGMxSeverityIconArea.Create(TopArea, GMRect(c2CtlSpace, c2CtlSpace, GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON)), cTopLeftX, AIcon, cDfltIconAttributes, izSmall, ABkgndColor)); if maaClosable in AAttributes then OwnArea(TGMxCloseBtnArea.Create(TopArea, GMRect(-15, c2CtlSpace, cCtlSpace, 14), cTopRightX, OnCloseBtnClick)); if ATitle <> '' then OwnArea(TGMxTextLabel.Create(TopArea, GMRect(c2CtlSpace, c2CtlSpace, cCtlSpace, 0), cTopAligned, cNullRect, ATitle, ABkgndColor, GMBoldUIFont)); OwnArea(TGMxTextLabel.Create(Self, GMRect(c2CtlSpace, cCtlSpace, cCtlSpace, 0), cTopAligned, cNullRect, GMTerminateStr(AText), ABkgndColor)); FPaddSpace.y := c2CtlSpace; //CornerRounding := vGMDfltCornerRounding; //FFRame := TGMAreaSimpleFrame.Create(Self, 1); //FFrame := TGMAreaRegionFrame.Create(1, 1); end; {function TGMxMessageArea.CreateAreaRegion(const ABoundingRect: TRect; const ARegionKind: TGMAreaRegionKind): IGMGetHandle; begin if not FRounded then Result := inherited CreateAreaRegion(ABoundingRect, ARegionKind) else Result := TGMGdiRegion.CreateRoundRect(0, ABoundingRect, GMPoint(4, 4)); end;} {function TGMxMessageArea.FrameColor: COLORREF; begin Result := clDkGray; // clNavy; end;} function TGMxMessageArea.InternalCalcHeight(const NewSize: TPoint): LongInt; begin if FShrinkDelta <= 0 then Result := inherited InternalCalcHeight(NewSize) else Result := GMRectSize(LayoutBounds).y-FShrinkDelta; end; procedure TGMxMessageArea.OnCloseBtnClick(const Sender: TObject); var i: LongInt; Wnd: HWnd; begin if GMFindAllocatedParentHandle(Self, Wnd) then try FShrinkDelta := GMRectSize(LayoutBounds).y div vGMShrinkAnimationCount; for i:=1 to GMRectSize(LayoutBounds).y div FShrinkDelta do begin GMReLayoutContainedAreas(Parent, True); UpdateWindow(Wnd); end; finally FShrinkDelta := 0; end; SetVisible(False, True); end; end.