Archivado/Componentes.Terceros.SpTBXLib
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
f130fe4cb1
Componentes.Terceros.SpTBXLib/internal/2.4.4/1/Source/SpTBXEditors.pas
david 03dfd8c7c1 Importación inicial 
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.SpTBXLib@4 aa3591e4-a9f2-482a-ba07-9d38a056ee4e
2010-01-19 16:32:53 +00:00

3770 lines
121 KiB
ObjectPascal
Raw Blame History

unit SpTBXEditors;
{==============================================================================
Version 2.4.4
The contents of this file are subject to the SpTBXLib License; you may
not use or distribute this file except in compliance with the
SpTBXLib License.
A copy of the SpTBXLib License may be found in SpTBXLib-LICENSE.txt or at:
http://www.silverpointdevelopment.com/sptbxlib/SpTBXLib-LICENSE.htm
Alternatively, the contents of this file may be used under the terms of the
Mozilla Public License Version 1.1 (the "MPL v1.1"), in which case the provisions
of the MPL v1.1 are applicable instead of those in the SpTBXLib License.
A copy of the MPL v1.1 may be found in MPL-LICENSE.txt or at:
http://www.mozilla.org/MPL/
If you wish to allow use of your version of this file only under the terms of
the MPL v1.1 and not to allow others to use your version of this file under the
SpTBXLib License, indicate your decision by deleting the provisions
above and replace them with the notice and other provisions required by the
MPL v1.1. If you do not delete the provisions above, a recipient may use your
version of this file under either the SpTBXLib License or the MPL v1.1.
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The initial developer of this code is Robert Lee.
Requirements:
For Delphi/C++Builder 2009 or newer:
- Jordan Russell's Toolbar 2000
http://www.jrsoftware.org
For Delphi/C++Builder 7-2007:
- Jordan Russell's Toolbar 2000
http://www.jrsoftware.org
- Troy Wolbrink's TNT Unicode Controls
http://www.tntware.com/delphicontrols/unicode/
Development notes:
- All the Windows and Delphi bugs fixes are marked with '[Bugfix]'.
- All the theme changes and adjustments are marked with '[Theme-Change]'.
To Do:
- Rotated caption painting.
Known Issues:
-
History:
2 December 2009 - version 2.4.4
- Fixed flicker on TSpTBXComboBox when changing the font,
thanks to Simon H. for reporting this.
13 September 2009 - version 2.4.3
- Fixed incorrect TSpTBXComboBox painting, when the Style
is set to csDropDownList and the control is disabled the
text is not painted with csGrayText. This is a VCL bug
the same happens with TComboBox when you set it to
csDropDownFixed (TSpTBXComboBox uses csDropDownFixed
instead of csDropDownList).
Thanks to Arvid for reporting this.
- Fixed incorrect TSpTBXSpinEdit behavior, when the focus
was changed the text wasn't validated, thanks to Stephan
for reporting this.
- Fixed incorrect caret positioning on TSpTBXSpinEdit when
using a Postfix, thanks to Eric Rappsilber for reporting
this.
8 May 2009 - version 2.4.2
- Added AutoDropDownWidth property to TSpTBXComboBox, use
this to automatically calculate the DropDown window
size.
- Changed params of OnDrawItem and OnDrawItemBackground events
from TSpTBXComboBox.
15 March 2009 - version 2.4.1
- Added HasEditButton public method to TSpTBXEdit.
- Added GetDropDownButtonRect public method to TSpTBXComboBox.
- Fixed TSpTBXEdit frame flicker, thanks to Marc Hoffmann for
reporting this.
- Fixed incorrect TSpTBXEdit frame painting when the edit was
placed on a Toolbar, thanks to Alfred Vink for reporting this.
- Fixed incorrect TSpTBXListBox painting when OnDrawItem event
was used, thanks to Evgeny Efimov for reporting this.
17 January 2009 - version 2.4
- Added AutoItemHeight property to TSpTBXComboBox, use this
to automatically calculate the ItemHeight property when the
Style is csDropDown, csDropDownList or csSimple.
26 September 2008 - version 2.3
- Added skinning support to TSpTBXComboBox items.
- Fixed incorrect TSpTBXEditItem OnChange event handling,
the event was only fired if the text property was changed,
thanks to Anta for reporting this.
- Added hack to automatically adjust the ItemHeight based on
the ComboBox font size. Delphi doesn't do this when the
ComboBox is owner drawed.
29 July 2008 - version 2.2
- Fixed incorrect TSpTBXEditItem size when the item is on
a menu, thanks to David for reporting it.
26 June 2008 - version 2.1
- Added EditImageIndex property to TSpTBXEditItem and
TSpTBXSpinEditItem, use this to show an icon image
on the left of the EditCaption when the item is on a menu.
3 May 2008 - version 2.0
- No changes.
2 April 2008 - version 1.9.5
- Added ExtendedAccept property to TSpTBXSpinEditor.
- Fixed incorrect TSpTBXSpinEditor.ValueInc/ValueDec behavior
when ValueSnap was true and Increment was a fraction, thanks
to John for reporting this.
3 Febrary 2008 - version 1.9.4
- Fixed incorrect TSpTBXSpinEditor.ValueInc/ValueDec behavior
when ValueSnap was true and Increment was higher than
10000, thanks to Yucel for reporting this.
19 January 2008 - version 1.9.3
- Fixed incorrect TSpTBXComboBox painting on Windows Vista,
thanks to Santiago Vila for reporting this.
26 December 2007 - version 1.9.2
- Fixed incorrect TSpTBXSpinEdit font behavior, when the font
was changed at runtime the edit rect was not updated, thanks
to Beta Xiong for reporting this.
1 December 2007 - version 1.9.1
- Fixed incorrect TSpTBXEditButton painting, when the caption
was empty and DropDownMenu was assigned 2 arrows were painted
instead of 1, thanks to Costas Stergiou for reporting this.
20 November 2007 - version 1.9
- Removed TBX dependency.
20 April 2007 - version 1.8.4
- Added CustomWidth and CustomHeight properties to the toolbar
editor items.
- Fixed incorrect TSpTBXEditItem.StartEditing behavior,
thanks to Daniel Rikowski for reporting this.
8 February 2007 - version 1.8.3
- Fixed incorrect OnChange event handling in TSpTBXEditItem,
thanks to Daniel Rikowski for reporting this.
17 December 2006 - version 1.8.2
- Fixed a BDS 2006 bug related to Comboboxes, CM_MOUSEENTER and
CM_MOUSELEAVE are fired everytime the mouse is moved over the
internal edit control. In D7 these messages were only fired when
the mouse entered or leaved the combobox.
24 November 2006 - version 1.8.1
- Fixed incorrect TSpTBXSpinEdit behavior, the Value was not updated
when the control was unfocused, thanks to Steve and Sebastian for
reporting this.
27 August 2006 - version 1.8
- Improved editor's button painting.
15 June 2006 - version 1.7
- Fixed edit items incorrect painting, the items were not painted
using the color of FontSettings and EditorFontSettings properties,
the same happens with the TBX items.
4 May 2006 - version 1.6
- No changes.
12 April 2006 - version 1.5
- Added ValueType, ValueAsInteger, Decimals, Prefix and Postfix
properties to TSpTBXSpinEdit, thanks to Maxim Rylov for his
code donation.
- Fixed TSpTBXSpinEdit painting.
27 February 2006 - version 1.4
- New component added, TSpTBXSpinEdit: a SpinEdit control
that has TBX themes support.
- Fixed TSpTBXComboBoxItem bug, when AutoComplete is set to
false the ComboBox still autocompletes the text, thanks to
Erwin Denissen for reporting this.
- Fixed Delphi 2005/2006 bug, CM_MOUSEENTER and CM_MOUSELEAVE
are fired everytime the mouse enters the combobox internal
edit control. In prior versions of Delphi these messages
were only fired when the mouse entered or leaved the combobox,
including the internal edit control.
10 February 2006 - version 1.3
- New component added, TSpTBXButtonEdit: an Edit control that
has a multipurpose button attached.
- Added new public method, AddEditButton, to TSpTBXEdit.
28 December 2005 - version 1.2
- No changes.
18 October 2005 - version 1.1
- New component added, TSpTBXListBox: a ListBox
with Unicode and TBX themes support that paints
a hottrack border and TBX theme style selection.
- New component added, TSpTBXCheckListBox: a CheckListBox
with Unicode and TBX themes support that paints
a hottrack border and TBX theme style selection.
- Fixed TSpTBXComboBoxItem dynamic creation problem.
18 August 2005 - version 1.0
- No changes.
10 June 2005 - version 0.9
- SpTBXLib may now alternatively, at your option, be used and/or
distributed under the terms of the SpTBXLib License.
Please see the updated LICENSE.TXT file for more information.
20 May 2005 - version 0.8
- Fixed TSpTBXDropDownItem and TSpTBXComboBoxItem bugs, the popup list
should be closed when F4 is pressed, thanks to Rune Moberg for
reporting this.
- Fixed TSpTBXComboBoxItem bug, the ComboBox didn't check the ItemIndex
bounds when pressing Up or Down keys, thanks to Rune Moberg for
reporting this.
- Fixed AV when trying to dock a toolbar with a TSpTBXComboBoxItem
on a vertical dock, thanks to Pavel for reporting this.
16 February 2005 - version 0.7
- Fixed unicode support in W9x, thanks to Daniel Rikowski for
reporting this.
- Fixed editors bug, the editors autocomplete was case sensitive,
this is a TBX bug but it was fixed without patching the source,
thanks to Daniel Rikowski for reporting this.
- Fixed TSpTBXComboBox painting bug, the edit frame was not
correctly highlighted when using the Default theme.
- Added HotTrack property to TSpTBXEdit and TSpTBXComboBox, when
setted to true a TBX style frame will be painted when the mouse
is over the control.
- Added OnDrawBackground event to TSpTBXEdit and TSpTBXComboBox.
23 December 2004 - version 0.6
- Initial release.
==============================================================================}
interface
{$BOOLEVAL OFF} // Unit depends on short-circuit boolean evaluation
uses
Windows, Messages, Classes, SysUtils, Controls, Graphics, ImgList, Forms,
Menus, StdCtrls, ExtCtrls, ActnList, CheckLst,
{$IFNDEF UNICODE}
TntClasses, TntControls, TntStdCtrls, TntCheckLst, TntSysUtils,
{$ENDIF}
TB2Toolbar, TB2Item, TB2ExtItems,
SpTBXSkins, SpTBXItem, SpTBXControls;
{$IFDEF UNICODE}
type
TTntComboBox = TComboBox;
TTntListBox = TListBox;
TTntCheckListBox = TCheckListBox;
{$ENDIF}
const
CM_SPFONTCHANGED = CM_BASE + 2221; // Message sent to the control when the font is changed
{ Change reasons for EditItem.Text property }
tcrSetProperty = 0; // direct assignment to Text property
tcrActionLink = 1; // change comes from an action link
tcrEditControl = 2; // change is caused by typing in edit area
type
TSpTBXSpinType = (
spnInteger,
spnFloat,
spnHex
);
TSpTBXEditItemViewer = class;
TSpTBXSpinEditViewer = class;
TSpTBXEditChangeEvent = procedure(Sender: TObject; const AText: WideString) of object;
TSpTBXEditAcceptTextEvent = procedure(Sender: TObject; var NewText: WideString; var Accept: Boolean) of object;
TSpTBXEditGetTextEvent = procedure(Sender: TObject; var AText: WideString) of object;
TSpTBXBeginEditEvent = procedure(Sender: TObject; Viewer: TSpTBXEditItemViewer; EditControl: TCustomEdit) of object;
TSpTBXEditMessageEvent = procedure(Sender: TObject; Viewer: TSpTBXEditItemViewer; var Message: TMessage; var Handled: Boolean) of object;
TSpTBXDrawListItemEvent = procedure(Sender: TObject; ACanvas: TCanvas; var ARect: TRect; Index: Integer; const State: TOwnerDrawState;
const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean) of object;
{ TSpTBXEditButton }
TSpTBXEditButton = class(TSpTBXSpeedButton)
protected
procedure AdjustFont(AFont: TFont); override;
function DoDrawDropDownArrow(ACanvas: TCanvas; ARect: TRect): Boolean; override;
function DoDrawItem(ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage): Boolean; override;
function GetFrameHotTrack: Boolean;
public
constructor Create(AOwner: TComponent); override;
procedure Click; override;
end;
{ TSpTBXSpinButton }
TSpTBXSpinButton = class(TSpTBXEditButton)
private
FUpPushed: Boolean;
FDownPushed: Boolean;
FOnUpClick: TNotifyEvent;
FOnDownClick: TNotifyEvent;
protected
function DoDrawItem(ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage): Boolean; override;
procedure DoMouseLeave; override;
procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
property OnUpClick: TNotifyEvent read FOnUpClick write FOnUpClick;
property OnDownClick: TNotifyEvent read FOnDownClick write FOnDownClick;
public
constructor Create(AOwner: TComponent); override;
procedure Click; override;
procedure IsHotTracking(out UpButton, DownButton, EditFrame: Boolean);
published
property Repeating default True;
end;
{ TSpTBXUnicodeAdaptEdit }
// Do not inherit from TTNTEdit, TBEditItemViewer.GetEditControlClass needs a TEditClass
{$IFNDEF UNICODE}
TSpTBXUnicodeAdaptEdit = class(TEdit)
private
FPasswordChar: WideChar;
procedure SetSelText(const Value: WideString);
function GetText: WideString;
procedure SetText(const Value: WideString);
function GetHint: WideString;
procedure SetHint(const Value: WideString);
function IsHintStored: Boolean;
function GetPasswordChar: WideChar;
procedure SetPasswordChar(const Value: WideChar);
protected
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure CreateWnd; override;
procedure DefineProperties(Filer: TFiler); override;
function GetActionLinkClass: TControlActionLinkClass; override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
function GetSelStart: Integer; reintroduce; virtual;
procedure SetSelStart(const Value: Integer); reintroduce; virtual;
function GetSelLength: Integer; reintroduce; virtual;
procedure SetSelLength(const Value: Integer); reintroduce; virtual;
function GetSelText: WideString; reintroduce; virtual;
public
property SelText: WideString read GetSelText write SetSelText;
property SelStart: Integer read GetSelStart write SetSelStart;
property SelLength: Integer read GetSelLength write SetSelLength;
published
// Don't let the streaming system store the WideStrings, use DefineProperties instead
property Text: WideString read GetText write SetText;
property Hint: WideString read GetHint write SetHint stored IsHintStored;
property PasswordChar: WideChar read GetPasswordChar write SetPasswordChar default #0;
end;
{$ELSE}
TSpTBXUnicodeAdaptEdit = class(TEdit);
{$ENDIF}
{ TSpTBXUnicodeEdit }
TSpTBXUnicodeEdit = class(TSpTBXUnicodeAdaptEdit)
private
FAlignment: TAlignment;
procedure SetAlignment(Value: TAlignment);
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
protected
procedure CreateWnd; override;
procedure CreateParams(var Params: TCreateParams); override;
procedure UpdateEditRect; virtual;
public
function AddEditButton(RightAligned: Boolean = True; AWidth: Integer = -1): TSpTBXEditButton;
function HasEditButton: Boolean;
published
property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
end;
{ TSpTBXEdit }
TSpTBXEdit = class(TSpTBXUnicodeEdit)
private
FBorderStyle: TBorderStyle;
FHotTrack: Boolean;
FSkinType: TSpTBXSkinType;
FMouseInControl: Boolean;
procedure SetBorderStyle(const Value: TBorderStyle);
procedure SetSkinType(const Value: TSpTBXSkinType);
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
procedure WMSpSkinChange(var Message: TMessage); message WM_SPSKINCHANGE;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure InvalidateFrame;
property MouseInControl: Boolean read FMouseInControl;
published
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; // Hides the inherited BorderStyle
property HotTrack: Boolean read FHotTrack write FHotTrack default True;
property SkinType: TSpTBXSkinType read FSkinType write SetSkinType default sknSkin;
end;
{ TSpTBXButtonEdit }
TSpTBXCustomButtonEdit = class(TSpTBXEdit)
private
FEditButton: TSpTBXEditButton;
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetName(const Value: TComponentName); override;
property EditButton: TSpTBXEditButton read FEditButton;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
TSpTBXButtonEdit = class(TSpTBXCustomButtonEdit)
published
property EditButton;
end;
{ TSpTBXSpinEdit }
TSpTBXSpinEditOptions = class(TPersistent)
private
FDecimal: Integer;
FIncrement: Extended;
FMinValue: Extended;
FMaxValue: Extended;
FValue: Extended;
FValueSnap: Boolean;
FValueType: TSpTBXSpinType;
FPrefix: WideString;
FPostfix: WideString;
FOnGetText: TSpTBXEditAcceptTextEvent;
FOnSetText: TSpTBXEditChangeEvent;
FOnValueChanged: TNotifyEvent;
function IsIncrementStored: Boolean;
function IsMaxValueStored: Boolean;
function IsMinValueStored: Boolean;
function IsValueStored: Boolean;
procedure SetDecimal(NewDecimal: Integer);
procedure SetMaxValue(const NewValue: Extended);
procedure SetMinValue(const NewValue: Extended);
procedure SetValue(const NewValue: Extended);
procedure SetValueType(NewType: TSpTBXSpinType);
procedure SetPostfix(const ValueString: WideString);
procedure SetPrefix(const ValueString: WideString);
function GetValueAsInteger: Int64;
procedure SetValueAsInteger(const NewValue: Int64);
protected
procedure DoValueChanged; virtual;
procedure UpdateTextFromValue;
procedure UpdateValueFromText(RevertWhenInvalid: Boolean = True);
property OnGetText: TSpTBXEditAcceptTextEvent read FOnGetText write FOnGetText;
property OnSetText: TSpTBXEditChangeEvent read FOnSetText write FOnSetText;
property OnValueChanged: TNotifyEvent read FOnValueChanged write FOnValueChanged;
public
constructor Create; virtual;
procedure ValueInc;
procedure ValueDec;
property ValueAsInteger: Int64 read GetValueAsInteger write SetValueAsInteger;
published
property Decimal: Integer read FDecimal write SetDecimal default 2;
property Increment: Extended read FIncrement write FIncrement stored IsIncrementStored;
property MaxValue: Extended read FMaxValue write SetMaxValue stored IsMaxValueStored;
property MinValue: Extended read FMinValue write SetMinValue stored IsMinValueStored;
property Postfix: WideString read FPostfix write SetPostfix;
property Prefix: WideString read FPrefix write SetPrefix;
property Value: Extended read FValue write SetValue stored IsValueStored;
property ValueSnap: Boolean read FValueSnap write FValueSnap default True;
property ValueType: TSpTBXSpinType read FValueType write SetValueType default spnInteger;
end;
TSpTBXSpinEdit = class(TSpTBXEdit)
private
FExtendedAccept: Boolean;
FSpinButton: TSpTBXSpinButton;
FSpinOptions: TSpTBXSpinEditOptions;
procedure SpinOptionsGetText(Sender: TObject; var NewText: WideString; var Accept: Boolean);
procedure SpinOptionsSetText(Sender: TObject; const AText: WideString);
function GetValue: Extended;
function GetValueChanged: TNotifyEvent;
procedure SetValue(const Value: Extended);
procedure SetValueChanged(const ValueChangedEvent: TNotifyEvent);
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
protected
procedure Change; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure UpClick(Sender: TObject); virtual;
procedure DownClick(Sender: TObject); virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Alignment default taRightJustify;
property ExtendedAccept: Boolean read FExtendedAccept write FExtendedAccept default False;
property Text stored False;
property SpinButton: TSpTBXSpinButton read FSpinButton;
property SpinOptions: TSpTBXSpinEditOptions read FSpinOptions write FSpinOptions;
property Value: Extended read GetValue write SetValue stored False;
property OnValueChanged: TNotifyEvent read GetValueChanged write SetValueChanged;
end;
{ TSpTBXComboBox }
TSpTBXComboBox = class(TTntComboBox)
private
FAutoDropDownWidth: Boolean;
FAutoItemHeight: Boolean;
FFontChanging: Boolean;
FHotTrack: Boolean;
FInternalItemHeight: Integer;
FMouseInControl: Boolean;
FMouseInDropDownButton: Boolean;
FMouseTimer: TTimer;
FSkinType: TSpTBXSkinType;
FOnDrawBackground: TSpTBXDrawEvent;
FOnDrawItem: TSpTBXDrawListItemEvent;
FOnDrawItemBackground: TSpTBXDrawListItemEvent;
procedure MouseTimerHandler(Sender: TObject);
procedure SetSkinType(const Value: TSpTBXSkinType);
procedure UpdateDropDownButton;
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMSPFontChanged(var Message: TMessage); message CM_SPFONTCHANGED;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
procedure WMSpSkinChange(var Message: TMessage); message WM_SPSKINCHANGE;
protected
FAutoDropDownWidthRightMargin: Integer;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure CloseUp; override;
procedure DoCalcMaxDropDownWidth; virtual;
procedure DoDrawBackground(ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual;
procedure DoDrawItem(ACanvas: TCanvas; var ARect: TRect; Index: Integer; const State: TOwnerDrawState;
const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual;
procedure DoDrawItemBackground(ACanvas: TCanvas; var ARect: TRect; Index: Integer; const State: TOwnerDrawState;
const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
procedure DrawItemBackground(Index: Integer; Rect: TRect; State: TOwnerDrawState); virtual;
{$IF CompilerVersion > 17}
procedure EditWndProc(var Message: TMessage); override;
{$IFEND}
function GetItemHt: Integer; override;
procedure SetItemHeight(Value: Integer); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetDropDownButtonRect: TRect;
function GetMouseInDropDownButton: Boolean;
procedure InvalidateFrame;
property MouseInControl: Boolean read FMouseInControl;
published
property AutoDropDownWidth: Boolean read FAutoDropDownWidth write FAutoDropDownWidth default False;
property AutoItemHeight: Boolean read FAutoItemHeight write FAutoItemHeight default True;
property HotTrack: Boolean read FHotTrack write FHotTrack default True;
property SkinType: TSpTBXSkinType read FSkinType write SetSkinType default sknSkin;
property OnDrawBackground: TSpTBXDrawEvent read FOnDrawBackground write FOnDrawBackground;
property OnDrawItem: TSpTBXDrawListItemEvent read FOnDrawItem write FOnDrawItem; // Hides the inherited OnDrawItem
property OnDrawItemBackground: TSpTBXDrawListItemEvent read FOnDrawItemBackground write FOnDrawItemBackground;
property OnMouseMove;
end;
{ TSpTBXListBox }
TSpTBXListBox = class(TTntListBox)
private
FHotTracking: Boolean;
FHotTrack: Boolean;
FSkinType: TSpTBXSkinType;
FChildFocused: Boolean;
FOnDrawItem: TSpTBXDrawListItemEvent;
FOnDrawItemBackground: TSpTBXDrawListItemEvent;
procedure SetHotTrack(const Value: Boolean);
procedure SetSkinType(const Value: TSpTBXSkinType);
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
procedure WMSpSkinChange(var Message: TMessage); message WM_SPSKINCHANGE;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure DoDrawItem(ACanvas: TCanvas; var ARect: TRect; Index: Integer; const State: TOwnerDrawState;
const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual;
procedure DoDrawItemBackground(ACanvas: TCanvas; var ARect: TRect; Index: Integer; const State: TOwnerDrawState;
const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
procedure DrawItemBackground(Index: Integer; Rect: TRect; State: TOwnerDrawState); virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure InvalidateBorders;
property HotTracking: Boolean read FHotTracking;
published
property Style default lbOwnerDrawFixed;
property HotTrack: Boolean read FHotTrack write SetHotTrack default True;
property SkinType: TSpTBXSkinType read FSkinType write SetSkinType default sknSkin;
property OnDrawItem: TSpTBXDrawListItemEvent read FOnDrawItem write FOnDrawItem; // Hides the inherited OnDrawItem
property OnDrawItemBackground: TSpTBXDrawListItemEvent read FOnDrawItemBackground write FOnDrawItemBackground;
end;
{ TSpTBXCheckListBox }
TSpTBXCheckListBox = class(TTntCheckListBox)
private
FHotTracking: Boolean;
FHotTrack: Boolean;
FSkinType: TSpTBXSkinType;
FChildFocused: Boolean;
FOnDrawItem: TSpTBXDrawListItemEvent;
FOnDrawItemBackground: TSpTBXDrawListItemEvent;
procedure SetHotTrack(const Value: Boolean);
procedure SetSkinType(const Value: TSpTBXSkinType);
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
procedure WMSpSkinChange(var Message: TMessage); message WM_SPSKINCHANGE;
protected
procedure DoDrawItem(ACanvas: TCanvas; var ARect: TRect; Index: Integer; const State: TOwnerDrawState;
const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual;
procedure DoDrawItemBackground(ACanvas: TCanvas; var ARect: TRect; Index: Integer; const State: TOwnerDrawState;
const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
procedure DrawItemBackground(Index: Integer; Rect: TRect; State: TOwnerDrawState); virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure InvalidateBorders;
property HotTracking: Boolean read FHotTracking;
published
property Style default lbOwnerDrawFixed;
property HotTrack: Boolean read FHotTrack write SetHotTrack default True;
property SkinType: TSpTBXSkinType read FSkinType write SetSkinType default sknSkin;
property OnDrawItem: TSpTBXDrawListItemEvent read FOnDrawItem write FOnDrawItem;
property OnDrawItemBackground: TSpTBXDrawListItemEvent read FOnDrawItemBackground write FOnDrawItemBackground;
end;
{ TSpTBXEditItem }
TSpTBXEditItem = class(TSpTBXCustomItem)
private
FEditCaption: WideString;
FEditImageIndex: TImageIndex;
FText: WideString;
FAllowVerticalEditor: Boolean;
FCharCase: TEditCharCase;
FEditorFontSettings: TSpTBXFontSettings;
FExtendedAccept: Boolean;
FFontSettings: TSpTBXFontSettings;
FMaxLength: Integer;
FPasswordChar: WideChar;
FReadOnly: Boolean;
FShowImage: Boolean;
FOnAcceptText: TSpTBXEditAcceptTextEvent;
FOnBeginEdit: TSpTBXBeginEditEvent;
FOnChange: TSpTBXEditChangeEvent;
FOnEditMessage: TSpTBXEditMessageEvent;
procedure FontSettingsChanged(Sender: TObject);
procedure SetAllowVerticalEditor(const Value: Boolean);
procedure SetCharCase(Value: TEditCharCase);
procedure SetEditCaption(const Value: WideString);
procedure SetEditorFontSettings(const Value: TSpTBXFontSettings);
procedure SetMaxLength(Value: Integer);
procedure SetPasswordChar(Value: WideChar);
procedure SetShowImage(const Value: Boolean);
procedure SetText(Value: WideString);
protected
function DoAcceptText(var NewText: WideString): Boolean; virtual;
function DoAutoComplete(var AText: WideString): Boolean; virtual;
procedure DoBeginEdit(Viewer: TSpTBXEditItemViewer); virtual;
procedure DoChange(const AText: WideString); virtual;
procedure DoTextChanging(const OldText: WideString; var NewText: WideString; Reason: Integer); virtual;
function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override;
function NeedToRecreateViewer(AViewer: TTBItemViewer): Boolean; override;
procedure SetTextEx(Value: WideString; Reason: Integer); virtual;
public
function StartEditing(AView: TTBView): Boolean;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
// TSpTBXCustomItem properties
property Action;
property Alignment default taLeftJustify;
property Caption;
property CustomWidth default 64;
property CustomHeight;
property DisplayMode;
property Enabled;
property FontSettings;
property GroupIndex;
property HelpContext;
property Hint;
property ImageIndex;
property Images;
property ShortCut;
property Visible;
property OnClick;
property OnDrawCaption;
property OnDrawHint;
property OnDrawImage;
property OnDrawItem;
property OnSelect;
// Don't let the streaming system store the WideStrings, use DefineProperties instead
property EditCaption: WideString read FEditCaption write SetEditCaption; // Hides the inherited EditCaption
property EditImageIndex: TImageIndex read FEditImageIndex write FEditImageIndex default -1;
property Text: WideString read FText write SetText; // Hides the inherited Text
property AllowVerticalEditor: Boolean read FAllowVerticalEditor write SetAllowVerticalEditor default False;
property CharCase: TEditCharCase read FCharCase write SetCharCase default ecNormal;
property EditorFontSettings: TSpTBXFontSettings read FEditorFontSettings write SetEditorFontSettings;
property ExtendedAccept: Boolean read FExtendedAccept write FExtendedAccept default False;
property MaxLength: Integer read FMaxLength write SetMaxLength default 0;
property PasswordChar: WideChar read FPasswordChar write SetPasswordChar default #0;
property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
property ShowImage: Boolean read FShowImage write SetShowImage default False;
property OnAcceptText: TSpTBXEditAcceptTextEvent read FOnAcceptText write FOnAcceptText; // Hides the inherited OnAcceptText
property OnBeginEdit: TSpTBXBeginEditEvent read FOnBeginEdit write FOnBeginEdit;
property OnChange: TSpTBXEditChangeEvent read FOnChange write FOnChange;
property OnEditMessage: TSpTBXEditMessageEvent read FOnEditMessage write FOnEditMessage;
end;
TEditClass = class of TCustomEdit;
TSpTBXEditItemViewer = class(TSpTBXItemViewer)
private
function EditLoop(const CapHandle: HWND): Boolean;
procedure EditWndProc(var Message: TMessage);
function GetEditControlText: WideString;
procedure GetEditHeight(const DC: HDC; out EditHeight, ExternalLeading: Integer);
function GetItem: TSpTBXEditItem;
procedure MouseBeginEdit;
function MeasureEditCaption: TSize;
function MeasureTextHeight: Integer;
protected
FEditControl: TCustomEdit;
FEditControlStatus: set of (ecsContinueLoop, ecsAccept, ecsClose);
procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); override;
function CaptionShown: Boolean; override;
procedure DoBeginEdit; virtual;
function DoExecute: Boolean; override;
function HandleEditMessage(var Message: TMessage): Boolean; virtual;
function GetAccRole: Integer; override;
function GetAccValue(var Value: WideString): Boolean; override;
procedure GetCursor(const Pt: TPoint; var ACursor: HCURSOR); override;
function GetEditControlClass: TEditClass; virtual;
procedure GetEditRect(var R: TRect); virtual;
function GetImageShown: Boolean; override;
function GetIndentBefore: Integer; virtual;
function GetIndentAfter: Integer; virtual;
procedure InternalDrawFrame(ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo); virtual;
procedure InternalEditControlChange(Sender: TObject); virtual;
procedure InternalEditControlExit; virtual;
procedure MouseDown(Shift: TShiftState; X, Y: Integer; var MouseDownOnMenu: Boolean); override;
procedure MouseUp(X, Y: Integer; MouseWasDownOnMenu: Boolean); override;
procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean); override;
function ShowImage: Boolean; virtual;
function UsesSameWidth: Boolean; override;
public
function GetCaptionText: WideString; override;
property EditControl: TCustomEdit read FEditControl;
property Item: TSpTBXEditItem read GetItem; // Hides the inherited TB2K Item property
end;
{ TSpTBXSpinEditItem }
TSpTBXSpinEditItem = class(TSpTBXEditItem)
private
FSpinOptions: TSpTBXSpinEditOptions;
procedure SpinOptionsGetText(Sender: TObject; var NewText: WideString; var Accept: Boolean);
procedure SpinOptionsSetText(Sender: TObject; const AText: WideString);
function GetValue: Extended;
function GetValueChanged: TNotifyEvent;
procedure SetValue(const Value: Extended);
procedure SetValueChanged(const ValueChangedEvent: TNotifyEvent);
protected
function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Alignment default taRightJustify;
property Text stored False;
property SpinOptions: TSpTBXSpinEditOptions read FSpinOptions write FSpinOptions;
property Value: Extended read GetValue write SetValue stored False;
property OnValueChanged: TNotifyEvent read GetValueChanged write SetValueChanged;
end;
TSpTBXSpinEditViewer = class(TSpTBXEditItemViewer)
private
FUpPushed: Boolean;
FDownPushed: Boolean;
FTimer: TTimer;
procedure TimerHandler(Sender: TObject);
function GetItem: TSpTBXSpinEditItem;
protected
function GetAccRole: Integer; override;
function GetIndentAfter: Integer; override;
function HandleEditMessage(var Message: TMessage): Boolean; override;
procedure InvalidateButtons;
function IsPtInButtonPart(X, Y: Integer): Boolean; override;
procedure LosingCapture; override;
procedure MouseDown(Shift: TShiftState; X, Y: Integer; var MouseDownOnMenu: Boolean); override;
procedure MouseUp(X, Y: Integer; MouseWasDownOnMenu: Boolean); override;
procedure InternalDrawFrame(ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo); override;
procedure InternalEditControlChange(Sender: TObject); override;
procedure InternalEditControlExit; override;
public
destructor Destroy; override;
property Item: TSpTBXSpinEditItem read GetItem; // Hides the inherited TB2K Item property
end;
{ Helpers }
procedure SpCalcMaxDropDownWidth(Combo: TSpTBXComboBox; RightMargin: Integer = 8);
function SpFocusEditItem(Item: TTBCustomItem; View: TTBView): Boolean;
function SpStartsTextW(const ASubText, AText: WideString): Boolean;
{ Painting helpers }
function SpCanEditFrameBeHotTracked(BorderStyle: TBorderStyle; SkinType: TSpTBXSkinType): Boolean;
procedure SpDrawXPEditButton(ACanvas: TCanvas; ARect: TRect; Enabled, FrameHotTrack, HotTrack, Pushed, RightAligned: Boolean);
procedure SpDrawXPComboButton(ACanvas: TCanvas; ARect: TRect; Enabled, FrameHotTrack, HotTrack, DroppedDown, RightAligned: Boolean; SkinType: TSpTBXSkinType);
procedure SpDrawXPSpinButton(ACanvas: TCanvas; ARect: TRect; Enabled, FrameHotTrack, UpHotTrack, DownHotTrack, UpPushed, DownPushed, RightAligned: Boolean; SkinType: TSpTBXSkinType);
implementation
uses
Themes, UxTheme,
{$IFNDEF UNICODE} TntActnList, TntWindows, {$ENDIF}
Math, TB2Common;
const
DefaultSpinButtonSize = 14;
type
TTBViewAccess = class(TTBView);
TSpTBXFontSettingsAccess = class(TSpTBXFontSettings);
TCustomEditAccess = class(TCustomEdit);
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ Helpers }
procedure SpCalcMaxDropDownWidth(Combo: TSpTBXComboBox; RightMargin: Integer = 8);
var
I, MaxWidth: Integer;
Sz: TSize;
C: TControlCanvas;
begin
MaxWidth := 0;
C := TControlCanvas.Create;
try
C.Control := Combo;
C.Font.Assign(Combo.Font);
for I := 0 to Combo.Items.Count - 1 do begin
Sz := SpGetTextSize(C.Handle, Combo.Items[I], False);
if Sz.cx > MaxWidth then MaxWidth := Sz.cx;
end;
MaxWidth := MaxWidth + GetSystemMetrics(SM_CXVSCROLL) + RightMargin;
if Combo.Width < MaxWidth then
SendMessage(Combo.Handle, CB_SETDROPPEDWIDTH, MaxWidth, 0);
finally
C.Free;
end;
end;
function SpFocusEditItem(Item: TTBCustomItem; View: TTBView): Boolean;
var
IV: TTBItemViewer;
begin
Result := False;
IV := View.Find(Item);
if Assigned(IV) then begin
View.Select(IV, False);
View.ExecuteSelected(False);
Result := True;
end;
end;
function SpStartsTextW(const ASubText, AText: WideString): Boolean;
var
L, L2: Integer;
begin
L := Length(ASubText);
L2 := Length(AText);
if L > L2 then Result := False
else Result := CompareStringW(LOCALE_USER_DEFAULT, NORM_IGNORECASE,
PWideChar(AText), L, PWideChar(ASubText), L) = 2;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ Painting helpers }
function SpCanEditFrameBeHotTracked(BorderStyle: TBorderStyle; SkinType: TSpTBXSkinType): Boolean;
var
NormalB, HotTrackB: TSpTBXSkinOptionEntry;
begin
Result := False;
if (BorderStyle <> bsNone) and (SpTBXSkinType(SkinType) <> sknNone) then begin
// If the HotTrack borders are different than the Normal borders then
// return true.
NormalB := CurrentSkin.Options(skncEditFrame, sknsNormal).Borders;
HotTrackB := CurrentSkin.Options(skncEditFrame, sknsHotTrack).Borders;
if not NormalB.IsEqual(HotTrackB) then
Result := True;
end;
end;
procedure SpDrawXPEditButton(ACanvas: TCanvas; ARect: TRect; Enabled, FrameHotTrack,
HotTrack, Pushed, RightAligned: Boolean);
var
State: TSpTBXSkinStatesType;
begin
State := CurrentSkin.GetState(Enabled, Pushed, HotTrack or FrameHotTrack, False);
if FrameHotTrack then begin
InflateRect(ARect, 1, 1);
if RightAligned then
ARect.Left := ARect.Left + 1
else
ARect.Right := ARect.Right - 1;
end;
CurrentSkin.PaintBackground(ACanvas, ARect, skncEditButton, State, True, True);
end;
procedure SpDrawXPComboButton(ACanvas: TCanvas; ARect: TRect; Enabled, FrameHotTrack,
HotTrack, DroppedDown, RightAligned: Boolean; SkinType: TSpTBXSkinType);
var
Flags: Integer;
State: TSpTBXSkinStatesType;
C: TColor;
X, Y, Part: Integer;
begin
case SpTBXSkinType(SkinType) of
sknNone:
begin
Inc(ARect.Left, 4);
SpFillRect(ACanvas, ARect, clBtnFace, clWindow);
if DroppedDown then
Windows.DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENOUTER, BF_RECT)
else if FrameHotTrack or HotTrack then
Windows.DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDINNER, BF_RECT);
State := CurrentSkin.GetState(Enabled, DroppedDown, HotTrack, False);
C := CurrentSkin.GetTextColor(skncEditButton, State);
X := (ARect.Left + ARect.Right) div 2;
Y := (ARect.Top + ARect.Bottom) div 2 - 1;
SpDrawArrow(ACanvas, X, Y, C, True, False, 2);
end;
sknWindows:
begin
if SpIsWinVistaOrUp then
Part := 6 // (CP_DROPDOWNBUTTONRIGHT) Use the new API on Windows Vista
else
Part := CP_DROPDOWNBUTTON;
if not Enabled then Flags := CBXS_DISABLED
else if DroppedDown then Flags := CBXS_PRESSED
else if HotTrack then Flags := CBXS_HOT
else Flags := CBXS_NORMAL;
DrawThemeBackground(ThemeServices.Theme[teComboBox], ACanvas.Handle, Part, Flags, ARect, nil);
end;
sknSkin:
begin
State := CurrentSkin.GetState(Enabled, DroppedDown, FrameHotTrack, False);
ACanvas.FillRect(ARect);
SpDrawXPEditButton(ACanvas, ARect, Enabled, FrameHotTrack, HotTrack, DroppedDown, RightAligned);
C := CurrentSkin.GetTextColor(skncEditButton, State);
X := (ARect.Left + ARect.Right) div 2;
Y := (ARect.Top + ARect.Bottom) div 2 - 1;
SpDrawArrow(ACanvas, X, Y, C, True, False, 2);
end;
end;
end;
procedure SpDrawXPSpinButton(ACanvas: TCanvas; ARect: TRect; Enabled, FrameHotTrack,
UpHotTrack, DownHotTrack, UpPushed, DownPushed, RightAligned: Boolean; SkinType: TSpTBXSkinType);
var
ButtonR, BR: TRect;
StateFlags: Integer;
Flags: Cardinal;
X, Y: Integer;
State: TSpTBXSkinStatesType;
C: TColor;
begin
ButtonR := ARect;
case SpTBXSkinType(SkinType) of
sknNone:
begin
// Up button
Flags := DFCS_SCROLLUP;
if UpPushed then
Flags := Flags or DFCS_PUSHED;
BR := Rect(ButtonR.Left, ButtonR.Top, ButtonR.Right, (ButtonR.Bottom + ButtonR.Top) div 2);
DrawFrameControl(ACanvas.Handle, BR, DFC_SCROLL, Flags);
// Down button
Flags := DFCS_SCROLLDOWN;
if DownPushed then
Flags := Flags or DFCS_PUSHED;
BR := Rect(ButtonR.Left, BR.Bottom - 1, ButtonR.Right, ButtonR.Bottom);
DrawFrameControl(ACanvas.Handle, BR, DFC_SCROLL, Flags);
end;
sknWindows:
begin
InflateRect(ButtonR, 1, 1);
// Up button
BR := ButtonR;
BR.Bottom := (ButtonR.Top + ButtonR.Bottom) div 2;
if not Enabled then StateFlags := UPS_DISABLED
else if UpPushed then StateFlags := UPS_PRESSED
else if UpHotTrack then StateFlags := UPS_HOT
else StateFlags := UPS_NORMAL;
DrawThemeBackground(ThemeServices.Theme[teSpin], ACanvas.Handle, SPNP_UP, StateFlags, BR, nil);
// Down button
BR := ButtonR;
BR.Top := (ButtonR.Top + ButtonR.Bottom) div 2;
if not Enabled then StateFlags := DNS_DISABLED
else if DownPushed then StateFlags := DNS_PRESSED
else if DownHotTrack then StateFlags := DNS_HOT
else StateFlags := DNS_NORMAL;
DrawThemeBackground(ThemeServices.Theme[teSpin], ACanvas.Handle, SPNP_DOWN, StateFlags, BR, nil);
end;
sknSkin:
begin
// Up button
BR := Rect(ButtonR.Left, ButtonR.Top, ButtonR.Right, (ButtonR.Top + ButtonR.Bottom) div 2 + 1);
X := (BR.Left + BR.Right) div 2;
Y := (BR.Top + BR.Bottom) div 2 - 1;
State := CurrentSkin.GetState(Enabled, UpPushed, UpHotTrack or FrameHotTrack, False);
if FrameHotTrack then
BR.Bottom := BR.Bottom - 1;
SpDrawXPEditButton(ACanvas, BR, Enabled, FrameHotTrack, UpHotTrack, UpPushed, RightAligned);
C := CurrentSkin.GetTextColor(skncEditButton, State);
SpDrawArrow(ACanvas, X, Y, C, True, True, 2);
if FrameHotTrack then
BR.Bottom := BR.Bottom + 1;
// Down button
BR := Rect(ButtonR.Left, BR.Bottom - 1, ButtonR.Right, ButtonR.Bottom);
X := (BR.Left + BR.Right) div 2;
Y := (BR.Top + BR.Bottom) div 2 - 1;
State := CurrentSkin.GetState(Enabled, DownPushed, DownHotTrack or FrameHotTrack, False);
if FrameHotTrack then
BR.Top := BR.Top + 1;
SpDrawXPEditButton(ACanvas, BR, Enabled, FrameHotTrack, DownHotTrack, DownPushed, RightAligned);
C := CurrentSkin.GetTextColor(skncEditButton, State);
SpDrawArrow(ACanvas, X, Y, C, True, False, 2);
end;
end;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXEditButton }
constructor TSpTBXEditButton.Create(AOwner: TComponent);
var
Index: Integer;
const
DefaultName = 'SubEditButton';
begin
inherited;
// Find unique name
if Assigned(AOwner) then begin
Index := 0;
while AOwner.FindComponent(DefaultName + IntToStr(Index)) <> nil do
Inc(Index);
Name := DefaultName + IntToStr(Index);
end;
// Change the FPopupControl, we need to align
// the DropdownMenu to the Edit control not the button.
// FPopupControl is used in TSpTBXCustomButton.Click
if Assigned(AOwner) and (AOwner is TControl) then
FPopupControl := AOwner as TControl;
SetSubComponent(True);
SkinType := sknSkin;
end;
procedure TSpTBXEditButton.AdjustFont(AFont: TFont);
var
State: TSpTBXSkinStatesType;
begin
if (LinkText <> '') and MouseInControl then
inherited
else begin
State := CurrentSkin.GetState(Enabled, Pushed, MouseInControl or GetFrameHotTrack, Checked);
AFont.Color := CurrentSkin.GetTextColor(skncEditButton, State);
end;
end;
procedure TSpTBXEditButton.Click;
begin
if Assigned(Parent) and SpCanFocus(Parent) then
Parent.SetFocus;
inherited;
end;
function TSpTBXEditButton.DoDrawDropDownArrow(ACanvas: TCanvas;
ARect: TRect): Boolean;
begin
if (Caption = '') and not IsImageIndexValid then
Result := False // Paint the default Windows combo button
else
Result := inherited DoDrawDropDownArrow(ACanvas, ARect);
end;
function TSpTBXEditButton.DoDrawItem(ACanvas: TCanvas; ARect: TRect;
const PaintStage: TSpTBXPaintStage): Boolean;
var
T: TSpTBXSkinType;
FrameHotTrack, RightAligned: Boolean;
begin
if (PaintStage = pstPrePaint) and not BitmapValid then begin
Result := True;
if Assigned(OnDraw) then OnDraw(Self, ACanvas, ARect, PaintStage, Result);
if Result then begin
FrameHotTrack := GetFrameHotTrack;
RightAligned := Align <> alLeft;
// Draw the ComboButton if the caption is not set
T := SpTBXSkinType(SkinType);
if (Length(Caption) = 0) and not IsImageIndexValid then
SpDrawXPComboButton(ACanvas, ARect, Enabled, FrameHotTrack, MouseInControl, Pushed, RightAligned, T)
else begin
case T of
sknNone:
SpDrawXPButton(ACanvas, ARect, Enabled, Pushed, MouseInControl, Checked, Focused, Default, T);
sknWindows:
begin
InflateRect(ARect, 1, 1);
SpDrawXPButton(ACanvas, ARect, Enabled, Pushed, MouseInControl, Checked, Focused, Default, T);
end;
sknSkin:
SpDrawXPEditButton(ACanvas, ARect, Enabled, FrameHotTrack, FrameHotTrack or MouseInControl, Pushed, RightAligned);
end;
end;
end;
end
else
Result := inherited DoDrawItem(ACanvas, ARect, PaintStage);
end;
function TSpTBXEditButton.GetFrameHotTrack: Boolean;
begin
if Parent is TSpTBXEdit then
Result := TSpTBXEdit(Parent).MouseInControl or Parent.Focused
else
Result := False;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXSpinButton }
constructor TSpTBXSpinButton.Create(AOwner: TComponent);
begin
inherited;
Repeating := True;
end;
procedure TSpTBXSpinButton.Click;
var
P: TPoint;
begin
FUpPushed := False;
FDownPushed := False;
if Enabled then begin
GetCursorPos(P);
P := ScreenToClient(P);
if P.Y < Height div 2 then begin
FUpPushed := True;
if Assigned(FOnUpClick) then FOnUpClick(Self);
end
else begin
FDownPushed := True;
if Assigned(FOnDownClick) then FOnDownClick(Self);
end;
end;
inherited;
end;
function TSpTBXSpinButton.DoDrawItem(ACanvas: TCanvas; ARect: TRect;
const PaintStage: TSpTBXPaintStage): Boolean;
var
UpHotTrack, DownHotTrack, EditFrameHotTrack, RightAligned: Boolean;
begin
// Draw rectangle buttons
if (PaintStage = pstPrePaint) and not BitmapValid then begin
Result := True;
if Assigned(OnDraw) then OnDraw(Self, ACanvas, ARect, PaintStage, Result);
if Result then begin
IsHotTracking(UpHotTrack, DownHotTrack, EditFrameHotTrack);
RightAligned := Align <> alLeft;
SpDrawXPSpinButton(ACanvas, ARect, Enabled, EditFrameHotTrack, UpHotTrack, DownHotTrack, FUpPushed, FDownPushed, RightAligned, SkinType);
end;
end
else
Result := inherited DoDrawItem(ACanvas, ARect, PaintStage);
end;
procedure TSpTBXSpinButton.IsHotTracking(out UpButton, DownButton, EditFrame: Boolean);
var
Edit: TSpTBXEdit;
P: TPoint;
R: TRect;
begin
UpButton := False;
DownButton := False;
EditFrame := False;
if GetCursorPos(P) then begin
P := ScreenToClient(P);
R := Rect(0, 0, Width, Height div 2);
UpButton := PtInRect(R, P);
if not UpButton then begin
R := Rect(0, Height div 2, Width, Height);
DownButton := PtInRect(R, P);
end;
end;
if Assigned(Owner) and (Owner is TSpTBXEdit) then begin
Edit := Owner as TSpTBXEdit;
if Edit.HotTrack then
EditFrame := Edit.MouseInControl or Edit.Focused;
end;
end;
procedure TSpTBXSpinButton.DoMouseLeave;
begin
FUpPushed := False;
FDownPushed := False;
inherited;
end;
procedure TSpTBXSpinButton.MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FUpPushed := False;
FDownPushed := False;
inherited;
end;
procedure TSpTBXSpinButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if Enabled then
Repaint;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXUnicodeAdaptEdit }
{$IFNDEF UNICODE}
procedure TSpTBXUnicodeAdaptEdit.CreateWindowHandle(const Params: TCreateParams);
begin
TntCustomEdit_CreateWindowHandle(Self, Params);
end;
procedure TSpTBXUnicodeAdaptEdit.CreateWnd;
begin
inherited;
TntCustomEdit_AfterInherited_CreateWnd(Self, FPasswordChar);
end;
procedure TSpTBXUnicodeAdaptEdit.DefineProperties(Filer: TFiler);
begin
inherited;
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
function TSpTBXUnicodeAdaptEdit.GetSelStart: Integer;
begin
Result := TntCustomEdit_GetSelStart(Self);
end;
procedure TSpTBXUnicodeAdaptEdit.SetSelStart(const Value: Integer);
begin
TntCustomEdit_SetSelStart(Self, Value);
end;
function TSpTBXUnicodeAdaptEdit.GetSelLength: Integer;
begin
Result := TntCustomEdit_GetSelLength(Self);
end;
procedure TSpTBXUnicodeAdaptEdit.SetSelLength(const Value: Integer);
begin
TntCustomEdit_SetSelLength(Self, Value);
end;
function TSpTBXUnicodeAdaptEdit.GetSelText: WideString;
begin
Result := TntCustomEdit_GetSelText(Self);
end;
procedure TSpTBXUnicodeAdaptEdit.SetSelText(const Value: WideString);
begin
TntCustomEdit_SetSelText(Self, Value);
end;
function TSpTBXUnicodeAdaptEdit.GetPasswordChar: WideChar;
begin
Result := TntCustomEdit_GetPasswordChar(Self, FPasswordChar);
end;
procedure TSpTBXUnicodeAdaptEdit.SetPasswordChar(const Value: WideChar);
begin
TntCustomEdit_SetPasswordChar(Self, FPasswordChar, Value);
end;
function TSpTBXUnicodeAdaptEdit.GetText: WideString;
begin
Result := TntControl_GetText(Self);
end;
procedure TSpTBXUnicodeAdaptEdit.SetText(const Value: WideString);
begin
TntControl_SetText(Self, Value);
end;
function TSpTBXUnicodeAdaptEdit.IsHintStored: Boolean;
begin
Result := TntControl_IsHintStored(Self);
end;
function TSpTBXUnicodeAdaptEdit.GetHint: WideString;
begin
Result := TntControl_GetHint(Self);
end;
procedure TSpTBXUnicodeAdaptEdit.SetHint(const Value: WideString);
begin
TntControl_SetHint(Self, Value);
end;
procedure TSpTBXUnicodeAdaptEdit.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
inherited;
end;
function TSpTBXUnicodeAdaptEdit.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;
{$ENDIF}
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXUnicodeEdit }
procedure TSpTBXUnicodeEdit.CreateWnd;
begin
inherited;
if HandleAllocated then UpdateEditRect;
end;
procedure TSpTBXUnicodeEdit.CreateParams(var Params: TCreateParams);
const
Alignments: array[TAlignment] of Cardinal = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
inherited CreateParams(Params);
// WS_CLIPCHILDREN needed for edit buttons
Params.Style := Params.Style or Alignments[FAlignment] or WS_CLIPCHILDREN;
end;
procedure TSpTBXUnicodeEdit.SetAlignment(Value: TAlignment);
begin
if Value <> FAlignment then begin
FAlignment := Value;
RecreateWnd;
end;
end;
function TSpTBXUnicodeEdit.AddEditButton(RightAligned: Boolean;
AWidth: Integer): TSpTBXEditButton;
begin
Result := TSpTBXEditButton.Create(Self);
Result.Parent := Self;
Result.FreeNotification(Self);
if RightAligned then
Result.Align := alRight
else
Result.Align := alLeft;
if AWidth = -1 then
Result.Width := GetSystemMetrics(SM_CXVSCROLL)
else
Result.Width := AWidth;
UpdateEditRect;
end;
function TSpTBXUnicodeEdit.HasEditButton: Boolean;
var
I: Integer;
begin
Result := False;
if not HandleAllocated then Exit;
for I := 0 to ControlCount - 1 do begin
if Controls[I] is TSpTBXEditButton then begin
Result := True;
Break;
end;
end;
end;
procedure TSpTBXUnicodeEdit.UpdateEditRect;
var
I, X1, X2: Integer;
B: TSpTBXEditButton;
begin
if not HandleAllocated then Exit;
X1 := 0;
X2 := 0;
for I := 0 to ControlCount - 1 do begin
if Controls[I] is TSpTBXEditButton then begin
B := Controls[I] as TSpTBXEditButton;
if B.Visible then
case B.Align of
alLeft: X1 := X1 + B.Width;
alRight: X2 := X2 + B.Width;
end;
end;
end;
if X1 > 0 then Inc(X1, 2);
if X2 > 0 then Inc(X2, 2);
SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, MakeLong(X1, X2));
end;
procedure TSpTBXUnicodeEdit.CMEnabledChanged(var Message: TMessage);
var
I: Integer;
begin
inherited;
for I := 0 to ControlCount - 1 do
if Controls[I] is TSpTBXEditButton then
TSpTBXEditButton(Controls[I]).Enabled := Enabled;
end;
procedure TSpTBXUnicodeEdit.CMFontChanged(var Message: TMessage);
begin
inherited;
UpdateEditRect;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXEdit }
constructor TSpTBXEdit.Create(AOwner: TComponent);
begin
inherited;
FSkinType := sknSkin;
FHotTrack := True;
FBorderStyle := bsSingle;
SkinManager.AddSkinNotification(Self);
if not (csDesigning in ComponentState) then
DoubleBuffered := True;
end;
destructor TSpTBXEdit.Destroy;
begin
SkinManager.RemoveSkinNotification(Self);
inherited;
end;
procedure TSpTBXEdit.CMEnabledChanged(var Message: TMessage);
begin
inherited;
FMouseInControl := False;
if FHotTrack then InvalidateFrame;
end;
procedure TSpTBXEdit.CMEnter(var Message: TCMEnter);
begin
inherited;
FMouseInControl := True;
if FHotTrack then InvalidateFrame;
end;
procedure TSpTBXEdit.CMExit(var Message: TCMExit);
begin
inherited;
FMouseInControl := False;
if FHotTrack then InvalidateFrame;
end;
procedure TSpTBXEdit.CMMouseEnter(var Message: TMessage);
begin
inherited;
if not FMouseInControl then begin
FMouseInControl := True;
if FHotTrack and not Focused and (HasEditButton or SpCanEditFrameBeHotTracked(BorderStyle, SkinType)) then
InvalidateFrame;
end;
end;
procedure TSpTBXEdit.CMMouseLeave(var Message: TMessage);
begin
inherited;
if FMouseInControl then begin
FMouseInControl := False;
if FHotTrack and not Focused and (HasEditButton or SpCanEditFrameBeHotTracked(BorderStyle, SkinType)) then
InvalidateFrame;
end;
end;
procedure TSpTBXEdit.InvalidateFrame;
begin
if HandleAllocated then
RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN);
end;
procedure TSpTBXEdit.SetBorderStyle(const Value: TBorderStyle);
begin
if FBorderStyle <> Value then begin
FBorderStyle := Value;
InvalidateFrame;
end;
end;
procedure TSpTBXEdit.SetSkinType(const Value: TSpTBXSkinType);
var
I: Integer;
begin
if Value <> FSkinType then begin
FSkinType := Value;
for I := 0 to ControlCount - 1 do
if Controls[I] is TSpTBXEditButton then
TSpTBXEditButton(Controls[I]).SkinType := Value;
InvalidateFrame;
end;
end;
procedure TSpTBXEdit.WMNCPaint(var Message: TWMNCPaint);
var
HotTrackFrame: Boolean;
begin
if FHotTrack then
HotTrackFrame := FMouseInControl or Focused
else
HotTrackFrame := False;
if (SpTBXSkinType(FSkinType) = sknNone) and (FBorderStyle <> bsNone) then
inherited
else
if Ctl3D then
SpDrawXPEditFrame(Self, HotTrackFrame, FSkinType, False, FBorderStyle = bsNone);
end;
procedure TSpTBXEdit.WMSpSkinChange(var Message: TMessage);
begin
inherited;
InvalidateFrame;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXCustomButtonEdit }
constructor TSpTBXCustomButtonEdit.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle - [csSetCaption];
FEditButton := AddEditButton(True, 19);
end;
destructor TSpTBXCustomButtonEdit.Destroy;
begin
FreeAndNil(FEditButton);
inherited;
end;
procedure TSpTBXCustomButtonEdit.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (AComponent = FEditButton) and (Operation = opRemove) then
FEditButton := nil;
end;
procedure TSpTBXCustomButtonEdit.SetName(const Value: TComponentName);
begin
inherited SetName(Value);
if not (csLoading in ComponentState) then begin
FEditButton.Caption := '...';
Text := '';
end;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXSpinEditOptions }
constructor TSpTBXSpinEditOptions.Create;
begin
inherited Create;
FDecimal := 2;
FIncrement := 1;
FValueSnap := True;
FValueType := spnInteger;
end;
procedure TSpTBXSpinEditOptions.DoValueChanged;
begin
if Assigned(FOnValueChanged) then FOnValueChanged(Self);
end;
function TSpTBXSpinEditOptions.GetValueAsInteger: Int64;
begin
Result := Round(Value);
end;
function TSpTBXSpinEditOptions.IsIncrementStored: Boolean;
begin
Result := FIncrement <> 1;
end;
function TSpTBXSpinEditOptions.IsMaxValueStored: Boolean;
begin
Result := FMaxValue <> 0;
end;
function TSpTBXSpinEditOptions.IsMinValueStored: Boolean;
begin
Result := FMinValue <> 0;
end;
function TSpTBXSpinEditOptions.IsValueStored: Boolean;
begin
Result := FValue <> 0;
end;
procedure TSpTBXSpinEditOptions.SetDecimal(NewDecimal: Integer);
begin
if NewDecimal > 10 then NewDecimal := 10;
if NewDecimal < 0 then NewDecimal := 0;
if NewDecimal <> FDecimal then begin
FDecimal := NewDecimal;
UpdateTextFromValue;
end;
end;
procedure TSpTBXSpinEditOptions.SetMaxValue(const NewValue: Extended);
begin
if NewValue <> FMaxValue then begin
FMaxValue := NewValue;
if FValue > NewValue then SetValue(NewValue);
end;
end;
procedure TSpTBXSpinEditOptions.SetMinValue(const NewValue: Extended);
begin
if NewValue <> FMinValue then begin
FMinValue := NewValue;
if FValue < NewValue then SetValue(NewValue);
end;
end;
procedure TSpTBXSpinEditOptions.SetPostfix(const ValueString: WideString);
begin
if FPostfix <> ValueString then begin
FPostfix := ValueString;
UpdateTextFromValue;
end;
end;
procedure TSpTBXSpinEditOptions.SetPrefix(const ValueString: WideString);
begin
if FPrefix <> ValueString then begin
FPrefix := ValueString;
UpdateTextFromValue;
end;
end;
procedure TSpTBXSpinEditOptions.SetValue(const NewValue: Extended);
begin
if NewValue <> FValue then
if (FMaxValue = FMinValue) or
(FMaxValue <> FMinValue) and (NewValue >= FMinValue) and (NewValue <= FMaxValue) then
begin
FValue := NewValue;
DoValueChanged;
UpdateTextFromValue;
end;
end;
procedure TSpTBXSpinEditOptions.SetValueAsInteger(const NewValue: Int64);
begin
Value := NewValue;
end;
procedure TSpTBXSpinEditOptions.SetValueType(NewType: TSpTBXSpinType);
begin
if NewType <> FValueType then begin
FValueType := NewType;
if NewType in [spnInteger, spnHex] then FIncrement := Max(Round(FIncrement), 1);
UpdateTextFromValue;
end;
end;
procedure TSpTBXSpinEditOptions.UpdateTextFromValue;
var
WS: WideString;
begin
WS := '';
case FValueType of
spnInteger: WS := IntToStr(Round(FValue));
spnFloat: WS := FloatToStrF(FValue, ffFixed, 15, FDecimal);
spnHex: WS := IntToHex(Round(FValue), 1);
end;
if Assigned(FOnSetText) then FOnSetText(Self, FPrefix + WS + FPostfix);
end;
procedure TSpTBXSpinEditOptions.UpdateValueFromText(RevertWhenInvalid: Boolean = True);
var
WS: WideString;
PrevValue, NewValue: Extended;
I: Integer;
Dummy: Boolean;
begin
PrevValue := FValue;
NewValue := FValue;
Dummy := True;
WS := '';
if Assigned(FOnGetText) then FOnGetText(Self, WS, Dummy);
// Remove the Prefix and Postfix from the text
I := Pos(Prefix, WS);
if I > 0 then
Delete(WS, I, Length(Prefix));
I := Pos(Postfix, WS);
if I > 0 then
Delete(WS, I, Length(Postfix));
// Try to parse the text to get the value
WS := Trim(WS);
if Length(WS) > 0 then begin
case FValueType of
spnInteger: NewValue := StrToInt64Def(WS, Round(PrevValue));
spnFloat: NewValue := StrToFloatDef(WS, PrevValue);
spnHex: NewValue := StrToInt64Def('$' + WS, Round(PrevValue));
end;
end;
if RevertWhenInvalid or (NewValue <> PrevValue) then begin
SetValue(NewValue);
UpdateTextFromValue;
end;
end;
procedure TSpTBXSpinEditOptions.ValueInc;
var
NewValue: Extended;
begin
if FValueSnap then
NewValue := Math.Floor(FValue / FIncrement + 1 + FIncrement * 0.0000000001) * FIncrement
else
NewValue := FValue + FIncrement;
SetValue(NewValue);
end;
procedure TSpTBXSpinEditOptions.ValueDec;
var
NewValue: Extended;
begin
if FValueSnap then
NewValue := Math.Ceil(FValue / FIncrement - 1 - FIncrement * 0.0000000001) * FIncrement
else
NewValue := FValue - FIncrement;
SetValue(NewValue);
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXSpinEdit }
constructor TSpTBXSpinEdit.Create(AOwner: TComponent);
begin
inherited;
Alignment := taRightJustify;
FSpinOptions := TSpTBXSpinEditOptions.Create;
FSpinOptions.OnGetText := SpinOptionsGetText;
FSpinOptions.OnSetText := SpinOptionsSetText;
FSpinButton := TSpTBXSpinButton.Create(Self);
FSpinButton.Parent := Self;
FSpinButton.FreeNotification(Self);
FSpinButton.OnUpClick := UpClick;
FSpinButton.OnDownClick := DownClick;
FSpinButton.Align := alRight;
FSpinButton.Width := DefaultSpinButtonSize;
UpdateEditRect;
Text := '0';
end;
destructor TSpTBXSpinEdit.Destroy;
begin
FreeAndNil(FSpinOptions);
FreeAndNil(FSpinButton);
inherited;
end;
procedure TSpTBXSpinEdit.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (AComponent = FSpinButton) and (Operation = opRemove) then
FSpinButton := nil;
end;
procedure TSpTBXSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited;
case Key of
VK_UP: SpinOptions.ValueInc;
VK_DOWN: SpinOptions.ValueDec;
end;
end;
procedure TSpTBXSpinEdit.KeyPress(var Key: Char);
begin
inherited;
if Key = #13 then begin
Key := #0;
SpinOptions.UpdateValueFromText;
end;
end;
procedure TSpTBXSpinEdit.UpClick(Sender: TObject);
begin
SpinOptions.ValueInc;
end;
procedure TSpTBXSpinEdit.DownClick(Sender: TObject);
begin
SpinOptions.ValueDec;
end;
procedure TSpTBXSpinEdit.Change;
begin
if FExtendedAccept then
SpinOptions.UpdateValueFromText(False); // Don't revert when an invalid text is entered
inherited;
end;
function TSpTBXSpinEdit.GetValue: Extended;
begin
Result := SpinOptions.Value;
end;
procedure TSpTBXSpinEdit.SetValue(const Value: Extended);
begin
SpinOptions.Value := Value;
end;
function TSpTBXSpinEdit.GetValueChanged: TNotifyEvent;
begin
Result := SpinOptions.OnValueChanged;
end;
procedure TSpTBXSpinEdit.SetValueChanged(const ValueChangedEvent: TNotifyEvent);
begin
SpinOptions.OnValueChanged := ValueChangedEvent;
end;
procedure TSpTBXSpinEdit.SpinOptionsGetText(Sender: TObject;
var NewText: WideString; var Accept: Boolean);
begin
// Event used by SpinOptions to get the text from the edit control
NewText := Text;
end;
procedure TSpTBXSpinEdit.SpinOptionsSetText(Sender: TObject;
const AText: WideString);
var
L, L2: Integer;
begin
// Event used by SpinOptions to set the edit control text
if Text = AText then Exit;
// Change the EditControl text and reposition the edit caret
L := Length(Text);
Text := AText;
L2 := Length(Text);
if L2 > L then
SelStart := L + Length(SpinOptions.Prefix);
end;
procedure TSpTBXSpinEdit.WMKillFocus(var Message: TWMKillFocus);
begin
SpinOptions.UpdateValueFromText;
inherited;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXComboBox }
constructor TSpTBXComboBox.Create(AOwner: TComponent);
begin
inherited;
FAutoDropDownWidthRightMargin := 8;
FAutoItemHeight := True;
FMouseTimer := nil;
FHotTrack := True;
FSkinType := sknSkin;
SkinManager.AddSkinNotification(Self);
if not (csDesigning in ComponentState) then
DoubleBuffered := True;
end;
procedure TSpTBXComboBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
// Force the ComboBox to be owner draw
with Params do
if Style and (CBS_OWNERDRAWFIXED or CBS_OWNERDRAWVARIABLE) = 0 then
Style := Style or LBS_OWNERDRAWFIXED;
end;
procedure TSpTBXComboBox.CreateWnd;
begin
inherited;
DoCalcMaxDropDownWidth;
end;
destructor TSpTBXComboBox.Destroy;
begin
SkinManager.RemoveSkinNotification(Self);
if Assigned(FMouseTimer) then begin
FMouseTimer.Enabled := False;
FreeAndNil(FMouseTimer);
end;
inherited;
end;
procedure TSpTBXComboBox.CloseUp;
begin
inherited;
InvalidateFrame;
end;
procedure TSpTBXComboBox.CMEnter(var Message: TCMEnter);
begin
inherited;
FMouseInControl := True;
InvalidateFrame;
end;
procedure TSpTBXComboBox.CMExit(var Message: TCMExit);
begin
inherited;
FMouseInControl := False;
InvalidateFrame;
end;
procedure TSpTBXComboBox.CMMouseEnter(var Message: TMessage);
begin
inherited;
if Message.LParam = 0 then begin
if not FMouseInControl then begin
FMouseInControl := True;
if FHotTrack then
InvalidateFrame;
if not Assigned(FMouseTimer) then begin
FMouseTimer := TTimer.Create(nil);
FMouseTimer.Enabled := False;
FMouseTimer.Interval := 125;
FMouseTimer.OnTimer := MouseTimerHandler;
FMouseTimer.Enabled := True;
end;
end;
end;
end;
procedure TSpTBXComboBox.CNDrawItem(var Message: TWMDrawItem);
var
State: TOwnerDrawState;
SknState: TSpTBXSkinStatesType;
begin
with Message.DrawItemStruct^ do
begin
State := TOwnerDrawState(LongRec(itemState).Lo);
if itemState and ODS_COMBOBOXEDIT <> 0 then
Include(State, odComboBoxEdit);
if itemState and ODS_DEFAULT <> 0 then
Include(State, odDefault);
Canvas.Handle := hDC;
Canvas.Lock;
try
Canvas.Font := Font;
Canvas.Brush := Brush;
if (Integer(itemID) >= 0) and (Integer(itemID) < Items.Count) then begin
DrawItemBackground(itemID, rcItem, State);
TControlCanvas(Canvas).UpdateTextFlags;
SknState := CurrentSkin.GetState(not (odDisabled in State), False, False, odSelected in State);
Canvas.Brush.Style := bsClear;
if SknState = sknsChecked then
Canvas.Font.Color := CurrentSkin.GetTextColor(skncListItem, SknState, SkinType);
DrawItem(itemID, rcItem, State);
end
else
Canvas.FillRect(rcItem);
finally
Canvas.Unlock;
Canvas.Handle := 0;
end;
end;
end;
procedure TSpTBXComboBox.MouseTimerHandler(Sender: TObject);
var
P: TPoint;
R: TRect;
InControl: Boolean;
begin
if not DroppedDown and GetCursorPos(P) then begin
GetWindowRect(Handle, R);
InControl := PtInRect(R, P);
if InControl <> FMouseInControl then begin
FMouseInControl := InControl;
if FHotTrack then InvalidateFrame;
end;
if not InControl then begin
FMouseTimer.Enabled := False;
FreeAndNil(FMouseTimer);
end;
end;
end;
procedure TSpTBXComboBox.DoCalcMaxDropDownWidth;
begin
if FAutoDropDownWidth then
SpCalcMaxDropDownWidth(Self, FAutoDropDownWidthRightMargin);
end;
procedure TSpTBXComboBox.DoDrawBackground(ACanvas: TCanvas; ARect: TRect;
const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean);
begin
if Assigned(FOnDrawBackground) then FOnDrawBackground(Self, ACanvas, ARect,
PaintStage, PaintDefault);
end;
procedure TSpTBXComboBox.DoDrawItem(ACanvas: TCanvas; var ARect: TRect;
Index: Integer; const State: TOwnerDrawState;
const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean);
begin
if Assigned(FOnDrawItem) then FOnDrawItem(Self, ACanvas, ARect, Index, State, PaintStage, PaintDefault);
end;
procedure TSpTBXComboBox.DoDrawItemBackground(ACanvas: TCanvas;
var ARect: TRect; Index: Integer; const State: TOwnerDrawState;
const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean);
begin
if Assigned(FOnDrawItemBackground) then FOnDrawItemBackground(Self, ACanvas, ARect, Index, State, PaintStage, PaintDefault);
end;
procedure TSpTBXComboBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var
Flags: Integer;
PaintDefault: Boolean;
begin
// Draw the item text
PaintDefault := True;
DoDrawItem(Canvas, Rect, Index, State, pstPrePaint, PaintDefault);
if PaintDefault then begin
Flags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
Inc(Rect.Left, 2);
// [Bugfix] Delphi 7-2009 bug:
// When the Style is set to csDropDownList and the control is disabled the
// text is not painted with csGrayText. This is a VCL bug the same happens
// with TComboBox when you set it to csDropDownFixed (TSpTBXComboBox uses
// csDropDownFixed instead of csDropDownList).
if odDisabled in State then
Canvas.Font.Color := clGrayText;
SpDrawXPText(Canvas, Items[Index], Rect, Flags);
end;
PaintDefault := True;
DoDrawItem(Canvas, Rect, Index, State, pstPostPaint, PaintDefault);
end;
procedure TSpTBXComboBox.DrawItemBackground(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var
PaintDefault: Boolean;
begin
// Draw the list items background
PaintDefault := True;
DoDrawItemBackground(Canvas, Rect, Index, State, pstPrePaint, PaintDefault);
if PaintDefault then
SpDrawXPListItemBackground(Canvas, Rect, odSelected in State, False, odFocused in State, SkinType);
PaintDefault := True;
DoDrawItemBackground(Canvas, Rect, Index, State, pstPostPaint, PaintDefault);
end;
{$IF CompilerVersion > 17}
procedure TSpTBXComboBox.EditWndProc(var Message: TMessage);
begin
// [Bugfix] Delphi 2006/2007 bug:
// CM_MOUSEENTER and CM_MOUSELEAVE are fired everytime the mouse
// enters the combobox internal edit control.
// In D7 these messages were only fired when the mouse entered or leaved
// the combobox, including the internal edit control.
// We need to block the mouse messages from the internal edit control
// in EditWndProc
if Message.Msg = WM_MOUSEMOVE then
ComboWndProc(Message, FEditHandle, FDefEditProc)
else
inherited;
end;
{$IFEND}
function TSpTBXComboBox.GetDropDownButtonRect: TRect;
var
ButtonWidth: Integer;
T: TSpTBXSkinType;
begin
if Style = csSimple then
ButtonWidth := 0
else
ButtonWidth := GetSystemMetrics(SM_CXHSCROLL);
Result.Left := Width - ButtonWidth;
Result.Top := 0;
Result.Right := Result.Left + ButtonWidth;
Result.Bottom := Height;
T := SpTBXSkinType(FSkinType);
case T of
sknNone:
begin
InflateRect(Result, 0, -1);
OffsetRect(Result, -1, 0);
end;
sknWindows:
begin
InflateRect(Result, 0, -1);
OffsetRect(Result, -1, 0);
end;
sknSkin:
begin
InflateRect(Result, 0, -2);
OffsetRect(Result, -2, 0);
end;
end;
end;
function TSpTBXComboBox.GetMouseInDropDownButton: Boolean;
var
P: TPoint;
ButtonR: TRect;
ButtonWidth: Integer;
begin
Result := False;
if not (csDesigning in ComponentState) and GetCursorPos(P) then begin
P := ScreenToClient(P);
if Style = csSimple then
ButtonWidth := 0
else
ButtonWidth := GetSystemMetrics(SM_CXHSCROLL);
ButtonR.Left := Width - ButtonWidth;
ButtonR.Top := 0;
ButtonR.Right := ButtonR.Left + ButtonWidth;
ButtonR.Bottom := Height;
Result := PtInRect(ButtonR, P);
end;
end;
procedure TSpTBXComboBox.InvalidateFrame;
begin
if HandleAllocated then
Invalidate;
end;
procedure TSpTBXComboBox.UpdateDropDownButton;
var
ButtonState: Boolean;
begin
if not DroppedDown then begin
ButtonState := GetMouseInDropDownButton;
if ButtonState <> FMouseInDropDownButton then
InvalidateFrame;
FMouseInDropDownButton := ButtonState;
end;
end;
function TSpTBXComboBox.GetItemHt: Integer;
// Automatically update the Height/ItemHeight when Style is csDropDown,
// csDropDownList or csSimple
begin
// CB_GETITEMHEIGHT doesn't work when Style is csOwnerDrawFixed or
// csOwnerDrawVariable.
// Since TSpTBXComboBox is always owner-drawed we must calculate the
// ItemHeight based on the font when Style <> csOwnerDrawFixed/csOwnerDrawVariable.
// Look at TCustomComboBox.GetItemHt
if Style in [csOwnerDrawFixed, csOwnerDrawVariable] then
Result := inherited GetItemHt
else
if not FAutoItemHeight then // When AutoItemHeight is turned off return the ItemHeight
Result := FInternalItemHeight
else
Result := SpGetControlTextHeight(Self, Font);
end;
procedure TSpTBXComboBox.SetItemHeight(Value: Integer);
begin
if Value > 0 then
FInternalItemHeight := Value;
inherited;
end;
procedure TSpTBXComboBox.SetSkinType(const Value: TSpTBXSkinType);
begin
if Value <> FSkinType then begin
FSkinType := Value;
InvalidateFrame;
end;
end;
procedure TSpTBXComboBox.WMMouseMove(var Message: TWMMouseMove);
begin
inherited;
UpdateDropDownButton;
end;
procedure TSpTBXComboBox.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
// [Bugfix] Delphi 2006 bug:
// Do nothing, fix Delphi 2005/2006 bug: http://qc.borland.com/wc/qcmain.aspx?d=13852
end;
procedure TSpTBXComboBox.WMPaint(var Message: TWMPaint);
var
ACanvas: TControlCanvas;
R, ButtonR: TRect;
ButtonWidth: Integer;
T: TSpTBXSkinType;
PaintDefault, HotTrackFrame, VistaNewComCtrls: Boolean;
begin
inherited;
ACanvas := TControlCanvas.Create;
try
ACanvas.Control := Self;
ACanvas.Lock; // lock the canvas to prevent flicker on mouse click
GetWindowRect(Handle, R);
OffsetRect(R, -R.Left, -R.Top);
if Style = csSimple then
ButtonWidth := 0
else
ButtonWidth := GetSystemMetrics(SM_CXHSCROLL);
T := SpTBXSkinType(FSkinType);
ExcludeClipRect(ACanvas.Handle, 2, 2, R.Right - 2 - ButtonWidth, R.Bottom - 2);
try
PaintDefault := True;
DoDrawBackground(ACanvas, R, pstPrePaint, PaintDefault);
// Don't custom paint if we are on Vista with ComCtrls 6, let the
// OS draw the frame
VistaNewComCtrls := not (csDesigning in ComponentState) and (T = sknWindows) and SpIsWinVistaOrUp and ThemeServices.ThemesEnabled;
if PaintDefault and (T <> sknNone) and not VistaNewComCtrls then begin
if csDesigning in ComponentState then
HotTrackFrame := False
else
if FHotTrack then
HotTrackFrame := FMouseInControl or Focused
else
HotTrackFrame := DroppedDown;
ButtonR := GetDropDownButtonRect;
if T = sknSkin then
SpDrawParentBackground(Self, ACanvas.Handle, R);
SpDrawXPEditFrame(ACanvas, R, Enabled, HotTrackFrame, T);
if Style <> csSimple then
SpDrawXPComboButton(ACanvas, ButtonR, Enabled, HotTrackFrame, GetMouseInDropDownButton, DroppedDown, True, T);
end;
PaintDefault := True;
DoDrawBackground(ACanvas, R, pstPostPaint, PaintDefault);
finally
SelectClipRgn(ACanvas.Handle, 0);
end;
finally
ACanvas.Unlock;
ACanvas.Free;
end;
end;
procedure TSpTBXComboBox.CNMeasureItem(var Message: TWMMeasureItem);
// Automatically update the Height/ItemHeight when Style is csDropDown,
// csDropDownList or csSimple
// Recalc ItemHeight based on the font
var
I: Integer;
begin
inherited;
if not (Style in [csOwnerDrawFixed, csOwnerDrawVariable]) then begin
// When itemID = $FFFFFFFFFF the itemHeight is refering to the
// editbox height
if Message.MeasureItemStruct.itemID = High(LongWord) then begin
I := SpGetControlTextHeight(Self, Font);
Inc(I, 2);
end
else
I := GetItemHt;
Message.MeasureItemStruct^.itemHeight := I;
end;
end;
procedure TSpTBXComboBox.CMSPFontChanged(var Message: TMessage);
// Automatically update the Height/ItemHeight when Style is csDropDown,
// csDropDownList or csSimple
// Recreate when the font is changed
begin
if not FFontChanging and not (Style in [csOwnerDrawFixed, csOwnerDrawVariable]) then begin
FFontChanging := True;
if not DroppedDown then RecreateWnd;
FFontChanging := False;
end;
end;
procedure TSpTBXComboBox.WMSetFont(var Message: TWMSetFont);
// Automatically update the Height/ItemHeight when Style is csDropDown,
// csDropDownList or csSimple
// Recreate when the font is changed
begin
inherited;
if not FFontChanging and not (Style in [csOwnerDrawFixed, csOwnerDrawVariable]) then
PostMessage(Handle, CM_SPFONTCHANGED, 0, 0);
end;
procedure TSpTBXComboBox.WMSpSkinChange(var Message: TMessage);
begin
inherited;
InvalidateFrame;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXListBox }
constructor TSpTBXListBox.Create(AOwner: TComponent);
begin
inherited;
FHotTrack := True;
FSkinType := sknSkin;
SkinManager.AddSkinNotification(Self);
Style := lbOwnerDrawFixed;
end;
procedure TSpTBXListBox.CreateParams(var Params: TCreateParams);
begin
inherited;
// Force the ListBox to be owner draw
with Params do
if Style and (LBS_OWNERDRAWFIXED or LBS_OWNERDRAWVARIABLE) = 0 then
Style := Style or LBS_OWNERDRAWFIXED;
end;
destructor TSpTBXListBox.Destroy;
begin
SkinManager.RemoveSkinNotification(Self);
inherited;
end;
procedure TSpTBXListBox.InvalidateBorders;
begin
if HandleAllocated then
RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE);
end;
procedure TSpTBXListBox.SetHotTrack(const Value: Boolean);
begin
if FHotTrack <> Value then begin
FHotTrack := Value;
InvalidateBorders;
end;
end;
procedure TSpTBXListBox.SetSkinType(const Value: TSpTBXSkinType);
begin
if Value <> FSkinType then begin
FSkinType := Value;
InvalidateBorders;
end;
end;
procedure TSpTBXListBox.CMFocusChanged(var Message: TCMFocusChanged);
begin
inherited;
if FHotTrack and Assigned(Message.Sender) then begin
FChildFocused := Self = Message.Sender;
if FChildFocused <> FHotTracking then begin
FHotTracking := FChildFocused;
InvalidateBorders;
end;
end;
end;
procedure TSpTBXListBox.CMMouseEnter(var Message: TMessage);
begin
inherited;
if FHotTrack and not FHotTracking then begin
FHotTracking := True;
if SpCanEditFrameBeHotTracked(BorderStyle, SkinType) then
InvalidateBorders;
end;
end;
procedure TSpTBXListBox.CMMouseLeave(var Message: TMessage);
begin
inherited;
if FHotTrack and FHotTracking and not FChildFocused then begin
FHotTracking := False;
if SpCanEditFrameBeHotTracked(BorderStyle, SkinType) then
InvalidateBorders;
end;
end;
procedure TSpTBXListBox.WMSpSkinChange(var Message: TMessage);
begin
inherited;
InvalidateBorders;
end;
procedure TSpTBXListBox.DoDrawItem(ACanvas: TCanvas; var ARect: TRect;
Index: Integer; const State: TOwnerDrawState;
const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean);
begin
if Assigned(FOnDrawItem) then FOnDrawItem(Self, ACanvas, ARect, Index, State, PaintStage, PaintDefault);
end;
procedure TSpTBXListBox.DoDrawItemBackground(ACanvas: TCanvas; var ARect: TRect;
Index: Integer; const State: TOwnerDrawState;
const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean);
begin
if Assigned(FOnDrawItemBackground) then FOnDrawItemBackground(Self, ACanvas, ARect, Index, State, PaintStage, PaintDefault);
end;
procedure TSpTBXListBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var
R: TRect;
Flags: Integer;
PaintDefault: Boolean;
begin
// Draw the item text
PaintDefault := True;
DoDrawItem(Canvas, Rect, Index, State, pstPrePaint, PaintDefault);
if PaintDefault then begin
Flags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
// It seems TabWidth doesn't work on owner-drawed listboxes, we have to do
// it manually using DT_EXPANDTABS.
// It seems that DrawText uses a different unit metric than LB_SETTABSTOPS,
// don't know how to calculate it correctly for more info:
// http://news.jrsoftware.org/read/article.php?id=15427&group=jrsoftware.toolbar2000.thirdparty#15427
// Using DrawTextEx doesn't solve the problem, GetDialogBaseUnits doesn't help either
if TabWidth > 0 then
Flags := ((Flags or DT_EXPANDTABS or DT_TABSTOP) and not $800) or (Round(TabWidth * 0.3) shl 8);
// Add a margin to the rect
R := Rect;
if not UseRightToLeftAlignment then
Inc(R.Left, 3)
else
Dec(R.Right, 3);
SpDrawXPText(Canvas, Items[Index], R, Flags);
end;
PaintDefault := True;
DoDrawItem(Canvas, Rect, Index, State, pstPostPaint, PaintDefault);
end;
procedure TSpTBXListBox.DrawItemBackground(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var
PaintDefault: Boolean;
begin
// Draw the item background
PaintDefault := True;
DoDrawItemBackground(Canvas, Rect, Index, State, pstPrePaint, PaintDefault);
if PaintDefault then
SpDrawXPListItemBackground(Canvas, Rect, odSelected in State, False, odFocused in State, SkinType);
PaintDefault := True;
DoDrawItemBackground(Canvas, Rect, Index, State, pstPostPaint, PaintDefault);
end;
procedure TSpTBXListBox.CNDrawItem(var Message: TWMDrawItem);
var
State: TOwnerDrawState;
SknState: TSpTBXSkinStatesType;
begin
with Message.DrawItemStruct^ do
begin
State := TOwnerDrawState(LongRec(itemState).Lo);
Canvas.Handle := hDC;
Canvas.Lock;
try
Canvas.Font := Font;
Canvas.Brush := Brush;
if (Integer(itemID) >= 0) and (Integer(itemID) < Items.Count) then begin
DrawItemBackground(itemID, rcItem, State);
SknState := CurrentSkin.GetState(not (odDisabled in State), False, False, odSelected in State);
Canvas.Brush.Style := bsClear;
if SknState = sknsChecked then
Canvas.Font.Color := CurrentSkin.GetTextColor(skncListItem, SknState, SkinType);
DrawItem(itemID, rcItem, State);
end
else
Canvas.FillRect(rcItem);
finally
Canvas.Unlock;
Canvas.Handle := 0;
end;
end;
end;
procedure TSpTBXListBox.WMNCPaint(var Message: TWMNCPaint);
begin
inherited;
if (BorderStyle <> bsNone) and (SpTBXSkinType(FSkinType) <> sknNone) then
if Ctl3D then
SpDrawXPEditFrame(Self, FHotTracking, FSkinType, True);
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXCheckListBox }
constructor TSpTBXCheckListBox.Create(AOwner: TComponent);
begin
inherited;
FHotTrack := True;
FSkinType := sknSkin;
SkinManager.AddSkinNotification(Self);
Style := lbOwnerDrawFixed;
end;
destructor TSpTBXCheckListBox.Destroy;
begin
SkinManager.RemoveSkinNotification(Self);
inherited;
end;
procedure TSpTBXCheckListBox.InvalidateBorders;
begin
if HandleAllocated then
RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE);
end;
procedure TSpTBXCheckListBox.SetHotTrack(const Value: Boolean);
begin
if FHotTrack <> Value then begin
FHotTrack := Value;
InvalidateBorders;
end;
end;
procedure TSpTBXCheckListBox.SetSkinType(const Value: TSpTBXSkinType);
begin
if Value <> FSkinType then begin
FSkinType := Value;
InvalidateBorders;
end;
end;
procedure TSpTBXCheckListBox.CMFocusChanged(var Message: TCMFocusChanged);
begin
inherited;
if FHotTrack and Assigned(Message.Sender) then begin
FChildFocused := Self = Message.Sender;
if FChildFocused <> FHotTracking then begin
FHotTracking := FChildFocused;
InvalidateBorders;
end;
end;
end;
procedure TSpTBXCheckListBox.CMMouseEnter(var Message: TMessage);
begin
inherited;
if FHotTrack and not FHotTracking then begin
FHotTracking := True;
if SpCanEditFrameBeHotTracked(BorderStyle, SkinType) then
InvalidateBorders;
end;
end;
procedure TSpTBXCheckListBox.CMMouseLeave(var Message: TMessage);
begin
inherited;
if FHotTrack and FHotTracking and not FChildFocused then begin
FHotTracking := False;
if SpCanEditFrameBeHotTracked(BorderStyle, SkinType) then
InvalidateBorders;
end;
end;
procedure TSpTBXCheckListBox.WMSpSkinChange(var Message: TMessage);
begin
inherited;
InvalidateBorders;
end;
procedure TSpTBXCheckListBox.DoDrawItem(ACanvas: TCanvas; var ARect: TRect;
Index: Integer; const State: TOwnerDrawState;
const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean);
begin
if Assigned(FOnDrawItem) then FOnDrawItem(Self, ACanvas, ARect, Index, State, PaintStage, PaintDefault);
end;
procedure TSpTBXCheckListBox.DoDrawItemBackground(ACanvas: TCanvas;
var ARect: TRect; Index: Integer; const State: TOwnerDrawState;
const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean);
begin
if Assigned(FOnDrawItemBackground) then FOnDrawItemBackground(Self, ACanvas, ARect, Index, State, PaintStage, PaintDefault);
end;
procedure TSpTBXCheckListBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var
R: TRect;
Flags: Integer;
PaintDefault: Boolean;
begin
// Draw the item text
PaintDefault := True;
DoDrawItem(Canvas, Rect, Index, State, pstPrePaint, PaintDefault);
if PaintDefault then begin
Flags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
// Add a margin to the rect
R := Rect;
if not UseRightToLeftAlignment then
Inc(R.Left, 3)
else
Dec(R.Right, 3);
SpDrawXPText(Canvas, Items[Index], R, Flags);
end;
PaintDefault := True;
DoDrawItem(Canvas, Rect, Index, State, pstPostPaint, PaintDefault);
end;
procedure TSpTBXCheckListBox.DrawItemBackground(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var
ACheckWidth: Integer;
R: TRect;
PaintDefault: Boolean;
begin
// Draw the checkbox, background and focus
PaintDefault := True;
DoDrawItemBackground(Canvas, Rect, Index, State, pstPrePaint, PaintDefault);
if PaintDefault then begin
if not Header[Index] then begin
// Draw the checkbox
ACheckWidth := GetCheckWidth;
if not UseRightToLeftAlignment then begin
R.Right := Rect.Left;
R.Left := R.Right - ACheckWidth;
end
else begin
R.Left := Rect.Right;
R.Right := R.Left + ACheckWidth;
end;
R.Top := Rect.Top + (Rect.Bottom - Rect.Top - ACheckWidth) div 2;
R.Bottom := R.Top + ACheckWidth;
InflateRect(R, -1, -1);
Canvas.FillRect(R);
SpDrawXPCheckBoxGlyph(Canvas, R, ItemEnabled[Index], Self.State[Index], False, False, SkinType);
// Draw the background and focus
SpDrawXPListItemBackground(Canvas, Rect, odSelected in State, False, odFocused in State, SkinType);
end
else begin
Canvas.Font.Color := HeaderColor;
Canvas.Brush.Color := HeaderBackgroundColor;
Canvas.FillRect(Rect);
if odFocused in State then
SpDrawFocusRect(Canvas, Rect);
end;
end;
PaintDefault := True;
DoDrawItemBackground(Canvas, Rect, Index, State, pstPostPaint, PaintDefault);
end;
procedure TSpTBXCheckListBox.CNDrawItem(var Message: TWMDrawItem);
var
State: TOwnerDrawState;
SknState: TSpTBXSkinStatesType;
begin
if Items.Count = 0 then Exit;
with Message.DrawItemStruct^ do
begin
State := TOwnerDrawState(LongRec(itemState).Lo);
Canvas.Handle := hDC;
Canvas.Lock;
try
Canvas.Font := Font;
Canvas.Brush := Brush;
if (Integer(itemID) >= 0) and (Integer(itemID) < Items.Count) then begin
// Exclude the checkbox area
if not Header[itemID] then
if not UseRightToLeftAlignment then
rcItem.Left := rcItem.Left + GetCheckWidth
else
rcItem.Right := rcItem.Right - GetCheckWidth;
DrawItemBackground(itemID, rcItem, State);
SknState := CurrentSkin.GetState(not (odDisabled in State), False, False, odSelected in State);
Canvas.Brush.Style := bsClear;
if SknState = sknsChecked then
Canvas.Font.Color := CurrentSkin.GetTextColor(skncListItem, SknState, SkinType);
DrawItem(itemID, rcItem, State);
end
else
Canvas.FillRect(rcItem);
finally
Canvas.Unlock;
Canvas.Handle := 0;
end;
end;
end;
procedure TSpTBXCheckListBox.WMNCPaint(var Message: TWMNCPaint);
begin
inherited;
if (BorderStyle <> bsNone) and (SpTBXSkinType(FSkinType) <> sknNone) then
if Ctl3D then
SpDrawXPEditFrame(Self, FHotTracking, FSkinType, True);
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXEditItem }
constructor TSpTBXEditItem.Create(AOwner: TComponent);
begin
inherited;
FEditImageIndex := -1;
FEditorFontSettings := TSpTBXFontSettings.Create;
TSpTBXFontSettingsAccess(FEditorFontSettings).OnChange := FontSettingsChanged;
CustomWidth := 64;
Alignment := taLeftJustify;
end;
destructor TSpTBXEditItem.Destroy;
begin
FFontSettings.Free;
FEditorFontSettings.Free;
inherited;
end;
function TSpTBXEditItem.DoAcceptText(var NewText: WideString): Boolean;
begin
Result := True;
if Assigned(FOnAcceptText) then FOnAcceptText(Self, NewText, Result);
end;
function TSpTBXEditItem.DoAutoComplete(var AText: WideString): Boolean;
begin
Result := False;
end;
procedure TSpTBXEditItem.DoBeginEdit(Viewer: TSpTBXEditItemViewer);
begin
if Assigned(FOnBeginEdit) then FOnBeginEdit(Self, Viewer, Viewer.EditControl);
end;
procedure TSpTBXEditItem.DoChange(const AText: WideString);
begin
if Assigned(FOnChange) then FOnChange(Self, AText);
end;
procedure TSpTBXEditItem.DoTextChanging(const OldText: WideString;
var NewText: WideString; Reason: Integer);
begin
case CharCase of
ecUpperCase: NewText := WideUpperCase(NewText);
ecLowerCase: NewText := WideLowerCase(NewText);
end;
end;
procedure TSpTBXEditItem.FontSettingsChanged(Sender: TObject);
begin
Change(True);
end;
function TSpTBXEditItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass;
begin
if not FAllowVerticalEditor and (AView.Orientation = tbvoVertical) then
Result := inherited GetItemViewerClass(AView)
else
Result := TSpTBXEditItemViewer;
end;
function TSpTBXEditItem.NeedToRecreateViewer(AViewer: TTBItemViewer): Boolean;
begin
Result := GetItemViewerClass(AViewer.View) <> AViewer.ClassType;
end;
procedure TSpTBXEditItem.SetPasswordChar(Value: WideChar);
begin
if Value <> FPasswordChar then begin
FPasswordChar := Value;
Change(True);
end;
end;
procedure TSpTBXEditItem.SetShowImage(const Value: Boolean);
begin
if FShowImage <> Value then begin
FShowImage := Value;
Change(True);
end;
end;
function TSpTBXEditItem.StartEditing(AView: TTBView): Boolean;
var
SaveText: WideString;
begin
SaveText := Text;
SpFocusEditItem(Self, AView);
// Case Sensitive, Result is true when the text is changed
Result := Text <> SaveText;
end;
procedure TSpTBXEditItem.SetAllowVerticalEditor(const Value: Boolean);
begin
if FAllowVerticalEditor <> Value then begin
FAllowVerticalEditor := Value;
Change(True);
end;
end;
procedure TSpTBXEditItem.SetCharCase(Value: TEditCharCase);
begin
if FCharCase <> Value then begin
FCharCase := Value;
SetText(Text); // Updates case
end;
end;
procedure TSpTBXEditItem.SetEditCaption(const Value: WideString);
begin
if FEditCaption <> Value then begin
FEditCaption := Value;
Change(True);
end;
end;
procedure TSpTBXEditItem.SetEditorFontSettings(const Value: TSpTBXFontSettings);
begin
FEditorFontSettings.Assign(Value);
end;
procedure TSpTBXEditItem.SetMaxLength(Value: Integer);
begin
if FMaxLength <> Value then begin
FMaxLength := Value;
Change(False);
end;
end;
procedure TSpTBXEditItem.SetText(Value: WideString);
begin
SetTextEx(Value, tcrSetProperty);
end;
procedure TSpTBXEditItem.SetTextEx(Value: WideString; Reason: Integer);
begin
DoTextChanging(FText, Value, Reason);
// Case Sensitive, fire the event when the text is changed
if FText <> Value then begin
FText := Value;
Change(False);
DoChange(Text);
end;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXEditItemViewer }
procedure TSpTBXEditItemViewer.EditWndProc(var Message: TMessage);
procedure AcceptText;
var
S: WideString;
begin
S := GetEditControlText;
if Item.DoAcceptText(S) then Item.SetTextEx(S, tcrEditControl);
end;
begin
if FEditControl = nil then
Exit;
if not HandleEditMessage(Message) then begin
if Message.Msg = WM_CHAR then
case TWMChar(Message).CharCode of
VK_TAB: begin
FEditControlStatus := [ecsAccept];
AcceptText;
Exit;
end;
VK_RETURN: begin
FEditControlStatus := [ecsAccept, ecsClose];
AcceptText;
Exit;
end;
VK_ESCAPE: begin
FEditControlStatus := [];
Exit;
end;
end;
TCustomEditAccess(FEditControl).WndProc(Message);
end;
if Message.Msg = WM_KILLFOCUS then begin
View.CancelMode;
FEditControlStatus := [ecsClose];
end;
end;
function TSpTBXEditItemViewer.GetEditControlClass: TEditClass;
begin
Result := TSpTBXUnicodeEdit;
end;
function TSpTBXEditItemViewer.GetEditControlText: WideString;
begin
Result := '';
if Assigned(FEditControl) then begin
if FEditControl is TSpTBXUnicodeEdit then
Result := TSpTBXUnicodeEdit(FEditControl).Text
else
Result := TCustomEditAccess(FEditControl).Text;
end;
end;
procedure TSpTBXEditItemViewer.GetEditHeight(const DC: HDC; out EditHeight,
ExternalLeading: Integer);
var
TextMetricA: TTextMetricA;
TextMetricW: TTextMetricW;
begin
if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then begin
Windows.GetTextMetricsA(DC, TextMetricA);
EditHeight := TextMetricA.tmHeight;
ExternalLeading := TextMetricA.tmExternalLeading;
end
else begin
Windows.GetTextMetricsW(DC, TextMetricW);
EditHeight := TextMetricW.tmHeight;
ExternalLeading := TextMetricW.tmExternalLeading;
end;
end;
procedure TSpTBXEditItemViewer.GetEditRect(var R: TRect);
var
TextSize: TSize;
MarginsInfo: TSpTBXMenuItemMarginsInfo;
begin
R := BoundsRect;
if not IsToolbarStyle then begin
TextSize := MeasureEditCaption;
CurrentSkin.GetMenuItemMargins(StockBitmap.Canvas, 0, MarginsInfo);
Inc(R.Left, MarginsInfo.GutterSize + MarginsInfo.ImageTextSpace);
if Length(Item.EditCaption) > 0 then
Inc(R.Left, MarginsInfo.LeftCaptionMargin + TextSize.cx + MarginsInfo.RightCaptionMargin + 1);
end;
InflateRect(R, 1, 0);
Inc(R.Left, GetIndentBefore);
Dec(R.Right, GetIndentAfter);
end;
function TSpTBXEditItemViewer.GetImageShown: Boolean;
begin
Result := (Item.EditImageIndex >= 0) and
((Item.DisplayMode in [nbdmDefault, nbdmImageAndText]) or
(IsToolbarStyle and (Item.DisplayMode = nbdmTextOnlyInMenus)));
if Assigned(View) and Assigned(View.Owner) and (View.Owner is TSpTBXToolbar) then
if TSpTBXToolbar(View.Owner).DisplayMode = tbdmTextOnly then
Result := False;
end;
function TSpTBXEditItemViewer.GetIndentAfter: Integer;
begin
Result := 1;
end;
function TSpTBXEditItemViewer.GetIndentBefore: Integer;
var
ImgList: TCustomImageList;
begin
Result := 1;
if ShowImage then begin
ImgList := GetImageList;
if Assigned(ImgList) and (Item.ImageIndex >= 0) and (Item.ImageIndex <= ImgList.Count - 1) then
Result := ImgList.Width + 4;
end;
end;
function TSpTBXEditItemViewer.GetItem: TSpTBXEditItem;
var
TBItem: TTBCustomItem;
begin
TBItem := inherited Item;
if Assigned(TBItem) then
Result := TBItem as TSpTBXEditItem
else
Result := nil;
end;
function TSpTBXEditItemViewer.HandleEditMessage(var Message: TMessage): Boolean;
begin
Result := False;
if Assigned(Item.FOnEditMessage) then Item.FOnEditMessage(Item, Self, Message, Result);
end;
procedure TSpTBXEditItemViewer.CalcSize(const Canvas: TCanvas;
var AWidth, AHeight: Integer);
var
TextSize: TSize;
MarginsInfo: TSpTBXMenuItemMarginsInfo;
EditBoxHeight: Integer;
begin
if Item.CustomWidth > -1 then
AWidth := Item.CustomWidth;
if not IsToolbarStyle then begin
TextSize := MeasureEditCaption;
CurrentSkin.GetMenuItemMargins(StockBitmap.Canvas, 0, MarginsInfo);
Inc(AWidth, MarginsInfo.GutterSize + MarginsInfo.ImageTextSpace);
if Length(Item.EditCaption) > 0 then
Inc(AWidth, MarginsInfo.LeftCaptionMargin + TextSize.cx + MarginsInfo.RightCaptionMargin + 2);
end
else begin
TextSize.cx := 0;
TextSize.cy := 0;
end;
EditBoxHeight := MeasureTextHeight + 1;
Inc(EditBoxHeight, 2 + 4);
AHeight := Max(EditBoxHeight, TextSize.cy);
if not IsToolbarStyle then
AHeight := AHeight
else
AHeight := AHeight or $01;
if (Item.CustomHeight > -1) and IsToolbarStyle then
AHeight := Item.CustomHeight;
end;
function TSpTBXEditItemViewer.CaptionShown: Boolean;
begin
Result := not IsToolbarStyle and inherited CaptionShown;
end;
function TSpTBXEditItemViewer.GetCaptionText: WideString;
begin
Result := TSpTBXEditItem(Item).EditCaption;
end;
procedure TSpTBXEditItemViewer.InternalDrawFrame(ACanvas: TCanvas;
ARect: TRect; ItemInfo: TSpTBXMenuItemInfo);
begin
if not (ItemInfo.HotTrack or ItemInfo.Pushed) and (SkinManager.CurrentSkinName = 'Default') then
SpFillRect(ACanvas, ARect, clWindow, clBtnFace)
else begin
SpDrawXPEditFrame(ACanvas, ARect, ItemInfo.Enabled, ItemInfo.HotTrack, sknSkin);
InflateRect(ARect, -2, -2);
SpFillRect(ACanvas, ARect, clWindow);
end;
end;
procedure TSpTBXEditItemViewer.InternalEditControlChange(Sender: TObject);
begin
// Used by descendants
Item.DoChange(GetEditControlText);
end;
procedure TSpTBXEditItemViewer.InternalEditControlExit;
begin
// Used by descendants
end;
procedure TSpTBXEditItemViewer.Paint(const Canvas: TCanvas;
const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean);
const
Alignments: array [TAlignment] of Integer = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
DC: HDC;
S: WideString;
R, ImageRect: TRect;
ImgList: TCustomImageList;
TextSize: TSize;
ItemInfo: TSpTBXMenuItemInfo;
MarginsInfo: TSpTBXMenuItemMarginsInfo;
begin
DC := Canvas.Handle;
R := ClientAreaRect;
SpFillItemInfo(Canvas, Self, ItemInfo);
Canvas.Font.Assign(View.GetFont);
Item.FontSettings.Apply(Canvas.Font);
{ Item Caption, only on MenuItems }
if not IsToolbarStyle then begin
S := Item.EditCaption;
CurrentSkin.GetMenuItemMargins(Canvas, 0, MarginsInfo);
TextSize := SpGetTextSize(DC, S, True);
if Length(S) > 0 then
R.Right := MarginsInfo.GutterSize + MarginsInfo.ImageTextSpace + TextSize.cx + MarginsInfo.LeftCaptionMargin + MarginsInfo.RightCaptionMargin
else
R.Right := MarginsInfo.GutterSize + MarginsInfo.ImageTextSpace - 1;
SpDrawXPMenuItem(Canvas, R, ItemInfo);
R.Right := ClientAreaRect.Right;
Inc(R.Left, MarginsInfo.GutterSize + MarginsInfo.ImageTextSpace);
if Length(S) > 0 then begin
if Canvas.Font.Color = clNone then
Canvas.Font.Color := CurrentSkin.GetTextColor(skncMenuItem, ItemInfo.State);
Inc(R.Left, MarginsInfo.LeftCaptionMargin);
SpDrawXPText(Canvas, S, R, DT_SINGLELINE or DT_LEFT or DT_VCENTER);
Inc(R.Left, TextSize.cx + MarginsInfo.RightCaptionMargin + 1);
end;
ImageRect := ClientAreaRect;
ImageRect.Right := ImageRect.Left + ItemInfo.MenuMargins.GutterSize;
if ItemInfo.ImageShown then begin
ImageRect.Left := ImageRect.Left + ((ImageRect.Right - ImageRect.Left) - ItemInfo.ImageSize.cx) div 2;
ImageRect.Top := ImageRect.Top + ((ImageRect.Bottom - ImageRect.Top) - ItemInfo.ImageSize.cy) div 2;
ImageRect.Right := ImageRect.Left + ItemInfo.ImageSize.cx;
ImageRect.Bottom := ImageRect.Top + ItemInfo.ImageSize.cy;
DrawItemImage(Canvas, ImageRect, ItemInfo, Item.EditImageIndex);
end;
end;
{ Edit Frame }
InternalDrawFrame(Canvas, R, ItemInfo);
InflateRect(R, 1, 0);
{ Editor Image }
if ShowImage then begin
ImgList := GetImageList;
if Assigned(ImgList) and (Item.ImageIndex >= 0) and (Item.ImageIndex <= ImgList.Count - 1) then begin
ImageRect.Left := R.Left + 4;
ImageRect.Right := R.Left + ImgList.Width;
ImageRect.Top := (R.Top + R.Bottom + 1 - ImgList.Height) div 2;
ImageRect.Bottom := ImageRect.Top + ImgList.Height;
SpDrawImageList(Canvas, ImageRect, ImgList, Item.ImageIndex, Item.Enabled, True);
end;
end;
{ Editor text }
if Length(Item.Text) > 0 then begin
if Item.PasswordChar <> #0 then
S := StringOfChar(Item.PasswordChar, Length(S))
else
S := Item.Text;
Canvas.Font.Assign(View.GetFont);
Item.EditorFontSettings.Apply(Canvas.Font);
if Canvas.Font.Color = clNone then
if Item.Enabled then
Canvas.Font.Color := clBtnText
else
Canvas.Font.Color := clGrayText;
InflateRect(R, -2, -1);
if not IsToolbarStyle then
Inc(R.Left, GetIndentBefore + 1)
else
Inc(R.Left, GetIndentBefore + 2);
Dec(R.Right, GetIndentAfter + 1);
Dec(R.Top, 1);
if IsToolbarStyle then
Inc(R.Left, -1);
SpDrawXPText(Canvas, S, R, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX or Alignments[Item.Alignment]);
end;
end;
function TSpTBXEditItemViewer.ShowImage: Boolean;
begin
Result := Item.ShowImage;
end;
procedure TSpTBXEditItemViewer.GetCursor(const Pt: TPoint; var ACursor: HCURSOR);
var
R: TRect;
begin
if not Item.Enabled then
Exit;
GetEditRect(R);
OffsetRect(R, -BoundsRect.Left, -BoundsRect.Top);
InflateRect(R, -2, -2);
if PtInRect(R, Pt) then
ACursor := LoadCursor(0, IDC_IBEAM);
end;
function TSpTBXEditItemViewer.EditLoop(const CapHandle: HWND): Boolean;
procedure ControlMessageLoop;
function PointInWindow(const Wnd: HWND; const P: TPoint): Boolean;
var
W: HWND;
begin
Result := False;
W := WindowFromPoint(P);
if W = 0 then Exit;
if W = Wnd then
Result := True
else
if IsChild(Wnd, W) then
Result := True;
end;
function ContinueLoop: Boolean;
begin
Result := (ecsContinueLoop in FEditControlStatus) and
not View.IsModalEnding and FEditControl.Focused and Item.Enabled;
{ Note: View.IsModalEnding is checked since TTBView.CancelMode doesn't
destroy popup windows; it merely hides them and calls EndModal. So if
IsModalEnding returns True we can infer that CancelMode was likely
called. }
end;
var
Msg: TMsg;
IsKeypadDigit: Boolean;
V: Integer;
begin
try
while ContinueLoop do begin
{ Examine the next message before popping it out of the queue }
if not PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE) then begin
WaitMessage;
Continue;
end;
case Msg.message of
WM_SYSKEYDOWN: begin
{ Exit immediately if Alt+[key] or F10 are pressed, but not
Alt+Shift, Alt+`, or Alt+[keypad digit] }
if (Msg.wParam <> VK_MENU) and (Msg.wParam <> VK_SHIFT) and
(Msg.wParam <> VK_HANJA) then begin
IsKeypadDigit := False;
{ This detect digits regardless of whether Num Lock is on: }
if Lo(LongRec(Msg.lParam).Hi) <> 0 then
for V := VK_NUMPAD0 to VK_NUMPAD9 do
if MapVirtualKey(V, 0) = Lo(LongRec(Msg.lParam).Hi) then begin
IsKeypadDigit := True;
Break;
end;
if not IsKeypadDigit then begin
FEditControlStatus := [ecsClose];
Exit;
end;
end;
end;
WM_SYSKEYUP: begin
{ Exit when Alt is released by itself }
if Msg.wParam = VK_MENU then begin
FEditControlStatus := [ecsClose];
Exit;
end;
end;
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK,
WM_RBUTTONDOWN, WM_RBUTTONDBLCLK,
WM_MBUTTONDOWN, WM_MBUTTONDBLCLK,
WM_NCLBUTTONDOWN, WM_NCLBUTTONDBLCLK,
WM_NCRBUTTONDOWN, WM_NCRBUTTONDBLCLK,
WM_NCMBUTTONDOWN, WM_NCMBUTTONDBLCLK: begin
{ If a mouse click outside the edit control is in the queue,
exit and let the upstream message loop deal with it }
if Msg.hwnd <> FEditControl.Handle then
Exit;
end;
WM_MOUSEMOVE, WM_NCMOUSEMOVE: begin
if GetCapture = CapHandle then begin
if PointInWindow(FEditControl.Handle, Msg.pt) then
ReleaseCapture;
end
else if GetCapture = 0 then begin
if not PointInWindow(FEditControl.Handle, Msg.pt) then
SetCapture(CapHandle);
end;
if GetCapture = CapHandle then
SetCursor(LoadCursor(0, IDC_ARROW));
end;
end;
{ Now pop the message out of the queue }
if not PeekMessage(Msg, 0, Msg.message, Msg.message, PM_REMOVE or PM_NOYIELD) then
Continue;
if ((Msg.message >= WM_MOUSEFIRST) and (Msg.message <= WM_MOUSELAST)) and
(Msg.hwnd = CapHandle) then
{ discard, so that the selection doesn't get changed }
else begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
finally
{ Make sure there are no outstanding WM_*CHAR messages }
RemoveMessages(WM_CHAR, WM_DEADCHAR);
RemoveMessages(WM_SYSCHAR, WM_SYSDEADCHAR);
end;
end;
var
R: TRect;
ActiveWnd, FocusWnd: HWND;
S: WideString;
begin
GetEditRect(R);
if IsRectEmpty(R) then begin
Result := False;
Exit;
end;
ActiveWnd := GetActiveWindow;
FocusWnd := GetFocus;
{ Create the edit control }
InflateRect(R, -3, -3);
FEditControl := GetEditControlClass.Create(nil);
try
FEditControl.Name := Format('%s_edit_control_%p', [ClassName, Pointer(FEditControl)]);
FEditControl.Visible := False;
TCustomEditAccess(FEditControl).ReadOnly := Item.ReadOnly;
TCustomEditAccess(FEditControl).BorderStyle := bsNone;
TCustomEditAccess(FEditControl).AutoSize := False;
TCustomEditAccess(FEditControl).Font.Assign(View.GetFont);
Item.EditorFontSettings.Apply(TCustomEditAccess(FEditControl).Font);
if FEditControl is TSpTBXUnicodeEdit then begin
TSpTBXUnicodeEdit(FEditControl).Alignment := Item.Alignment;
TSpTBXUnicodeEdit(FEditControl).PasswordChar := Item.PasswordChar;
TSpTBXUnicodeEdit(FEditControl).Text := Item.Text
end
else
TCustomEditAccess(FEditControl).Text := Item.Text;
TCustomEditAccess(FEditControl).CharCase := Item.FCharCase;
TCustomEditAccess(FEditControl).MaxLength := Item.FMaxLength;
FEditControl.BoundsRect := R;
FEditControl.WindowProc := EditWndProc;
FEditControl.ParentWindow := View.Window.Handle;
TCustomEditAccess(FEditControl).OnChange := InternalEditControlChange;
FEditControl.SelectAll;
DoBeginEdit;
FEditControl.Visible := True;
FEditControl.SetFocus;
if GetActiveWindow <> ActiveWnd then
SendMessage(ActiveWnd, WM_NCACTIVATE, 1, 0) // Don't gray out title bar of old active window
else
ActiveWnd := 0;
FEditControlStatus := [ecsContinueLoop];
ControlMessageLoop;
finally
if FEditControlStatus = [ecsContinueLoop] then
InternalEditControlExit;
S := GetEditControlText;
FreeAndNil(FEditControl);
end;
if (FEditControlStatus = [ecsContinueLoop]) and Item.ExtendedAccept then
if Item.DoAcceptText(S) then Item.SetTextEx(S, tcrEditControl);
{ ensure the area underneath the edit control is repainted immediately }
View.Window.Update;
{ If app is still active, set focus to previous control and restore capture
to CapHandle if another control hasn't taken it }
if GetActiveWindow <> 0 then begin
SetFocus(FocusWnd);
if GetCapture = 0 then
SetCapture(CapHandle);
end;
if ActiveWnd <> 0 then
SendMessage(ActiveWnd, WM_NCACTIVATE, Ord(GetActiveWindow = ActiveWnd), 0);
{ The SetFocus call above can change the Z order of windows. If the parent
window is a popup window, reassert its topmostness. }
if View.Window is TTBPopupWindow then
SetWindowPos(View.Window.Handle, HWND_TOPMOST, 0, 0, 0, 0,
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
{ Send an MSAA "focus" event now that we're returning to the regular modal loop }
View.NotifyFocusEvent;
Result := ecsClose in FEditControlStatus;
if not Result and (GetCapture = CapHandle) then begin
if ecsAccept in FEditControlStatus then
{ if we are accepting but not closing, Tab must have been pressed }
View.Selected := View.NextSelectable(View.Selected,
GetKeyState(VK_SHIFT) >= 0);
end;
end;
procedure TSpTBXEditItemViewer.DoBeginEdit;
begin
Item.DoBeginEdit(Self);
end;
function TSpTBXEditItemViewer.DoExecute: Boolean;
begin
// Close any delay-close popup menus before entering the edit loop
View.CancelChildPopups;
Result := False;
if EditLoop(View.GetCaptureWnd) then begin
View.EndModal;
if ecsAccept in FEditControlStatus then
Result := True;
end;
end;
function TSpTBXEditItemViewer.MeasureEditCaption: TSize;
begin
StockBitmap.Canvas.Font.Assign(View.GetFont);
Item.FontSettings.Apply(StockBitmap.Canvas.Font);
Result := SpGetTextSize(StockBitmap.Canvas.Handle, Item.EditCaption, True);
end;
function TSpTBXEditItemViewer.MeasureTextHeight: Integer;
var
I: Integer;
begin
StockBitmap.Canvas.Font.Assign(View.GetFont);
Item.EditorFontSettings.Apply(StockBitmap.Canvas.Font);
GetEditHeight(StockBitmap.Canvas.Handle, Result, I);
Inc(Result, I);
end;
procedure TSpTBXEditItemViewer.MouseBeginEdit;
begin
if Item.Enabled then
Execute(True)
else begin
if (View.ParentView = nil) and not View.IsPopup then
View.EndModal;
end;
end;
procedure TSpTBXEditItemViewer.MouseDown(Shift: TShiftState; X, Y: Integer;
var MouseDownOnMenu: Boolean);
begin
if IsPtInButtonPart(X, Y) then
MouseBeginEdit
else
inherited;
end;
procedure TSpTBXEditItemViewer.MouseUp(X, Y: Integer; MouseWasDownOnMenu: Boolean);
begin
if IsPtInButtonPart(X, Y) then
MouseBeginEdit
else
inherited;
end;
function TSpTBXEditItemViewer.UsesSameWidth: Boolean;
begin
Result := False;
end;
function TSpTBXEditItemViewer.GetAccRole: Integer;
const
ROLE_SYSTEM_TEXT = $2a; // from OleAcc.h
begin
Result := ROLE_SYSTEM_TEXT;
end;
function TSpTBXEditItemViewer.GetAccValue(var Value: WideString): Boolean;
begin
Value := Item.Text;
Result := True;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXSpinEditItem }
constructor TSpTBXSpinEditItem.Create(AOwner: TComponent);
begin
inherited;
FSpinOptions := TSpTBXSpinEditOptions.Create;
FSpinOptions.OnGetText := SpinOptionsGetText;
FSpinOptions.OnSetText := SpinOptionsSetText;
Alignment := taRightJustify;
Text := '0';
end;
destructor TSpTBXSpinEditItem.Destroy;
begin
FreeAndNil(FSpinOptions);
inherited;
end;
function TSpTBXSpinEditItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass;
begin
if not FAllowVerticalEditor and (AView.Orientation = tbvoVertical) then
Result := inherited GetItemViewerClass(AView)
else
Result := TSpTBXSpinEditViewer;
end;
function TSpTBXSpinEditItem.GetValue: Extended;
begin
Result := SpinOptions.Value;
end;
procedure TSpTBXSpinEditItem.SetValue(const Value: Extended);
begin
SpinOptions.Value := Value;
end;
function TSpTBXSpinEditItem.GetValueChanged: TNotifyEvent;
begin
Result := SpinOptions.OnValueChanged;
end;
procedure TSpTBXSpinEditItem.SetValueChanged(const ValueChangedEvent: TNotifyEvent);
begin
SpinOptions.OnValueChanged := ValueChangedEvent;
end;
procedure TSpTBXSpinEditItem.SpinOptionsGetText(Sender: TObject;
var NewText: WideString; var Accept: Boolean);
begin
// Event used by SpinOptions to get the text from the edit control
NewText := Text;
end;
procedure TSpTBXSpinEditItem.SpinOptionsSetText(Sender: TObject;
const AText: WideString);
begin
// Event used by SpinOptions to set the edit control text
Text := AText;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXSpinEditViewer }
destructor TSpTBXSpinEditViewer.Destroy;
begin
FreeAndNil(FTimer);
inherited;
end;
function TSpTBXSpinEditViewer.GetAccRole: Integer;
const
ROLE_SYSTEM_SPINBUTTON = $34;
begin
Result := ROLE_SYSTEM_SPINBUTTON;
end;
function TSpTBXSpinEditViewer.GetIndentAfter: Integer;
begin
if IsToolbarStyle then
Result := DefaultSpinButtonSize + 1
else
Result := GetSystemMetrics(SM_CXMENUCHECK) + 1;
end;
function TSpTBXSpinEditViewer.GetItem: TSpTBXSpinEditItem;
begin
Result := (inherited Item) as TSpTBXSpinEditItem;
end;
function TSpTBXSpinEditViewer.HandleEditMessage(var Message: TMessage): Boolean;
begin
if Message.Msg = WM_CHAR then
case TWMChar(Message).CharCode of
VK_TAB, VK_RETURN:
begin
Item.Text := EditControl.Text;
Item.SpinOptions.UpdateValueFromText;
EditControl.Text := Item.Text;
end;
end
else
if Message.Msg = WM_KEYDOWN then
case TWMKeyDown(Message).CharCode of
VK_UP:
begin
Item.SpinOptions.ValueInc;
EditControl.Text := Item.Text;
EditControl.SelectAll;
Result := True;
Exit;
end;
VK_DOWN:
begin
Item.SpinOptions.ValueDec;
EditControl.Text := Item.Text;
EditControl.SelectAll;
Result := True;
Exit;
end;
end;
Result := inherited HandleEditMessage(Message);
end;
procedure TSpTBXSpinEditViewer.InternalDrawFrame(ACanvas: TCanvas; ARect: TRect;
ItemInfo: TSpTBXMenuItemInfo);
var
IsHotTrack: Boolean;
R: TRect;
begin
inherited;
R := ARect;
InflateRect(R, -2, -2);
R.Left := ARect.Right - GetIndentAfter;
IsHotTrack := ItemInfo.HotTrack;
SpDrawXPSpinButton(ACanvas, R, ItemInfo.Enabled, IsHotTrack, IsHotTrack, IsHotTrack, FUpPushed, FDownPushed, True, sknSkin);
end;
procedure TSpTBXSpinEditViewer.InternalEditControlChange(Sender: TObject);
var
L, L2: Integer;
begin
if Item.ExtendedAccept then begin
Item.Text := EditControl.Text;
Item.SpinOptions.UpdateValueFromText(False); // Don't revert when an invalid text is entered
// Change the EditControl text and reposition the edit caret
L := Length(EditControl.Text);
EditControl.Text := Item.Text;
L2 := Length(EditControl.Text);
if L2 > L then
EditControl.SelStart := L + Length(Item.SpinOptions.Prefix);
end
else
inherited;
end;
procedure TSpTBXSpinEditViewer.InternalEditControlExit;
begin
Item.Text := EditControl.Text;
Item.SpinOptions.UpdateValueFromText;
EditControl.Text := Item.Text;
end;
procedure TSpTBXSpinEditViewer.InvalidateButtons;
var
R: TRect;
begin
if Show and not IsRectEmpty(BoundsRect) then begin
R := BoundsRect;
R.Left := R.Right - GetIndentAfter;
InvalidateRect(View.Window.Handle, @R, False);
Include(State, tbisInvalidated);
end;
end;
function TSpTBXSpinEditViewer.IsPtInButtonPart(X, Y: Integer): Boolean;
begin
Result := X <= (BoundsRect.Right - BoundsRect.Left) - GetIndentAfter;
end;
procedure TSpTBXSpinEditViewer.LosingCapture;
begin
FUpPushed := False;
FDownPushed := False;
FreeAndNil(FTimer);
inherited;
end;
procedure TSpTBXSpinEditViewer.MouseDown(Shift: TShiftState; X, Y: Integer;
var MouseDownOnMenu: Boolean);
begin
if not Item.Enabled then Exit;
FUpPushed := False;
FDownPushed := False;
if X >= BoundsRect.Right - BoundsRect.Left - GetIndentAfter then begin
if Y < (BoundsRect.Bottom - BoundsRect.Top) div 2 then begin
FUpPushed := True;
Item.SpinOptions.ValueInc;
end
else begin
FDownPushed := True;
Item.SpinOptions.ValueDec;
end;
if not Assigned(FTimer) then begin
FTimer := TTimer.Create(nil);
FTimer.OnTimer := TimerHandler;
end;
FTimer.Interval := 400;
FTimer.Enabled := True;
end;
if FUpPushed or FDownPushed then begin
InvalidateButtons;
inherited;
View.SetCapture;
end
else
inherited;
end;
procedure TSpTBXSpinEditViewer.MouseUp(X, Y: Integer; MouseWasDownOnMenu: Boolean);
begin
if FUpPushed or FDownPushed then begin
FUpPushed := False;
FDownPushed := False;
FreeAndNil(FTimer);
InvalidateButtons;
end;
inherited;
end;
procedure TSpTBXSpinEditViewer.TimerHandler(Sender: TObject);
begin
FTimer.Interval := 100;
if FUpPushed then Item.SpinOptions.ValueInc
else
if FDownPushed then Item.SpinOptions.ValueDec
else FreeAndNil(FTimer);
end;
end.
Reference in New Issue View Git Blame Copy Permalink