david
47aaf11578
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@38 05c56307-c608-d34a-929d-697000501d7a
6947 lines
192 KiB
ObjectPascal
6947 lines
192 KiB
ObjectPascal
|
|
{*******************************************************************}
|
|
{ }
|
|
{ Developer Express Visual Component Library }
|
|
{ ExpressBars extended items }
|
|
{ }
|
|
{ Copyright (c) 1998-2009 Developer Express Inc. }
|
|
{ ALL RIGHTS RESERVED }
|
|
{ }
|
|
{ The entire contents of this file is protected by U.S. and }
|
|
{ International Copyright Laws. Unauthorized reproduction, }
|
|
{ reverse-engineering, and distribution of all or any portion of }
|
|
{ the code contained in this file is strictly prohibited and may }
|
|
{ result in severe civil and criminal penalties and will be }
|
|
{ prosecuted to the maximum extent possible under the law. }
|
|
{ }
|
|
{ RESTRICTIONS }
|
|
{ }
|
|
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
|
|
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
|
|
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
|
|
{ LICENSED TO DISTRIBUTE THE EXPRESSBARS AND ALL ACCOMPANYING VCL }
|
|
{ CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
|
|
{ }
|
|
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
|
|
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
|
|
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
|
|
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
|
|
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
|
|
{ }
|
|
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
|
|
{ ADDITIONAL RESTRICTIONS. }
|
|
{ }
|
|
{*******************************************************************}
|
|
|
|
unit dxBarExtItems;
|
|
|
|
{$I cxVer.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, CommCtrl, Classes, Controls, Forms, Graphics, Dialogs,
|
|
StdCtrls, ComCtrls,{$IFDEF DELPHI4} ImgList,{$ENDIF} dxBar, dxCommon;
|
|
|
|
type
|
|
TdxBarStatic = class(TdxBarItem)
|
|
private
|
|
FAlignment: TAlignment;
|
|
FAllowClick: Boolean;
|
|
FBorderStyle: TdxBarStaticBorderStyle;
|
|
FHeight: Integer;
|
|
FLeftIndent: Integer;
|
|
FRightIndent: Integer;
|
|
FShowCaption: Boolean;
|
|
FWidth: Integer;
|
|
procedure SetAlignment(Value: TAlignment);
|
|
procedure SetBorderStyle(Value: TdxBarStaticBorderStyle);
|
|
procedure SetShowCaption(Value: Boolean);
|
|
procedure SetSizeValue(Index: Integer; Value: Integer);
|
|
protected
|
|
function CanClicked: Boolean; override;
|
|
function HasAccel(AItemLink: TdxBarItemLink): Boolean; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
published
|
|
property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
|
|
property AllowClick: Boolean read FAllowClick write FAllowClick default False;
|
|
property BorderStyle: TdxBarStaticBorderStyle read FBorderStyle write SetBorderStyle
|
|
default sbsNone;
|
|
property Glyph;
|
|
property Height: Integer index 4 read FHeight write SetSizeValue default 0;
|
|
property ImageIndex;
|
|
property LeftIndent: Integer index 1 read FLeftIndent write SetSizeValue default 0;
|
|
property RightIndent: Integer index 2 read FRightIndent write SetSizeValue default 0;
|
|
property ShowCaption: Boolean read FShowCaption write SetShowCaption default True;
|
|
property Width: Integer index 3 read FWidth write SetSizeValue default 0;
|
|
property OnClick;
|
|
end;
|
|
|
|
TdxBarStaticControl = class(TdxBarItemControl)
|
|
private
|
|
function GetBorderStyle: TdxBarStaticBorderStyle;
|
|
function GetBorderWidth: Integer;
|
|
function GetItem: TdxBarStatic;
|
|
function GetSizeValue(Index: Integer): Integer;
|
|
protected
|
|
function CanClicked: Boolean; override;
|
|
function CanHaveZeroSize: Boolean; virtual;
|
|
function CanMouseSelect: Boolean; override;
|
|
function CanSelect: Boolean; override;
|
|
procedure CaptionChanged; override;
|
|
procedure DrawGlyphAndCaption(DC: HDC; ARect: TRect;
|
|
PaintType: TdxBarPaintType; AllowCenter: Boolean);
|
|
procedure DrawInterior(DC: HDC; ARect: TRect; PaintType: TdxBarPaintType); virtual;
|
|
procedure GlyphChanged; override;
|
|
function GetAlignment: TAlignment; virtual;
|
|
function GetAutoWidth: Integer;
|
|
function GetDefaultHeight: Integer; virtual;
|
|
function GetDefaultWidth: Integer; virtual;
|
|
function GetHeight: Integer; override;
|
|
function GetWidth: Integer; override;
|
|
function IsDestroyOnClick: Boolean; override;
|
|
procedure Paint(ARect: TRect; PaintType: TdxBarPaintType); override;
|
|
|
|
property Alignment: TAlignment read GetAlignment;
|
|
property BorderStyle: TdxBarStaticBorderStyle read GetBorderStyle;
|
|
property BorderWidth: Integer read GetBorderWidth;
|
|
property Height: Integer index 4 read GetSizeValue;
|
|
property LeftIndent: Integer index 1 read GetSizeValue;
|
|
property RightIndent: Integer index 2 read GetSizeValue;
|
|
property Width: Integer index 3 read GetSizeValue;
|
|
public
|
|
property Item: TdxBarStatic read GetItem;
|
|
end;
|
|
|
|
TdxBarGlyphLayout = (glLeft, glRight, glTop, glBottom);
|
|
|
|
TdxBarLargeButton = class(TdxBarButton)
|
|
private
|
|
FAutoGrayScale: Boolean;
|
|
FGlyphLayout: TdxBarGlyphLayout;
|
|
FHeight: Integer;
|
|
FHotImageIndex: Integer;
|
|
FInSyncImageIndex: Boolean;
|
|
FLargeGlyph, FHotGlyph: TBitmap;
|
|
FLargeImageIndex: Integer;
|
|
FShowCaption: Boolean;
|
|
FSyncImageIndex: Boolean;
|
|
FWidth: Integer;
|
|
|
|
FSetImageIndex: Boolean;
|
|
FSetLargeImageIndex: Boolean;
|
|
FSetSyncImageIndex: Boolean;
|
|
|
|
function IsImageIndexStored: Boolean;
|
|
function IsLargeImageIndexStored: Boolean;
|
|
procedure SetAutoGrayScale(Value: Boolean);
|
|
procedure SetGlyphLayout(Value: TdxBarGlyphLayout);
|
|
procedure SetHeight(Value: Integer);
|
|
procedure SetHotGlyph(Value: TBitmap);
|
|
procedure SetHotImageIndex(Value: Integer);
|
|
procedure SetLargeGlyph(Value: TBitmap);
|
|
procedure SetLargeImageIndex(Value: Integer);
|
|
procedure SetShowCaption(Value: Boolean);
|
|
procedure SetSyncImageIndex(Value: Boolean);
|
|
procedure SetWidth(Value: Integer);
|
|
|
|
procedure OnHotGlyphChanged(Sender: TObject);
|
|
procedure OnLargeGlyphChanged(Sender: TObject);
|
|
protected
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
procedure Loaded; override;
|
|
procedure ReadImageIndex(Reader: TReader);
|
|
procedure WriteImageIndex(Writer: TWriter);
|
|
{$IFDEF DELPHI4}
|
|
function GetActionImageIndex: Integer; override;
|
|
procedure SetActionImageIndex(Value: Integer); override;
|
|
{$ENDIF}
|
|
procedure GlyphLayoutChanged; virtual;
|
|
function HasAccel(AItemLink: TdxBarItemLink): Boolean; override;
|
|
procedure HeightChanged; virtual;
|
|
procedure HotGlyphChanged; override;
|
|
function IsHotImageLinked: Boolean;
|
|
function IsLargeImageLinked: Boolean;
|
|
procedure LargeGlyphChanged; override;
|
|
procedure SetImageIndex(Value: Integer); override;
|
|
procedure ShowCaptionChanged; virtual;
|
|
function UseHotImages: Boolean; override;
|
|
function UseLargeImages: Boolean; override;
|
|
procedure WidthChanged; virtual;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
property AutoGrayScale: Boolean read FAutoGrayScale write SetAutoGrayScale default True;
|
|
property GlyphLayout: TdxBarGlyphLayout read FGlyphLayout write SetGlyphLayout default glTop;
|
|
property Height: Integer read FHeight write SetHeight default 0;
|
|
property HotGlyph: TBitmap read FHotGlyph write SetHotGlyph;
|
|
property HotImageIndex: Integer read FHotImageIndex write SetHotImageIndex default -1;
|
|
property LargeGlyph: TBitmap read FLargeGlyph write SetLargeGlyph;
|
|
property LargeImageIndex: Integer read FLargeImageIndex write SetLargeImageIndex
|
|
{$IFDEF DELPHI4}stored IsLargeImageIndexStored {$ENDIF}default -1;
|
|
property ShowCaption: Boolean read FShowCaption write SetShowCaption default True;
|
|
property Width: Integer read FWidth write SetWidth default 0;
|
|
property ImageIndex stored False{see DefineProperties: IsImageIndexStored};
|
|
property SyncImageIndex: Boolean read FSyncImageIndex write SetSyncImageIndex default True;
|
|
end;
|
|
|
|
TdxBarLargeButtonControl = class(TdxBarButtonControl)
|
|
private
|
|
function GetHotGlyph: TBitmap;
|
|
function GetItem: TdxBarLargeButton;
|
|
function GetLargeGlyph: TBitmap;
|
|
|
|
function GetCurrentImage(ASelected: Boolean; var CurrentGlyph: TBitmap;
|
|
var CurrentImages: TCurImageList; var CurrentImageIndex: Integer): Boolean;
|
|
function IsSizeAssigned: Boolean;
|
|
protected
|
|
function ArrowWidth: Integer; override;
|
|
procedure GlyphLayoutChanged; virtual;
|
|
procedure HeightChanged; virtual;
|
|
procedure HotGlyphChanged; virtual;
|
|
procedure LargeGlyphChanged; virtual;
|
|
procedure ShowCaptionChanged; virtual;
|
|
procedure WidthChanged; virtual;
|
|
function GetDefaultHeight: Integer; override;
|
|
function GetDefaultWidth: Integer; override;
|
|
function GetHeight: Integer; override;
|
|
function GetImageEnabled(APaintType: TdxBarPaintType): Boolean; override;
|
|
function GetWidth: Integer; override;
|
|
procedure Paint(ARect: TRect; PaintType: TdxBarPaintType); override;
|
|
procedure PreparePaintStyleOnBar(var APaintStyle: TdxBarPaintStyle); override;
|
|
|
|
property HotGlyph: TBitmap read GetHotGlyph;
|
|
property LargeGlyph: TBitmap read GetLargeGlyph;
|
|
public
|
|
property Item: TdxBarLargeButton read GetItem;
|
|
end;
|
|
|
|
TdxBarColorCombo = class(TdxBarCustomCombo)
|
|
private
|
|
FAutoColor: TColor;
|
|
FAutoColorText: string;
|
|
FColor: TColor;
|
|
FCustomColorText: string;
|
|
FExchangeColor: TColor;
|
|
FHasExchangeColor: Boolean;
|
|
FInRefreshColorNames: Boolean;
|
|
FSettingColor: Boolean;
|
|
FShowAutoColor: Boolean;
|
|
FShowCustomColorButton: Boolean;
|
|
|
|
function GetCurColor: TColor;
|
|
procedure SetAutoColor(Value: TColor);
|
|
procedure SetAutoColorText(Value: string);
|
|
procedure SetColor(Value: TColor);
|
|
procedure SetCurColor(Value: TColor);
|
|
procedure SetCustomColorText(Value: string);
|
|
procedure SetShowAutoColor(Value: Boolean);
|
|
procedure SetShowCustomColorButton(Value: Boolean);
|
|
|
|
procedure CreateItemsList;
|
|
function GetColorByIndex(AIndex: Integer): TColor;
|
|
function GetIndexOfColor(AColor: TColor): Integer;
|
|
function IsAutoColorTextStored: Boolean;
|
|
function IsCustomColorTextStored: Boolean;
|
|
function IsDropDownCountStored: Boolean;
|
|
protected
|
|
procedure Change; override;
|
|
procedure DrawItem(AIndex: Integer; ARect: TRect; AState: TOwnerDrawState); override;
|
|
procedure MeasureItem(AIndex: Integer; var AHeight: Integer); override;
|
|
procedure MeasureItemWidth(AIndex: Integer; var AWidth: Integer); override;
|
|
property ExchangeColor: TColor read FExchangeColor;
|
|
property HasExchangeColor: Boolean read FHasExchangeColor;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure DoClick; override;
|
|
procedure RefreshColorNames;
|
|
property CurColor: TColor read GetCurColor write SetCurColor;
|
|
published
|
|
property AutoColor: TColor read FAutoColor write SetAutoColor default clWindowText;
|
|
property AutoColorText: string read FAutoColorText write SetAutoColorText
|
|
stored IsAutoColorTextStored;
|
|
property Color: TColor read FColor write SetColor;
|
|
property CustomColorText: string read FCustomColorText write SetCustomColorText
|
|
stored IsCustomColorTextStored;
|
|
property DropDownCount stored IsDropDownCountStored;
|
|
property ShowAutoColor: Boolean read FShowAutoColor write SetShowAutoColor default False;
|
|
property ShowCustomColorButton: Boolean read FShowCustomColorButton
|
|
write SetShowCustomColorButton default False;
|
|
property ShowEditor default False;
|
|
property Text stored False;
|
|
end;
|
|
|
|
TdxBarColorComboControl = class(TdxBarComboControl)
|
|
private
|
|
FCustomColorButtonRect: TRect;
|
|
function GetItem: TdxBarColorCombo;
|
|
protected
|
|
function DrawSelected: Boolean; override;
|
|
procedure PressedChanged; override;
|
|
procedure Paint(ARect: TRect; PaintType: TdxBarPaintType); override;
|
|
procedure WndProc(var Message: TMessage); override;
|
|
property CustomColorButtonRect: TRect read FCustomColorButtonRect;
|
|
public
|
|
property Item: TdxBarColorCombo read GetItem;
|
|
end;
|
|
|
|
TdxBarFontNameCombo = class(TdxBarCustomCombo)
|
|
protected
|
|
procedure DrawItem(AIndex: Integer; ARect: TRect; AState: TOwnerDrawState); override;
|
|
procedure LoadFontNames;
|
|
procedure MeasureItemWidth(AIndex: Integer; var AWidth: Integer); override;
|
|
procedure SetText(Value: string); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure DoClick; override;
|
|
published
|
|
property ShowEditor default False;
|
|
end;
|
|
|
|
TDayOfWeek = 0..6;
|
|
TDay = (dSunday, dMonday, dTuesday, dWednesday, dThursday, dFriday, dSaturday);
|
|
TDays = set of TDay;
|
|
TdxBarCalendarStyle = (cs3D, csFlat, csUltraFlat);
|
|
|
|
TdxBarCustomCalendar = class(TCustomControl)
|
|
private
|
|
FDragDate: TDateTime;
|
|
FFirstDate: TDateTime;
|
|
FSelStart: TDateTime;
|
|
FSelFinish: TDateTime;
|
|
FStyle: TdxBarCalendarStyle;
|
|
|
|
FOnDateTimeChanged: TNotifyEvent;
|
|
|
|
function GetFlat: Boolean;
|
|
function GetUltraFlat: Boolean;
|
|
procedure SetStyle(Value: TdxBarCalendarStyle);
|
|
|
|
procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE;
|
|
procedure WMCaptureChanged(var Message: TMessage); message WM_CAPTURECHANGED;
|
|
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
|
|
protected
|
|
function GetStyle: TdxBarCalendarStyle; virtual;
|
|
function GetRealFirstDate: TDateTime; virtual;
|
|
function GetRealLastDate: TDateTime; virtual;
|
|
function GetLastDate: TDateTime; virtual; abstract;
|
|
function GetSelStart: TDateTime; virtual;
|
|
function GetSelFinish: TDateTime; virtual;
|
|
procedure SetFirstDate(Value: TDateTime); virtual;
|
|
procedure SetSelStart(Value: TDateTime); virtual;
|
|
procedure SetSelFinish(Value: TDateTime); virtual;
|
|
|
|
procedure CancelAll; dynamic;
|
|
procedure CheckFirstDate; virtual; abstract;
|
|
procedure DoDateTimeChanged; dynamic;
|
|
procedure DoInternalSelectPeriod(ADate: TDateTime);
|
|
function PosToDateTime(P: TPoint): TDateTime; virtual; abstract;
|
|
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure CreateWnd; override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
|
|
property Flat: Boolean read GetFlat;
|
|
property UltraFlat: Boolean read GetUltraFlat;
|
|
|
|
property RealFirstDate: TDateTime read GetRealFirstDate;
|
|
property RealLastDate: TDateTime read GetRealLastDate;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
|
|
property FirstDate: TDateTime read FFirstDate write SetFirstDate;
|
|
property LastDate: TDateTime read GetLastDate;
|
|
property SelStart: TDateTime read GetSelStart write SetSelStart;
|
|
property SelFinish: TDateTime read GetSelFinish write SetSelFinish;
|
|
property Style: TdxBarCalendarStyle read GetStyle write SetStyle;
|
|
property OnDateTimeChanged: TNotifyEvent read FOnDateTimeChanged
|
|
write FOnDateTimeChanged;
|
|
end;
|
|
|
|
TdxBarDateCombo = class;
|
|
|
|
TdxBarDateNavigator = class(TdxBarCustomCalendar)
|
|
private
|
|
FCombo: TdxBarDateCombo;
|
|
|
|
FColCount: Integer;
|
|
FRowCount: Integer;
|
|
FColWidth, FSideWidth,
|
|
FRowHeight, FHeaderHeight, FDaysOfWeekHeight: Integer;
|
|
FTodayButtonWidth, FClearButtonWidth, FButtonsOffset, FButtonsHeight,
|
|
FButtonsRegionHeight: Integer;
|
|
FListBox: TWinControl;
|
|
FListBoxDelta: Integer;
|
|
FTimer: UINT;
|
|
FTodayButtonActive, FTodayButtonPressed: Boolean;
|
|
FClearButtonActive, FClearButtonPressed: Boolean;
|
|
|
|
procedure CheckSelection(MarginDate: TDateTime);
|
|
function ColOfDate(ADate: TDateTime): Integer;
|
|
function GetHeaderRect: TRect;
|
|
function GetInternalRect: TRect;
|
|
function GetLeftArrowRect: TRect;
|
|
function GetRightArrowRect: TRect;
|
|
function GetMonthNameRect: TRect;
|
|
function GetTodayButtonRect: TRect;
|
|
function GetClearButtonRect: TRect;
|
|
function GetShowButtonsArea: Boolean;
|
|
procedure FreeTimer;
|
|
procedure RepaintTodayButton;
|
|
procedure RepaintClearButton;
|
|
|
|
procedure WMDestroy(var Message: TMessage); message WM_DESTROY;
|
|
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
|
|
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
|
|
procedure WMSize(var Message: TWMSize); message WM_SIZE;
|
|
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
|
|
protected
|
|
function GetStyle: TdxBarCalendarStyle; override;
|
|
function GetRealFirstDate: TDateTime; override;
|
|
function GetRealLastDate: TDateTime; override;
|
|
function GetLastDate: TDateTime; override;
|
|
procedure SetFirstDate(Value: TDateTime); override;
|
|
procedure SetSelFinish(Value: TDateTime); override;
|
|
procedure StepToPast;
|
|
procedure StepToFuture;
|
|
procedure CancelAll; override;
|
|
procedure CheckFirstDate; override;
|
|
procedure DeactivateAll;
|
|
function PosToDateTime(P: TPoint): TDateTime; override;
|
|
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure CreateWnd; override;
|
|
procedure DblClick; override;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure Paint; override;
|
|
|
|
property ColCount: Integer read FColCount;
|
|
property RowCount: Integer read FRowCount;
|
|
property ShowButtonsArea: Boolean read GetShowButtonsArea;
|
|
public
|
|
IsPopup: Boolean;
|
|
ShowTodayButton, ShowClearButton: Boolean;
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure SetSize;
|
|
function GetWidth: Integer;
|
|
function GetHeight: Integer;
|
|
end;
|
|
|
|
TdxBarDateOnStart = (bdsToday, bdsNullDate, bdsCustom);
|
|
|
|
TdxBarDateCombo = class(TCustomdxBarCombo)
|
|
private
|
|
FDateOnStart: TdxBarDateOnStart;
|
|
FDatePopup, FDateNavigator: TdxBarDateNavigator;
|
|
FDateEdit: TEdit;
|
|
FForm: TForm;
|
|
FInternalUpdate: Boolean;
|
|
FMinDate: TDateTime;
|
|
FMaxDate: TDateTime;
|
|
FShowDayText: Boolean;
|
|
FShowTodayButton: Boolean;
|
|
FShowClearButton: Boolean;
|
|
function GetCurDate: TDateTime;
|
|
function GetDate: TDateTime;
|
|
procedure SetCurDate(Value: TDateTime);
|
|
procedure SetDate(Value: TDateTime);
|
|
procedure DateChanged(Sender: TObject);
|
|
procedure DialogClick(Sender: TObject);
|
|
procedure DialogDateChanged(Sender: TObject);
|
|
procedure DialogDateEditChange(Sender: TObject);
|
|
function GetDateOfText(AText: string): TDateTime;
|
|
function GetDateText(ADate: TDateTime): string;
|
|
function IsMinDateStored: Boolean;
|
|
function IsMaxDateStored: Boolean;
|
|
function IsTextStored: Boolean;
|
|
procedure SetDateOnStart(Value: TdxBarDateOnStart);
|
|
procedure SetMinDate(Value: TDateTime);
|
|
procedure SetMaxDate(Value: TDateTime);
|
|
procedure SetShowDayText(Value: Boolean);
|
|
protected
|
|
procedure Loaded; override;
|
|
procedure Changed;
|
|
procedure CheckDateOnStart;
|
|
procedure CheckRange;
|
|
function CheckKeyForDropDownWindow(Key: Word; Shift: TShiftState): Boolean; override;
|
|
procedure CloseUp; override;
|
|
procedure DropDown(X, Y: Integer); override;
|
|
function GetDropDownWindow: HWND; override;
|
|
procedure SetText(Value: string); override;
|
|
|
|
property DatePopup: TdxBarDateNavigator read FDatePopup;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function CheckDate(ADate: TDateTime): TDateTime;
|
|
procedure DoClick; override;
|
|
|
|
property CurDate: TDateTime read GetCurDate write SetCurDate;
|
|
property Date: TDateTime read GetDate write SetDate;
|
|
published
|
|
property DateOnStart: TdxBarDateOnStart read FDateOnStart write SetDateOnStart default bdsToday;
|
|
property MaxDate: TDateTime read FMaxDate write SetMaxDate stored IsMaxDateStored;
|
|
property MinDate: TDateTime read FMinDate write SetMinDate stored IsMinDateStored;
|
|
property ShowTodayButton: Boolean read FShowTodayButton write FShowTodayButton default True;
|
|
property ShowClearButton: Boolean read FShowClearButton write FShowClearButton default True;
|
|
property ShowDayText: Boolean read FShowDayText write SetShowDayText default True;
|
|
property Text stored IsTextStored;
|
|
end;
|
|
|
|
TdxBarDateComboControl = class(TCustomdxBarComboControl)
|
|
private
|
|
function GetDate: TDateTime;
|
|
function GetItem: TdxBarDateCombo;
|
|
procedure SetDate(const Value: TDateTime);
|
|
protected
|
|
procedure WndProc(var Message: TMessage); override;
|
|
property Date: TDateTime read GetDate write SetDate;
|
|
public
|
|
property Item: TdxBarDateCombo read GetItem;
|
|
end;
|
|
|
|
TdxBarTreeViewCombo = class;
|
|
|
|
{$IFNDEF DELPHI6}
|
|
|
|
TdxBarTreeNode = class(TTreeNode)
|
|
public
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
TdxBarTreeView = class(TCustomTreeView)
|
|
private
|
|
FCloseButtonRect, FGripRect: TRect;
|
|
FCloseButtonIsTracking: Boolean;
|
|
FCombo: TdxBarTreeViewCombo;
|
|
FCorner: TdxCorner;
|
|
FMouseAboveCloseButton: Boolean;
|
|
function FindNode(const AText: string): TTreeNode;
|
|
procedure SaveAndHide;
|
|
procedure TVMSetImageList(var Message: TMessage); message TVM_SETIMAGELIST;
|
|
procedure TVMSetItem(var Message: TMessage); message TVM_SETITEM;
|
|
procedure WMCaptureChanged(var Message: TMessage); message WM_CAPTURECHANGED;
|
|
procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
|
|
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
|
|
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
|
|
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
|
|
procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
|
|
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
|
|
procedure WMSysColorChange(var Message: TWMSysColorChange); message WM_SYSCOLORCHANGE;
|
|
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
|
|
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
|
|
protected
|
|
procedure Change(Node: TTreeNode); override;
|
|
{$IFNDEF DELPHI6}
|
|
function CreateNode: TTreeNode; override;
|
|
{$ENDIF}
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure CreateWnd; override;
|
|
procedure DblClick; override;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
public
|
|
IsPopup: Boolean;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure SetFocus; override;
|
|
property Items;
|
|
property OnDeletion;
|
|
property Combo: TdxBarTreeViewCombo read FCombo;
|
|
end;
|
|
|
|
TdxBarTreeViewComboCanSelectNodeEvent = procedure(Sender: TdxBarTreeViewCombo;
|
|
Node: TTreeNode; var CanSelect: Boolean) of object;
|
|
|
|
TdxBarTreeViewCombo = class(TCustomdxBarCombo)
|
|
private
|
|
FAllowResizing: Boolean;
|
|
FButtonOk, FButtonCancel: TButton;
|
|
FChooseByDblClick: Boolean;
|
|
FForm: TForm;
|
|
FFormTreeView, FTreeView: TdxBarTreeView;
|
|
FFullExpand: Boolean;
|
|
FInSelectedNodeChanged: Boolean;
|
|
FLoadedText: string;
|
|
FSelectedNode: TTreeNode;
|
|
FShowImageInEdit: Boolean;
|
|
FOnCanSelectNode: TdxBarTreeViewComboCanSelectNodeEvent;
|
|
|
|
function GetDropDownHeight: Integer;
|
|
function GetDropDownWidth: Integer;
|
|
function GetImages: TCurImageList;
|
|
function GetIndent: Integer;
|
|
function GetItems: TTreeNodes;
|
|
function GetShowButtons: Boolean;
|
|
function GetShowLines: Boolean;
|
|
function GetShowRoot: Boolean;
|
|
function GetSortType: TSortType;
|
|
function GetStateImages: TCurImageList;
|
|
function GetOnExpanded: TTVExpandedEvent;
|
|
function GetOnExpanding: TTVExpandingEvent;
|
|
function GetOnChanging: TTVChangingEvent;
|
|
function GetOnCollapsed: TTVExpandedEvent;
|
|
function GetOnCollapsing: TTVCollapsingEvent;
|
|
function GetOnCompare: TTVCompareEvent;
|
|
function GetOnGetImageIndex: TTVExpandedEvent;
|
|
function GetOnGetSelectedIndex: TTVExpandedEvent;
|
|
function GetOnTreeViewChange: TTVChangedEvent;
|
|
|
|
procedure SetDropDownHeight(Value: Integer);
|
|
procedure SetDropDownWidth(Value: Integer);
|
|
procedure SetImages(Value: TCurImageList);
|
|
procedure SetIndent(Value: Integer);
|
|
procedure SetItems(Value: TTreeNodes);
|
|
procedure SetSelectedNode(Value: TTreeNode);
|
|
procedure SetShowButtons(Value: Boolean);
|
|
procedure SetShowImageInEdit(Value: Boolean);
|
|
procedure SetShowLines(Value: Boolean);
|
|
procedure SetShowRoot(Value: Boolean);
|
|
procedure SetSortType(Value: TSortType);
|
|
procedure SetStateImages(Value: TCurImageList);
|
|
procedure SetOnExpanded(Value: TTVExpandedEvent);
|
|
procedure SetOnExpanding(Value: TTVExpandingEvent);
|
|
procedure SetOnChanging(Value: TTVChangingEvent);
|
|
procedure SetOnCollapsed(Value: TTVExpandedEvent);
|
|
procedure SetOnCollapsing(Value: TTVCollapsingEvent);
|
|
procedure SetOnCompare(Value: TTVCompareEvent);
|
|
procedure SetOnGetImageIndex(Value: TTVExpandedEvent);
|
|
procedure SetOnGetSelectedIndex(Value: TTVExpandedEvent);
|
|
procedure SetOnTreeViewChange(Value: TTVChangedEvent);
|
|
|
|
procedure FormSize(Sender: TObject);
|
|
protected
|
|
function CheckKeyForDropDownWindow(Key: Word; Shift: TShiftState): Boolean; override;
|
|
function DoCanSelectNode: Boolean;
|
|
procedure DoSelectedNodeChanged; virtual;
|
|
procedure DrawInterior(ABarEditControl: TdxBarEditControl; ACanvas: TCanvas;
|
|
R: TRect; ItemLink: TdxBarItemLink); override;
|
|
procedure DropDown(X, Y: Integer); override;
|
|
function GetDropDownWindow: HWND; override;
|
|
function HasImageInEdit: Boolean;
|
|
procedure Loaded; override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure SetText(Value: string); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure DoClick; override;
|
|
|
|
property SelectedNode: TTreeNode read FSelectedNode write SetSelectedNode;
|
|
property TreeView: TdxBarTreeView read FTreeView;
|
|
published
|
|
property AllowResizing: Boolean read FAllowResizing write FAllowResizing default True;
|
|
property ChooseByDblClick: Boolean read FChooseByDblClick write FChooseByDblClick default True;
|
|
property DropDownHeight: Integer read GetDropDownHeight write SetDropDownHeight default 200;
|
|
property DropDownWidth: Integer read GetDropDownWidth write SetDropDownWidth default 150;
|
|
property FullExpand: Boolean read FFullExpand write FFullExpand default False;
|
|
property Images: TCurImageList
|
|
read GetImages write SetImages;
|
|
property Indent: Integer read GetIndent write SetIndent;
|
|
property Items: TTreeNodes read GetItems write SetItems;
|
|
property ShowButtons: Boolean read GetShowButtons write SetShowButtons;
|
|
property ShowEditor default False;
|
|
property ShowImageInEdit: Boolean read FShowImageInEdit write SetShowImageInEdit
|
|
default True;
|
|
property ShowLines: Boolean read GetShowLines write SetShowLines;
|
|
property ShowRoot: Boolean read GetShowRoot write SetShowRoot;
|
|
property SortType: TSortType read GetSortType write SetSortType;
|
|
property StateImages: TCurImageList
|
|
read GetStateImages write SetStateImages;
|
|
|
|
property OnExpanded: TTVExpandedEvent read GetOnExpanded write SetOnExpanded;
|
|
property OnExpanding: TTVExpandingEvent read GetOnExpanding write SetOnExpanding;
|
|
property OnCanSelectNode: TdxBarTreeViewComboCanSelectNodeEvent read FOnCanSelectNode
|
|
write FOnCanSelectNode;
|
|
property OnChanging: TTVChangingEvent read GetOnChanging write SetOnChanging;
|
|
property OnCollapsed: TTVExpandedEvent read GetOnCollapsed write SetOnCollapsed;
|
|
property OnCollapsing: TTVCollapsingEvent read GetOnCollapsing write SetOnCollapsing;
|
|
property OnCompare: TTVCompareEvent read GetOnCompare write SetOnCompare;
|
|
property OnGetImageIndex: TTVExpandedEvent read GetOnGetImageIndex write SetOnGetImageIndex;
|
|
property OnGetSelectedIndex: TTVExpandedEvent read GetOnGetSelectedIndex write SetOnGetSelectedIndex;
|
|
property OnTreeViewChange: TTVChangedEvent read GetOnTreeViewChange write SetOnTreeViewChange;
|
|
end;
|
|
|
|
TdxBarTreeViewComboControl = class(TCustomdxBarComboControl)
|
|
private
|
|
function GetItem: TdxBarTreeViewCombo;
|
|
protected
|
|
function GetHeight: Integer; override;
|
|
procedure SetFocused(Value: Boolean); override;
|
|
public
|
|
property Item: TdxBarTreeViewCombo read GetItem;
|
|
end;
|
|
|
|
TdxBarImageCombo = class(TdxBarCustomCombo)
|
|
private
|
|
FDialogListBox: TListBox;
|
|
FForm: TForm;
|
|
FImageChangeLink: TChangeLink;
|
|
FImages: TCurImageList;
|
|
FShowText: Boolean;
|
|
|
|
function GetImageIndexes(Index: Integer): Integer;
|
|
procedure SetImageIndexes(Index: Integer; Value: Integer);
|
|
procedure SetImages(Value: TCurImageList);
|
|
procedure SetShowText(Value: Boolean);
|
|
procedure ImageListChange(Sender: TObject);
|
|
procedure ReadImageIndexes(Reader: TReader);
|
|
procedure WriteImageIndexes(Writer: TWriter);
|
|
|
|
procedure DialogListBoxDblClick(Sender: TObject);
|
|
procedure DialogListBoxDrawItem(Control: TWinControl; Index: Integer;
|
|
Rect: TRect; State: TOwnerDrawState);
|
|
procedure DialogListBoxMeasureItem(Control: TWinControl; Index: Integer;
|
|
var Height: Integer);
|
|
protected
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
procedure DrawItem(AIndex: Integer; ARect: TRect; AState: TOwnerDrawState); override;
|
|
procedure ImagesChanged; virtual;
|
|
procedure MeasureItem(AIndex: Integer; var AHeight: Integer); override;
|
|
procedure MeasureItemWidth(AIndex: Integer; var AWidth: Integer); override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure DoClick; override;
|
|
property ImageIndexes[Index: Integer]: Integer read GetImageIndexes write SetImageIndexes;
|
|
published
|
|
property Images: TCurImageList
|
|
read FImages write SetImages;
|
|
property Items;
|
|
property ShowEditor default False;
|
|
property Sorted;
|
|
property ItemIndex; // loading after all
|
|
property ShowText: Boolean read FShowText write SetShowText default True;
|
|
end;
|
|
|
|
TdxBarImageComboControl = class(TdxBarComboControl)
|
|
protected
|
|
function GetHeight: Integer; override;
|
|
procedure ImagesChanged; virtual;
|
|
end;
|
|
|
|
TdxBarToolbarsListItem = class(TCustomdxBarSubItem)
|
|
protected
|
|
function HasDesignTimeLinks: Boolean; override;
|
|
end;
|
|
|
|
TdxBarToolbarsListItemControl = class(TdxBarSubItemControl)
|
|
protected
|
|
procedure CreateSubMenuControl; override;
|
|
end;
|
|
|
|
TdxBarSpinEdit = class;
|
|
TdxBarSpinEditValueType = (svtInteger, svtFloat);
|
|
TdxBarSpinEditPrefixPlace = (ppStart, ppEnd);
|
|
TdxBarSpinEditButtonClickEvent = procedure(Sender: TdxBarSpinEdit;
|
|
Button: TdxBarSpinEditButton) of object;
|
|
|
|
TdxBarSpinEdit = class(TdxBarEdit)
|
|
private
|
|
FIncrement: Extended;
|
|
FMaxValue: Extended;
|
|
FMinValue: Extended;
|
|
FPrefix: string;
|
|
FPrefixPlace: TdxBarSpinEditPrefixPlace;
|
|
FValueType: TdxBarSpinEditValueType;
|
|
FOnButtonClick: TdxBarSpinEditButtonClickEvent;
|
|
|
|
function GetCurValue: Extended;
|
|
function GetIntCurValue: Integer;
|
|
function GetIntValue: Integer;
|
|
function GetValue: Extended;
|
|
procedure SetCurValue(Value: Extended);
|
|
procedure SetIncrement(Value: Extended);
|
|
procedure SetIntCurValue(Value: Integer);
|
|
procedure SetIntValue(Value: Integer);
|
|
procedure SetMaxValue(Value: Extended);
|
|
procedure SetMinValue(Value: Extended);
|
|
procedure SetPrefix(const Value: string);
|
|
procedure SetPrefixPlace(Value: TdxBarSpinEditPrefixPlace);
|
|
procedure SetValue(Value: Extended);
|
|
procedure SetValueType(Value: TdxBarSpinEditValueType);
|
|
|
|
function IsIncrementStored: Boolean;
|
|
function IsMaxValueStored: Boolean;
|
|
function IsMinValueStored: Boolean;
|
|
function IsValueStored: Boolean;
|
|
|
|
procedure AddPrefix(var Text: string);
|
|
procedure RemovePrefix(var Text: string);
|
|
protected
|
|
function CheckRange: Boolean;
|
|
procedure DoButtonClick(Button: TdxBarSpinEditButton);
|
|
function GetCheckedValue(Value: Extended): Extended;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure KeyPress(var Key: Char); override;
|
|
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
|
|
procedure PrepareValue(var Value: Extended);
|
|
function TextToValue(Text: string): Extended;
|
|
procedure SetText(Value: string); override;
|
|
function ValueToText(Value: Extended): string;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
property CurValue: Extended read GetCurValue write SetCurValue;
|
|
property IntCurValue: Integer read GetIntCurValue write SetIntCurValue;
|
|
property IntValue: Integer read GetIntValue write SetIntValue;
|
|
published
|
|
property ValueType: TdxBarSpinEditValueType read FValueType write SetValueType
|
|
default svtInteger; // must be loaded before all
|
|
property Increment: Extended read FIncrement write SetIncrement
|
|
stored IsIncrementStored;
|
|
property MaxValue: Extended read FMaxValue write SetMaxValue stored IsMaxValueStored;
|
|
property MinValue: Extended read FMinValue write SetMinValue stored IsMinValueStored;
|
|
property Prefix: string read FPrefix write SetPrefix;
|
|
property PrefixPlace: TdxBarSpinEditPrefixPlace read FPrefixPlace write SetPrefixPlace
|
|
default ppEnd;
|
|
property Text stored False;
|
|
property Value: Extended read GetValue write SetValue stored IsValueStored;
|
|
property OnButtonClick: TdxBarSpinEditButtonClickEvent read FOnButtonClick
|
|
write FOnButtonClick;
|
|
end;
|
|
|
|
TdxBarSpinEditControl = class(TdxBarEditControl)
|
|
private
|
|
FActiveButton: TdxBarSpinEditButton;
|
|
FButtonPressed: Boolean;
|
|
FButtonsRect: TRect;
|
|
FTimerID: UINT;
|
|
function GetItem: TdxBarSpinEdit;
|
|
procedure SetActiveButton(Value: TdxBarSpinEditButton);
|
|
procedure SetButtonPressed(Value: Boolean);
|
|
protected
|
|
procedure BreakProcess;
|
|
function ButtonFromPoint(P: TPoint): TdxBarSpinEditButton;
|
|
procedure Paint(ARect: TRect; PaintType: TdxBarPaintType); override;
|
|
procedure WndProc(var Message: TMessage); override;
|
|
property ActiveButton: TdxBarSpinEditButton read FActiveButton write SetActiveButton;
|
|
property ButtonPressed: Boolean read FButtonPressed write SetButtonPressed;
|
|
property ButtonsRect: TRect read FButtonsRect;
|
|
public
|
|
property Item: TdxBarSpinEdit read GetItem;
|
|
end;
|
|
|
|
TdxBarControlContainerItem = class(TdxBarItem)
|
|
private
|
|
FControl: TControl;
|
|
FPlace: TCustomForm;
|
|
FPrevControlSize: TPoint;
|
|
FPrevControlWndProc: TWndMethod;
|
|
function GetControlVisible: Boolean;
|
|
function GetInPlaceControl: Boolean;
|
|
procedure SetControl(Value: TControl);
|
|
procedure ControlWndProc(var Message: TMessage);
|
|
function IsControlAssigned(AControl: TControl): Boolean;
|
|
procedure SaveControlSize;
|
|
procedure SetControlVisible(Value: Boolean);
|
|
protected
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure SetName(const NewName: TComponentName); override;
|
|
|
|
function CanClicked: Boolean; override;
|
|
function GetHidden: Boolean; override;
|
|
function HasAccel(AItemLink: TdxBarItemLink): Boolean; override;
|
|
procedure HideControl(AControl: TdxBarItemControl); override;
|
|
function NeedToBeHidden: Boolean; override;
|
|
|
|
property ControlVisible: Boolean read GetControlVisible write SetControlVisible;
|
|
property InPlaceControl: Boolean read GetInPlaceControl;
|
|
property Place: TCustomForm read FPlace;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
property Control: TControl read FControl write SetControl;
|
|
end;
|
|
|
|
TdxBarControlContainerControl = class(TdxBarItemControl)
|
|
private
|
|
FInPlaceControl: Boolean;
|
|
FPlacedControl: Boolean;
|
|
function GetControl: TControl;
|
|
function GetItem: TdxBarControlContainerItem;
|
|
function GetPlace: TCustomForm;
|
|
protected
|
|
procedure BeforeDestroyParentHandle; override;
|
|
function CanClicked: Boolean; override;
|
|
function CanSelect: Boolean; override;
|
|
function GetHeight: Integer; override;
|
|
function GetWidth: Integer; override;
|
|
function IsDestroyOnClick: Boolean; override;
|
|
function IsShowingControl: Boolean;
|
|
function NeedCaptureMouse: Boolean; override;
|
|
procedure Paint(ARect: TRect; PaintType: TdxBarPaintType); override;
|
|
procedure PlaceControl;
|
|
procedure RealVisibleChanging(AVisible: Boolean); override;
|
|
function ShowsControl: Boolean;
|
|
|
|
property Control: TControl read GetControl;
|
|
property InPlaceControl: Boolean read FInPlaceControl;
|
|
property Place: TCustomForm read GetPlace;
|
|
public
|
|
destructor Destroy; override;
|
|
property Item: TdxBarControlContainerItem read GetItem;
|
|
end;
|
|
|
|
TdxBarProgressItem = class(TdxBarStatic)
|
|
private
|
|
FColor: TColor;
|
|
FMax: Integer;
|
|
FMin: Integer;
|
|
FPosition: Integer;
|
|
FSmooth: Boolean;
|
|
FStep: Integer;
|
|
procedure SetColor(Value: TColor);
|
|
procedure SetMax(Value: Integer);
|
|
procedure SetMin(Value: Integer);
|
|
procedure SetPosition(Value: Integer);
|
|
procedure SetSmooth(Value: Boolean);
|
|
procedure SetStep(Value: Integer);
|
|
protected
|
|
procedure UpdateBar;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure SetParams(AMin, AMax: Integer);
|
|
procedure StepBy(Delta: Integer);
|
|
procedure StepIt;
|
|
published
|
|
property BorderStyle default sbsLowered;
|
|
property Color: TColor read FColor write SetColor default clDefault;
|
|
property Max: Integer read FMax write SetMax default 100;
|
|
property Min: Integer read FMin write SetMin default 0;
|
|
property Position: Integer read FPosition write SetPosition default 0;
|
|
property Smooth: Boolean read FSmooth write SetSmooth default False;
|
|
property Step: Integer read FStep write SetStep default 10;
|
|
end;
|
|
|
|
TdxBarProgressControl = class(TdxBarStaticControl)
|
|
private
|
|
function GetItem: TdxBarProgressItem;
|
|
protected
|
|
function BarBrushColor: TColorRef; virtual;
|
|
function BarHeight: Integer;
|
|
function BarRect: TRect;
|
|
function BarWidth: Integer;
|
|
function CanHaveZeroSize: Boolean; override;
|
|
procedure DrawInterior(DC: HDC; ARect: TRect; PaintType: TdxBarPaintType); override;
|
|
function GetAlignment: TAlignment; override;
|
|
function GetDefaultHeight: Integer; override;
|
|
function GetDefaultWidth: Integer; override;
|
|
procedure UpdateBar;
|
|
public
|
|
property Item: TdxBarProgressItem read GetItem;
|
|
end;
|
|
|
|
TdxBarMRUListItem = class(TdxBarListItem)
|
|
private
|
|
FMaxItemCount: Integer;
|
|
FRemoveItemOnClick: Boolean;
|
|
procedure SetMaxItemCount(Value: Integer);
|
|
protected
|
|
procedure CheckItemCount;
|
|
function GetDisplayText(const AText: string): string; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure DirectClick; override;
|
|
procedure AddItem(const S: string; AObject: TObject);
|
|
procedure RemoveItem(const S: string; AObject: TObject);
|
|
published
|
|
property MaxItemCount: Integer read FMaxItemCount write SetMaxItemCount default 5;
|
|
property RemoveItemOnClick: Boolean read FRemoveItemOnClick
|
|
write FRemoveItemOnClick default False;
|
|
end;
|
|
|
|
TdxBarInPlaceSubItem = class;
|
|
|
|
TdxBarInPlaceSubItemEvent =
|
|
procedure(Sender: TdxBarInPlaceSubItem; Link: TdxBarItemLink) of object;
|
|
|
|
TdxBarInPlaceSubItem = class(TdxBarContainerItem)
|
|
private
|
|
FExpanded: Boolean;
|
|
FExpandedChanging: Boolean;
|
|
FKeepBeginGroupWhileExpanded: Boolean;
|
|
FOnAfterExpand: TdxBarInPlaceSubItemEvent;
|
|
FOnBeforeCollapse: TdxBarInPlaceSubItemEvent;
|
|
procedure SetExpanded(Value: Boolean);
|
|
protected
|
|
procedure AddListedItemLinks(AItemLinks: TdxBarItemLinks; AIndex: Integer;
|
|
FirstCall: Boolean; CallingItemLink: TdxBarItemLink); override;
|
|
procedure DeleteListedItemLinks(AItemLinks: TdxBarItemLinks; AIndex: Integer); override;
|
|
function HideWhenRun: Boolean; override;
|
|
function InternalActuallyVisible: Boolean; override;
|
|
|
|
procedure ChangeNextItemLinkBeginGroup(ALink: TdxBarItemLink; Value: Boolean);
|
|
procedure DoAfterExpand(ALink: TdxBarItemLink); dynamic;
|
|
procedure DoBeforeCollapse(ALink: TdxBarItemLink); dynamic;
|
|
published
|
|
property Expanded: Boolean read FExpanded write SetExpanded default False;
|
|
property KeepBeginGroupWhileExpanded: Boolean read FKeepBeginGroupWhileExpanded
|
|
write FKeepBeginGroupWhileExpanded;
|
|
property OnAfterExpand: TdxBarInPlaceSubItemEvent read FOnAfterExpand
|
|
write FOnAfterExpand;
|
|
property OnBeforeCollapse: TdxBarInPlaceSubItemEvent read FOnBeforeCollapse
|
|
write FOnBeforeCollapse;
|
|
end;
|
|
|
|
TdxBarInPlaceSubItemControl = class(TdxBarContainerItemControl)
|
|
private
|
|
function GetItem: TdxBarInPlaceSubItem;
|
|
protected
|
|
procedure ControlClick(ByMouse: Boolean); override;
|
|
procedure DblClick; override;
|
|
function GetDefaultHeight: Integer; override;
|
|
function GetDefaultWidth: Integer; override;
|
|
function HasSubMenu: Boolean; override;
|
|
function IsExpandable: Boolean; override;
|
|
function IsInvertTextColor: Boolean; override;
|
|
procedure KeyDown(Key: Word); override;
|
|
procedure Paint(ARect: TRect; PaintType: TdxBarPaintType); override;
|
|
function WantsKey(Key: Word): Boolean; override;
|
|
public
|
|
property Item: TdxBarInPlaceSubItem read GetItem;
|
|
end;
|
|
|
|
var
|
|
// first day of week
|
|
StartOfWeek: Word; //TDayOfWeek;
|
|
|
|
// Use cxSetResourceString instead global variable
|
|
// for example, old code:
|
|
// sdxBarDatePopupToday := ...
|
|
// new code:
|
|
// cxSetResourceString(@dxSBAR_DATETODAY, ...);
|
|
function sdxBarDatePopupToday: string;
|
|
function sdxBarDatePopupClear: string;
|
|
|
|
const
|
|
NullDate = -700000;
|
|
|
|
function DateOf(ADateTime: TDateTime): Integer;
|
|
|
|
function dxBarColorDialog: TColorDialog;
|
|
function dxBarFontDialog: TFontDialog;
|
|
|
|
implementation
|
|
|
|
{$R dxBarExtItems.res}
|
|
|
|
uses
|
|
SysUtils, ActiveX, Printers, dxBarCommon, cxClasses, cxGraphics, dxBarStrs;
|
|
|
|
const
|
|
Colors: array[0..15] of TColor =
|
|
(clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal, clGray,
|
|
clSilver, clRed, clLime, clYellow, clBlue, clFuchsia, clAqua, clWhite);
|
|
ADateNavigatorTime = 170;
|
|
ProgressBarDefaultWidth = 150;
|
|
ProgressBarIndent = 2;
|
|
|
|
type
|
|
TDummyWinControl = class(TWinControl);
|
|
TDummyBarManager = class(TdxBarManager);
|
|
TDummyCustomBarControl = class(TCustomdxBarControl);
|
|
TdxBarItemActionLinkAccess = class(TdxBarItemActionLink);
|
|
TPlaceForm = class(TCustomForm)
|
|
private
|
|
FBarItemControl: TdxBarItemControl;
|
|
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
|
|
end;
|
|
|
|
procedure TPlaceForm.WMEraseBkgnd(var Message: TWMEraseBkgnd);
|
|
var
|
|
APrevWindowOrg: TPoint;
|
|
R: TRect;
|
|
begin
|
|
if FBarItemControl = nil then
|
|
FillRect(Message.DC, ClientRect, Brush.Handle)
|
|
else
|
|
begin
|
|
R := ClientRect;
|
|
OffsetRect(R, Left, Top);
|
|
OffsetWindowOrgEx(Message.DC, Left, Top, APrevWindowOrg);
|
|
try
|
|
FBarItemControl.PainterClass.DrawBackground(FBarItemControl, Message.DC,
|
|
R, Brush.Handle, False);
|
|
finally
|
|
SetWindowOrgEx(Message.DC, APrevWindowOrg.X, APrevWindowOrg.Y, nil);
|
|
end;
|
|
end;
|
|
Message.Result := 1;
|
|
end;
|
|
|
|
var
|
|
FColorDialog: TColorDialog;
|
|
FFontDialog: TFontDialog;
|
|
FTrueTypeFontBitmap, FNonTrueTypeFontBitmap: TBitmap;
|
|
|
|
function GetAdjustedString(const S: string): string;
|
|
var
|
|
C: PChar;
|
|
R: TRect;
|
|
DC: HDC;
|
|
begin
|
|
GetMem(C, 2 * (MAX_PATH + 1));
|
|
StrPCopy(C, S);
|
|
R := Rect(0, 0, 300, 100);
|
|
DC := GetDC(0);
|
|
DrawText(DC, C, Length(S), R,
|
|
DT_CALCRECT or DT_MODIFYSTRING or
|
|
DT_NOPREFIX or DT_SINGLELINE or DT_PATH_ELLIPSIS);
|
|
ReleaseDC(0, DC);
|
|
Result := C;
|
|
FreeMem(C);
|
|
end;
|
|
|
|
function sdxBarDatePopupToday: string;
|
|
begin
|
|
Result := cxGetResourceString(@dxSBAR_DATETODAY);
|
|
end;
|
|
|
|
function sdxBarDatePopupClear: string;
|
|
begin
|
|
Result := cxGetResourceString(@dxSBAR_DATECLEAR);
|
|
end;
|
|
|
|
{ TdxBarStatic }
|
|
|
|
constructor TdxBarStatic.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FAlignment := taCenter;
|
|
FShowCaption := True;
|
|
end;
|
|
|
|
procedure TdxBarStatic.SetAlignment(Value: TAlignment);
|
|
begin
|
|
if FAlignment <> Value then
|
|
begin
|
|
FAlignment := Value;
|
|
if not IsLoading then Update;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarStatic.SetBorderStyle(Value: TdxBarStaticBorderStyle);
|
|
begin
|
|
if FBorderStyle <> Value then
|
|
begin
|
|
FBorderStyle := Value;
|
|
if not IsLoading then
|
|
if (Width = 0) or (Height = 0) then
|
|
UpdateEx
|
|
else
|
|
Update;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarStatic.SetShowCaption(Value: Boolean);
|
|
begin
|
|
if FShowCaption <> Value then
|
|
begin
|
|
FShowCaption := Value;
|
|
if not IsLoading then UpdateEx;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarStatic.SetSizeValue(Index: Integer; Value: Integer);
|
|
var
|
|
PrevValue: Integer;
|
|
begin
|
|
if Value < 0 then Value := 0;
|
|
case Index of
|
|
1: PrevValue := FLeftIndent;
|
|
2: PrevValue := FRightIndent;
|
|
3: PrevValue := FWidth;
|
|
4: PrevValue := FHeight;
|
|
else
|
|
PrevValue := 0;
|
|
end;
|
|
if PrevValue <> Value then
|
|
begin
|
|
case Index of
|
|
1: FLeftIndent := Value;
|
|
2: FRightIndent := Value;
|
|
3: FWidth := Value;
|
|
4: FHeight := Value;
|
|
end;
|
|
if not IsLoading then UpdateEx;
|
|
end;
|
|
end;
|
|
|
|
function TdxBarStatic.CanClicked: Boolean;
|
|
begin
|
|
Result := FAllowClick;
|
|
end;
|
|
|
|
function TdxBarStatic.HasAccel(AItemLink: TdxBarItemLink): Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
{ TdxBarStaticControl }
|
|
|
|
function TdxBarStaticControl.GetBorderStyle: TdxBarStaticBorderStyle;
|
|
begin
|
|
Result := Item.BorderStyle;
|
|
end;
|
|
|
|
function TdxBarStaticControl.GetBorderWidth: Integer;
|
|
const
|
|
Widths: array[TdxBarStaticBorderStyle] of Integer = (0, 1, 1, 2, 2);
|
|
begin
|
|
Result := Widths[BorderStyle];
|
|
end;
|
|
|
|
function TdxBarStaticControl.GetItem: TdxBarStatic;
|
|
begin
|
|
Result := TdxBarStatic(ItemLink.Item);
|
|
end;
|
|
|
|
function TdxBarStaticControl.GetSizeValue(Index: Integer): Integer;
|
|
begin
|
|
case Index of
|
|
1: Result := Item.LeftIndent;
|
|
2: Result := Item.RightIndent;
|
|
3: Result := Item.Width;
|
|
4: Result := Item.Height;
|
|
else
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TdxBarStaticControl.CanHaveZeroSize: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TdxBarStaticControl.CanClicked: Boolean;
|
|
begin
|
|
Result := Item.AllowClick;
|
|
end;
|
|
|
|
function TdxBarStaticControl.CanMouseSelect: Boolean;
|
|
begin
|
|
Result := inherited CanSelect;
|
|
end;
|
|
|
|
function TdxBarStaticControl.CanSelect: Boolean;
|
|
begin
|
|
Result := inherited CanSelect and BarManager.IsCustomizing;
|
|
end;
|
|
|
|
procedure TdxBarStaticControl.CaptionChanged;
|
|
begin
|
|
if Width = 0 then
|
|
inherited
|
|
else
|
|
Repaint;
|
|
end;
|
|
|
|
procedure TdxBarStaticControl.DrawGlyphAndCaption(DC: HDC; ARect: TRect;
|
|
PaintType: TdxBarPaintType; AllowCenter: Boolean);
|
|
const
|
|
Alignments: array[TAlignment] of Integer = (DT_LEFT, DT_RIGHT, DT_CENTER);
|
|
var
|
|
TextIndent: Integer;
|
|
R: TRect;
|
|
Center: Boolean;
|
|
begin
|
|
if ImageExists then
|
|
begin
|
|
TextIndent := 2;
|
|
R := ARect;
|
|
with ARect do
|
|
if PaintType = ptMenu then
|
|
begin
|
|
Center := AllowCenter and not Item.ShowCaption;
|
|
if not Center then
|
|
begin
|
|
Inc(Left, Bottom - Top);
|
|
R.Right := Left;
|
|
PainterClass.DrawBackground(Self, DC, ARect, Parent.BkBrush, False);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Center := AllowCenter;
|
|
if Item.ShowCaption then
|
|
begin
|
|
if PaintType = ptHorz then
|
|
begin
|
|
Inc(Left, TDummyBarManager(BarManager).ButtonWidth);
|
|
R.Right := Left;
|
|
end
|
|
else
|
|
begin
|
|
Inc(Top, TDummyBarManager(BarManager).ButtonHeight);
|
|
R.Bottom := Top;
|
|
end;
|
|
PainterClass.DrawBackground(Self, DC, ARect, Parent.BkBrush, False);
|
|
end;
|
|
end;
|
|
DrawGlyph(R, nil, PaintType, False, False, False, False, Center, True, False, False);
|
|
end
|
|
else
|
|
begin
|
|
TextIndent := Parent.TextSize div 4;
|
|
PainterClass.DrawBackground(Self, DC, ARect, Parent.BkBrush, False);
|
|
end;
|
|
|
|
if Item.ShowCaption then
|
|
begin
|
|
Center := AllowCenter and (Alignment = taCenter);
|
|
if not Center then
|
|
begin
|
|
if PaintType in [ptMenu, ptHorz] then
|
|
if Alignment = taLeftJustify then
|
|
Inc(ARect.Left, TextIndent)
|
|
else
|
|
Dec(ARect.Right, TextIndent)
|
|
else
|
|
if Alignment = taLeftJustify then
|
|
Inc(ARect.Top, TextIndent)
|
|
else
|
|
Dec(ARect.Bottom, TextIndent);
|
|
end;
|
|
DrawItemText(DC, Caption, ARect, Alignments[Alignment], Enabled, False,
|
|
PaintType = ptVert, True, False);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarStaticControl.DrawInterior(DC: HDC; ARect: TRect;
|
|
PaintType: TdxBarPaintType);
|
|
begin
|
|
DrawGlyphAndCaption(DC, ARect, PaintType, True);
|
|
end;
|
|
|
|
procedure TdxBarStaticControl.GlyphChanged;
|
|
begin
|
|
Parent.RepaintBar;
|
|
end;
|
|
|
|
function TdxBarStaticControl.GetAlignment: TAlignment;
|
|
begin
|
|
Result := Item.Alignment;
|
|
end;
|
|
|
|
function TdxBarStaticControl.GetAutoWidth: Integer;
|
|
begin
|
|
if Item.ShowCaption then
|
|
Result := Parent.Canvas.TextWidth(GetTextOf(Caption))
|
|
else
|
|
Result := 0;
|
|
if ImageExists or not Item.ShowCaption and not CanHaveZeroSize then
|
|
begin
|
|
if not IsVertical(Parent) then
|
|
Inc(Result, TDummyBarManager(BarManager).ButtonWidth)
|
|
else
|
|
Inc(Result, TDummyBarManager(BarManager).ButtonHeight);
|
|
if Item.ShowCaption then Inc(Result, 4);
|
|
end
|
|
else
|
|
if Item.ShowCaption then
|
|
Inc(Result, Parent.TextSize div 2);
|
|
Inc(Result, LeftIndent + RightIndent + 2 * BorderWidth);
|
|
end;
|
|
|
|
function TdxBarStaticControl.GetDefaultHeight: Integer;
|
|
begin
|
|
if Height = 0 then
|
|
begin
|
|
if Parent is TdxBarControl then
|
|
begin
|
|
if ImageExists or not Item.ShowCaption and not CanHaveZeroSize then
|
|
if not IsVertical(Parent) then
|
|
Result := TDummyBarManager(BarManager).ButtonHeight
|
|
else
|
|
Result := TDummyBarManager(BarManager).ButtonWidth
|
|
else
|
|
Result := 0;
|
|
if (Result = 0) or Item.ShowCaption and (Result < Parent.TextSize - 3) then
|
|
Result := Parent.TextSize - 3;
|
|
end
|
|
else
|
|
Result := Parent.TextSize;
|
|
Inc(Result, 2 * BorderWidth);
|
|
end
|
|
else
|
|
Result := Height;
|
|
end;
|
|
|
|
function TdxBarStaticControl.GetDefaultWidth: Integer;
|
|
begin
|
|
if Width = 0 then
|
|
Result := GetAutoWidth
|
|
else
|
|
Result := Width;
|
|
end;
|
|
|
|
function TdxBarStaticControl.GetHeight: Integer;
|
|
begin
|
|
if IsVertical(Parent) then
|
|
Result := GetDefaultWidth
|
|
else
|
|
Result := GetDefaultHeight;
|
|
end;
|
|
|
|
function TdxBarStaticControl.GetWidth: Integer;
|
|
begin
|
|
if IsVertical(Parent) then
|
|
Result := GetDefaultHeight
|
|
else
|
|
Result := GetDefaultWidth;
|
|
end;
|
|
|
|
function TdxBarStaticControl.IsDestroyOnClick: Boolean;
|
|
begin
|
|
Result := Item.AllowClick;
|
|
end;
|
|
|
|
procedure TdxBarStaticControl.Paint(ARect: TRect; PaintType: TdxBarPaintType);
|
|
const
|
|
Borders: array[TdxBarStaticBorderStyle] of Integer =
|
|
(0, BDR_SUNKENOUTER, BDR_RAISEDINNER, EDGE_ETCHED, 0);
|
|
var
|
|
R: TRect;
|
|
DC: HDC;
|
|
|
|
procedure DrawIndents;
|
|
|
|
procedure DrawLeftIndent;
|
|
begin
|
|
if LeftIndent <> 0 then
|
|
begin
|
|
if IsVertical(Parent) then
|
|
begin
|
|
Inc(ARect.Top, LeftIndent);
|
|
R.Bottom := ARect.Top;
|
|
end
|
|
else
|
|
begin
|
|
Inc(ARect.Left, LeftIndent);
|
|
R.Right := ARect.Left;
|
|
end;
|
|
PainterClass.DrawBackground(Self, DC, R, Parent.BkBrush, False);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawRightIndent;
|
|
begin
|
|
if RightIndent <> 0 then
|
|
begin
|
|
if IsVertical(Parent) then
|
|
begin
|
|
R.Bottom := ARect.Bottom;
|
|
Dec(ARect.Bottom, RightIndent);
|
|
R.Top := ARect.Bottom;
|
|
end
|
|
else
|
|
begin
|
|
R.Right := ARect.Right;
|
|
Dec(ARect.Right, RightIndent);
|
|
R.Left := ARect.Right;
|
|
end;
|
|
PainterClass.DrawBackground(Self, DC, R, Parent.BkBrush, False);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
DrawLeftIndent;
|
|
DrawRightIndent;
|
|
end;
|
|
|
|
procedure DrawBorder;
|
|
begin
|
|
PainterClass.DrawStaticBorder(Self, DC, ARect, BorderWidth, BorderStyle);
|
|
end;
|
|
|
|
begin
|
|
if ARect.Left = ARect.Right then Exit;
|
|
R := ARect;
|
|
DC := Parent.Canvas.Handle;
|
|
DrawIndents;
|
|
DrawBorder;
|
|
DrawInterior(DC, ARect, PaintType);
|
|
end;
|
|
|
|
{ TdxBarLargeButton }
|
|
|
|
constructor TdxBarLargeButton.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FAutoGrayScale := True;
|
|
FGlyphLayout := glTop;
|
|
FHotGlyph := TBitmap.Create;
|
|
FHotGlyph.OnChange := OnHotGlyphChanged;
|
|
FHotImageIndex := -1;
|
|
FLargeGlyph := TBitmap.Create;
|
|
FLargeGlyph.OnChange := OnLargeGlyphChanged;
|
|
FLargeImageIndex := -1;
|
|
FShowCaption := True;
|
|
FSyncImageIndex := True;
|
|
end;
|
|
|
|
destructor TdxBarLargeButton.Destroy;
|
|
begin
|
|
FLargeGlyph.Free;
|
|
FHotGlyph.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TdxBarLargeButton.IsImageIndexStored: Boolean;
|
|
begin
|
|
Result := not SyncImageIndex;
|
|
end;
|
|
|
|
function TdxBarLargeButton.IsLargeImageIndexStored: Boolean;
|
|
begin
|
|
Result := (ActionLink = nil) or
|
|
not TdxBarItemActionLinkAccess(ActionLink).IsImageIndexLinked;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.SetAutoGrayScale(Value: Boolean);
|
|
begin
|
|
if FAutoGrayScale <> Value then
|
|
begin
|
|
FAutoGrayScale := Value;
|
|
Update;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.SetGlyphLayout(Value: TdxBarGlyphLayout);
|
|
begin
|
|
if FGlyphLayout <> Value then
|
|
begin
|
|
FGlyphLayout := Value;
|
|
GlyphLayoutChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.SetHeight(Value: Integer);
|
|
begin
|
|
if FHeight <> Value then
|
|
begin
|
|
if Value < 0 then Exit;
|
|
FHeight := Value;
|
|
HeightChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.SetHotGlyph(Value: TBitmap);
|
|
begin
|
|
FHotGlyph.Assign(Value);
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.SetHotImageIndex(Value: Integer);
|
|
begin
|
|
if FHotImageIndex <> Value then
|
|
begin
|
|
FHotImageIndex := Value;
|
|
HotGlyphChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.SetLargeGlyph(Value: TBitmap);
|
|
begin
|
|
FLargeGlyph.Assign(Value);
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.SetLargeImageIndex(Value: Integer);
|
|
begin
|
|
if IsLoading and not FInSyncImageIndex then
|
|
FSetLargeImageIndex := True;
|
|
if FLargeImageIndex <> Value then
|
|
begin
|
|
FLargeImageIndex := Value;
|
|
LargeGlyphChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.SetShowCaption(Value: Boolean);
|
|
begin
|
|
if FShowCaption <> Value then
|
|
begin
|
|
FShowCaption := Value;
|
|
ShowCaptionChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.SetSyncImageIndex(Value: Boolean);
|
|
begin
|
|
if IsLoading and not FInSyncImageIndex then
|
|
FSetSyncImageIndex := True;
|
|
if FSyncImageIndex <> Value then
|
|
begin
|
|
FSyncImageIndex := Value;
|
|
if FSyncImageIndex then
|
|
LargeGlyphChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.SetWidth(Value: Integer);
|
|
begin
|
|
if FWidth <> Value then
|
|
begin
|
|
if Value < 0 then Exit;
|
|
FWidth := Value;
|
|
WidthChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.OnHotGlyphChanged(Sender: TObject);
|
|
begin
|
|
HotGlyphChanged;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.OnLargeGlyphChanged(Sender: TObject);
|
|
begin
|
|
LargeGlyphChanged;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.DefineProperties(Filer: TFiler);
|
|
begin
|
|
inherited;
|
|
Filer.DefineProperty('ImageIndex', ReadImageIndex, WriteImageIndex, IsImageIndexStored);
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
FSetImageIndex := False;
|
|
FSetLargeImageIndex := False;
|
|
FSetSyncImageIndex := False;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.ReadImageIndex(Reader: TReader);
|
|
begin
|
|
ImageIndex := Reader.ReadInteger;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.WriteImageIndex(Writer: TWriter);
|
|
begin
|
|
Writer.WriteInteger(ImageIndex);
|
|
end;
|
|
|
|
function TdxBarLargeButton.GetActionImageIndex: Integer;
|
|
begin
|
|
Result := LargeImageIndex;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.SetActionImageIndex(Value: Integer);
|
|
begin
|
|
LargeImageIndex := Value;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.GlyphLayoutChanged;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to LinkCount - 1 do
|
|
if Links[I].Control <> nil then
|
|
TdxBarLargeButtonControl(Links[I].Control).GlyphLayoutChanged;
|
|
end;
|
|
|
|
function TdxBarLargeButton.HasAccel(AItemLink: TdxBarItemLink): Boolean;
|
|
begin
|
|
Result := inherited HasAccel(AItemLink) and
|
|
(not (AItemLink.Owner.Owner is TdxBar) or FShowCaption);
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.HeightChanged;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to LinkCount - 1 do
|
|
if Links[I].Control <> nil then
|
|
TdxBarLargeButtonControl(Links[I].Control).HeightChanged;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.HotGlyphChanged;
|
|
var
|
|
I: Integer;
|
|
{var
|
|
AItemLink: TdxBarItemLink;}
|
|
begin
|
|
{ AItemLink := CurItemLink;
|
|
if (AItemLink <> nil) and (AItemLink.Control <> nil) then
|
|
TdxBarLargeButtonControl(AItemLink.Control).HotGlyphChanged;}
|
|
for I := 0 to LinkCount - 1 do
|
|
if Links[I].Control <> nil then
|
|
TdxBarLargeButtonControl(Links[I].Control).HotGlyphChanged;
|
|
end;
|
|
|
|
function TdxBarLargeButton.IsHotImageLinked: Boolean;
|
|
begin
|
|
with BarManager do
|
|
Result := (HotImages <> nil) and
|
|
(0 <= FHotImageIndex) and (FHotImageIndex < HotImages.Count);
|
|
end;
|
|
|
|
function TdxBarLargeButton.IsLargeImageLinked: Boolean;
|
|
begin
|
|
with BarManager do
|
|
Result := (LargeImages <> nil) and
|
|
(0 <= FLargeImageIndex) and (FLargeImageIndex < LargeImages.Count);
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.LargeGlyphChanged;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if not FInSyncImageIndex and SyncImageIndex then
|
|
begin
|
|
if IsLoading and FSetImageIndex then
|
|
SyncImageIndex := LargeImageIndex = ImageIndex
|
|
else
|
|
begin
|
|
FInSyncImageIndex := True;
|
|
try
|
|
ImageIndex := LargeImageIndex;
|
|
finally
|
|
FInSyncImageIndex := False;
|
|
end;
|
|
end;
|
|
end;
|
|
for I := 0 to LinkCount - 1 do
|
|
if Links[I].Control <> nil then
|
|
TdxBarLargeButtonControl(Links[I].Control).LargeGlyphChanged;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.SetImageIndex(Value: Integer);
|
|
begin
|
|
if IsLoading and not FInSyncImageIndex then
|
|
FSetImageIndex := True;
|
|
inherited SetImageIndex(Value);
|
|
if not FInSyncImageIndex then
|
|
begin
|
|
if IsLoading and (LargeImageIndex = -1) and (SyncImageIndex or not FSetSyncImageIndex) then
|
|
begin
|
|
FInSyncImageIndex := True;
|
|
try
|
|
LargeImageIndex := ImageIndex;
|
|
finally
|
|
FInSyncImageIndex := False;
|
|
end;
|
|
end
|
|
else
|
|
// if not FInSyncImageIndex then
|
|
if not FSetSyncImageIndex then
|
|
SyncImageIndex := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.ShowCaptionChanged;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to LinkCount - 1 do
|
|
if Links[I].Control <> nil then
|
|
TdxBarLargeButtonControl(Links[I].Control).ShowCaptionChanged;
|
|
end;
|
|
|
|
function TdxBarLargeButton.UseHotImages: Boolean;
|
|
begin
|
|
Result := FHotImageIndex > -1;
|
|
end;
|
|
|
|
function TdxBarLargeButton.UseLargeImages: Boolean;
|
|
begin
|
|
Result := FLargeImageIndex > -1;
|
|
end;
|
|
|
|
procedure TdxBarLargeButton.WidthChanged;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to LinkCount - 1 do
|
|
if Links[I].Control <> nil then
|
|
TdxBarLargeButtonControl(Links[I].Control).WidthChanged;
|
|
end;
|
|
|
|
{ TdxBarLargeButtonControl }
|
|
|
|
function TdxBarLargeButtonControl.GetHotGlyph: TBitmap;
|
|
begin
|
|
Result := Item.HotGlyph;
|
|
end;
|
|
|
|
function TdxBarLargeButtonControl.GetItem: TdxBarLargeButton;
|
|
begin
|
|
Result := TdxBarLargeButton(ItemLink.Item);
|
|
end;
|
|
|
|
function TdxBarLargeButtonControl.GetLargeGlyph: TBitmap;
|
|
begin
|
|
Result := Item.LargeGlyph;
|
|
end;
|
|
|
|
function TdxBarLargeButtonControl.GetCurrentImage(ASelected: Boolean;
|
|
var CurrentGlyph: TBitmap; var CurrentImages: TCurImageList;
|
|
var CurrentImageIndex: Integer): Boolean;
|
|
|
|
procedure CheckHotGlyph;
|
|
begin
|
|
Result := True;
|
|
if not HotGlyph.Empty then
|
|
CurrentGlyph := HotGlyph
|
|
else
|
|
if Item.IsHotImageLinked then
|
|
begin
|
|
CurrentImages := HotImages;
|
|
CurrentImageIndex := Item.HotImageIndex;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
procedure CheckLargeGlyph;
|
|
begin
|
|
Result := True;
|
|
if not LargeGlyph.Empty then
|
|
CurrentGlyph := LargeGlyph
|
|
else
|
|
if Item.IsLargeImageLinked then
|
|
begin
|
|
CurrentImages := LargeImages;
|
|
CurrentImageIndex := Item.LargeImageIndex;
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function GetCurrentImages: TCurImageList;
|
|
begin
|
|
if LargeImages <> nil then
|
|
Result := LargeImages
|
|
else
|
|
if HotImages <> nil then
|
|
Result := HotImages
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
begin
|
|
CurrentGlyph := nil;
|
|
CurrentImages := nil;
|
|
CurrentImageIndex := -1;
|
|
if ASelected then
|
|
begin
|
|
CheckHotGlyph;
|
|
if not Result then CheckLargeGlyph;
|
|
end
|
|
else
|
|
begin
|
|
CheckLargeGlyph;
|
|
if not Result then CheckHotGlyph;
|
|
end;
|
|
if not Result then
|
|
CurrentImages := GetCurrentImages;
|
|
end;
|
|
|
|
function TdxBarLargeButtonControl.IsSizeAssigned: Boolean;
|
|
begin
|
|
with Item do
|
|
Result := (Width <> 0) and (Height <> 0);
|
|
end;
|
|
|
|
function TdxBarLargeButtonControl.ArrowWidth: Integer;
|
|
begin
|
|
if Parent is TdxBarControl then
|
|
Result := TDummyBarManager(BarManager).RealLargeButtonArrowWidth
|
|
else
|
|
Result := inherited ArrowWidth;
|
|
end;
|
|
|
|
procedure TdxBarLargeButtonControl.GlyphLayoutChanged;
|
|
begin
|
|
if Parent is TdxBarControl then Parent.RepaintBar;
|
|
end;
|
|
|
|
procedure TdxBarLargeButtonControl.HeightChanged;
|
|
begin
|
|
if Parent is TdxBarControl then Parent.RepaintBar;
|
|
end;
|
|
|
|
procedure TdxBarLargeButtonControl.HotGlyphChanged;
|
|
begin
|
|
LargeGlyphChanged;
|
|
end;
|
|
|
|
procedure TdxBarLargeButtonControl.LargeGlyphChanged;
|
|
begin
|
|
if Parent is TdxBarControl then
|
|
if IsSizeAssigned then
|
|
Repaint
|
|
else
|
|
Parent.RepaintBar;
|
|
end;
|
|
|
|
procedure TdxBarLargeButtonControl.ShowCaptionChanged;
|
|
begin
|
|
if Parent is TdxBarControl then Parent.RepaintBar;
|
|
end;
|
|
|
|
procedure TdxBarLargeButtonControl.WidthChanged;
|
|
begin
|
|
if Parent is TdxBarControl then Parent.RepaintBar;
|
|
end;
|
|
|
|
function TdxBarLargeButtonControl.GetDefaultHeight: Integer;
|
|
var
|
|
CurrentGlyph: TBitmap;
|
|
CurrentImages: TCurImageList;
|
|
CurrentImageIndex, H: Integer;
|
|
begin
|
|
if Parent is TdxBarControl then
|
|
begin
|
|
if Item.Height = 0 then
|
|
begin
|
|
Result := 1 + 2 + 2 + 1;
|
|
|
|
if not GetCurrentImage(False, CurrentGlyph, CurrentImages, CurrentImageIndex) and
|
|
(CurrentImages = nil) then
|
|
Inc(Result, 20)
|
|
else
|
|
if IsVertical(Parent) and Item.ShowCaption then
|
|
if CurrentGlyph = nil then
|
|
Inc(Result, CurrentImages.Width)
|
|
else
|
|
Inc(Result, CurrentGlyph.Width)
|
|
else
|
|
if CurrentGlyph = nil then
|
|
Inc(Result, CurrentImages.Height)
|
|
else
|
|
Inc(Result, CurrentGlyph.Height);
|
|
|
|
if Item.ShowCaption then
|
|
begin
|
|
H := Parent.Canvas.TextHeight('Qq');
|
|
if Item.GlyphLayout in [glTop, glBottom] then Inc(Result, H + 1)
|
|
else
|
|
begin
|
|
Inc(H, 1 + 2 + 2 + 1);
|
|
if Result < H then Result := H;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
Result := Item.Height;
|
|
if Lowered then Inc(Result, 2 * PainterClass.LoweredBorderSize(Self));
|
|
end
|
|
else
|
|
Result := inherited GetDefaultHeight;
|
|
end;
|
|
|
|
function TdxBarLargeButtonControl.GetDefaultWidth: Integer;
|
|
var
|
|
CurrentGlyph: TBitmap;
|
|
CurrentImages: TCurImageList;
|
|
CurrentImageIndex, W: Integer;
|
|
begin
|
|
if Parent is TdxBarControl then
|
|
begin
|
|
if Item.Width = 0 then
|
|
begin
|
|
Result := 1 + 4 + 4 + 1;
|
|
|
|
if not GetCurrentImage(False, CurrentGlyph, CurrentImages, CurrentImageIndex) and
|
|
(CurrentImages = nil) then
|
|
Inc(Result, 20)
|
|
else
|
|
if IsVertical(Parent) and Item.ShowCaption then
|
|
if CurrentGlyph = nil then
|
|
Inc(Result, CurrentImages.Height)
|
|
else
|
|
Inc(Result, CurrentGlyph.Height)
|
|
else
|
|
if CurrentGlyph = nil then
|
|
Inc(Result, CurrentImages.Width)
|
|
else
|
|
Inc(Result, CurrentGlyph.Width);
|
|
|
|
if Item.ShowCaption then
|
|
begin
|
|
W := 3 + Parent.Canvas.TextWidth(GetTextOf(Caption)) + 3;
|
|
if Item.GlyphLayout in [glLeft, glRight] then Inc(Result, W)
|
|
else
|
|
begin
|
|
W := 1 + 4 + W + 4 + 1;
|
|
if Result < W then Result := W;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
Result := Item.Width;
|
|
if Lowered then Inc(Result, 2 * PainterClass.LoweredBorderSize(Self));
|
|
end
|
|
else
|
|
Result := inherited GetDefaultWidth;
|
|
end;
|
|
|
|
function TdxBarLargeButtonControl.GetHeight: Integer;
|
|
begin
|
|
if IsVertical(Parent) and Item.ShowCaption then
|
|
Result := GetDefaultWidth
|
|
else
|
|
Result := GetDefaultHeight;
|
|
end;
|
|
|
|
function TdxBarLargeButtonControl.GetImageEnabled(APaintType: TdxBarPaintType): Boolean;
|
|
begin
|
|
if APaintType = ptMenu then
|
|
Result := inherited GetImageEnabled(APaintType)
|
|
else
|
|
Result := (BarManager.DisabledLargeImages <> nil) or Enabled;
|
|
end;
|
|
|
|
function TdxBarLargeButtonControl.GetWidth: Integer;
|
|
begin
|
|
if IsVertical(Parent) and Item.ShowCaption then
|
|
Result := GetDefaultHeight
|
|
else
|
|
Result := GetDefaultWidth;
|
|
if (Parent is TdxBarControl) and (Item.ButtonStyle = bsDropDown) then
|
|
Inc(Result, ArrowWidth);
|
|
end;
|
|
|
|
procedure TdxBarLargeButtonControl.Paint(ARect: TRect; PaintType: TdxBarPaintType);
|
|
var
|
|
DC: HDC;
|
|
Selected, DrawDowned, IsGlyphEmpty: Boolean;
|
|
R, FullRect, AImageBounds: TRect;
|
|
CurrentGlyph: TBitmap;
|
|
CurrentImages: TCurImageList;
|
|
CurrentImageIndex, Alignment: Integer;
|
|
|
|
function GetImageBounds: TRect;
|
|
var
|
|
OffsetX, OffsetY: Integer;
|
|
|
|
procedure GetImageOffset(var OffsetX, OffsetY: Integer);
|
|
begin
|
|
OffsetX := (R.Left + R.Right - Result.Right) div 2;
|
|
OffsetY := (R.Top + R.Bottom - Result.Bottom) div 2;
|
|
if not Item.ShowCaption then Exit;
|
|
if PaintType = ptHorz then
|
|
case Item.GlyphLayout of
|
|
glLeft:
|
|
OffsetX := R.Left + 4;
|
|
glRight:
|
|
OffsetX := R.Right - 4 - Result.Right;
|
|
glTop:
|
|
OffsetY := R.Top + 2;
|
|
glBottom:
|
|
OffsetY := R.Bottom - 2 - Result.Bottom;
|
|
end
|
|
else
|
|
case Item.GlyphLayout of
|
|
glLeft:
|
|
OffsetY := R.Top + 4;
|
|
glRight:
|
|
OffsetY := R.Bottom - 4 - Result.Bottom;
|
|
glTop:
|
|
OffsetX := R.Right - 2 - Result.Right;
|
|
glBottom:
|
|
OffsetX := R.Left + 2;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if IsGlyphEmpty and (CurrentImages = nil) then
|
|
Result := Rect(0, 0, 20, 20)
|
|
else
|
|
if CurrentGlyph = nil then
|
|
with CurrentImages do
|
|
Result := Rect(0, 0, Width, Height)
|
|
else
|
|
with CurrentGlyph do
|
|
Result := Rect(0, 0, Width, Height);
|
|
GetImageOffset(OffsetX, OffsetY);
|
|
OffsetRect(Result, OffsetX, OffsetY);
|
|
end;
|
|
|
|
procedure DrawImage;
|
|
|
|
function GetFullRect: TRect;
|
|
begin
|
|
if DroppedDownFlat then
|
|
Result := ARect
|
|
else
|
|
Result := FullRect;
|
|
end;
|
|
|
|
begin
|
|
IsGlyphEmpty :=
|
|
not GetCurrentImage(Selected, CurrentGlyph, CurrentImages, CurrentImageIndex);
|
|
AImageBounds := GetImageBounds;
|
|
DrawGlyphAndBkgnd(GetFullRect, AImageBounds, PaintType,
|
|
CurrentGlyph, CurrentImages, CurrentImageIndex,
|
|
IsGlyphEmpty, Selected, Down or DroppedDownFlat, DrawDowned, False,
|
|
not Selected and Item.Enabled and Item.AutoGrayScale, ButtonStyle = bsDropDown, ButtonStyle = bsDropDown);
|
|
end;
|
|
|
|
procedure DrawCaption;
|
|
var
|
|
ATextBounds: TRect;
|
|
begin
|
|
ATextBounds := R;
|
|
Alignment := DT_CENTER;
|
|
case Item.GlyphLayout of
|
|
glLeft:
|
|
begin
|
|
Alignment := DT_LEFT;
|
|
if PaintType = ptHorz then
|
|
ATextBounds.Left := AImageBounds.Right + 3
|
|
else
|
|
ATextBounds.Top := AImageBounds.Bottom + 3;
|
|
end;
|
|
glRight:
|
|
begin
|
|
Alignment := DT_RIGHT;
|
|
if PaintType = ptHorz then
|
|
ATextBounds.Right := AImageBounds.Left - 3
|
|
else
|
|
ATextBounds.Bottom := AImageBounds.Top - 3;
|
|
end;
|
|
glTop:
|
|
if PaintType = ptHorz then
|
|
ATextBounds.Top := AImageBounds.Bottom
|
|
else
|
|
ATextBounds.Right := AImageBounds.Left;
|
|
glBottom:
|
|
if PaintType = ptHorz then
|
|
ATextBounds.Bottom := AImageBounds.Top
|
|
else
|
|
ATextBounds.Left := AImageBounds.Right;
|
|
end;
|
|
DrawItemText(DC, Caption, ATextBounds, Alignment, Enabled, IsFlatTextSelected(DrawDowned),
|
|
PaintType = ptVert, False, not IsFlatTextSelected(DrawDowned));
|
|
end;
|
|
|
|
begin
|
|
if PaintType <> ptMenu then
|
|
begin
|
|
if ARect.Left = ARect.Right then Exit;
|
|
DC := Parent.Canvas.Handle;
|
|
if Lowered then DrawLowered(DC, ARect);
|
|
R := ARect;
|
|
if Item.ButtonStyle = bsDropDown then Dec(R.Right, ArrowWidth);
|
|
Selected := DrawSelected;
|
|
DrawDowned :=
|
|
Selected and Parent.IsActive and MousePressed and not DroppedDown or
|
|
Pressed and (ButtonStyle <> bsChecked);
|
|
FullRect := R;
|
|
InflateRect(R, -1, -1);
|
|
PainterClass.OffsetCaptionBounds(Self, DrawDowned, R);
|
|
DrawImage;
|
|
if Item.ShowCaption then DrawCaption;
|
|
if ButtonStyle = bsDropDown then DrawArrow(ARect, Selected, DrawDowned, PaintType);
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxBarLargeButtonControl.PreparePaintStyleOnBar(var APaintStyle: TdxBarPaintStyle);
|
|
begin
|
|
APaintStyle := psCaption;
|
|
end;
|
|
|
|
{ TdxBarColorCombo }
|
|
|
|
constructor TdxBarColorCombo.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FAutoColor := clWindowText;
|
|
FAutoColorText := cxGetResourceString(@dxSBAR_COLORAUTOTEXT);
|
|
FCustomColorText := cxGetResourceString(@dxSBAR_COLORCUSTOMTEXT);
|
|
DropDownCount := 16;
|
|
Glyph.LoadFromResourceName(HInstance, 'DXBARCOLORCOMBO');
|
|
CreateItemsList;
|
|
ItemIndex := 0;
|
|
ShowEditor := False;
|
|
end;
|
|
|
|
function TdxBarColorCombo.GetCurColor: TColor;
|
|
begin
|
|
Result := GetColorByIndex(CurItemIndex);
|
|
end;
|
|
|
|
procedure TdxBarColorCombo.SetAutoColor(Value: TColor);
|
|
begin
|
|
if FAutoColor <> Value then
|
|
begin
|
|
FAutoColor := Value;
|
|
if FShowAutoColor then
|
|
begin
|
|
FSettingColor := True;
|
|
try
|
|
ItemIndex := GetIndexOfColor(FColor);
|
|
finally
|
|
FSettingColor := False;
|
|
Update;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarColorCombo.SetAutoColorText(Value: string);
|
|
begin
|
|
if FAutoColorText <> Value then
|
|
begin
|
|
FAutoColorText := Value;
|
|
if FShowAutoColor then
|
|
begin
|
|
Items[0] := Value;
|
|
Update;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarColorCombo.SetColor(Value: TColor);
|
|
var
|
|
AIndex: Integer;
|
|
begin
|
|
if FColor <> Value then
|
|
begin
|
|
FColor := Value;
|
|
FSettingColor := True;
|
|
try
|
|
AIndex := GetIndexOfColor(FColor);
|
|
if ItemIndex = AIndex then
|
|
begin
|
|
Update;
|
|
Change;
|
|
end
|
|
else ItemIndex := AIndex;
|
|
finally
|
|
FSettingColor := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarColorCombo.SetCurColor(Value: TColor);
|
|
begin
|
|
if CurColor <> Value then
|
|
CurItemIndex := GetIndexOfColor(Value);
|
|
end;
|
|
|
|
procedure TdxBarColorCombo.SetCustomColorText(Value: string);
|
|
begin
|
|
if FCustomColorText <> Value then
|
|
begin
|
|
FCustomColorText := Value;
|
|
Update;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarColorCombo.SetShowAutoColor(Value: Boolean);
|
|
begin
|
|
if FShowAutoColor <> Value then
|
|
begin
|
|
FShowAutoColor := Value;
|
|
FSettingColor := True;
|
|
try
|
|
if Value then Items.Insert(0, FAutoColorText)
|
|
else Items.Delete(0);
|
|
if DropDownCount = Byte(not Value) + 16 then
|
|
DropDownCount := Byte(Value) + 16;
|
|
ItemIndex := GetIndexOfColor(FColor);
|
|
finally
|
|
FSettingColor := False;
|
|
Update;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarColorCombo.SetShowCustomColorButton(Value: Boolean);
|
|
begin
|
|
if FShowCustomColorButton <> Value then
|
|
begin
|
|
FShowCustomColorButton := Value;
|
|
Update;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarColorCombo.CreateItemsList;
|
|
begin
|
|
with Items do
|
|
begin
|
|
Clear;
|
|
if FShowAutoColor then Add(FAutoColorText);
|
|
Add(cxGetResourceString(@dxSBAR_COLOR_STR_0));
|
|
Add(cxGetResourceString(@dxSBAR_COLOR_STR_1));
|
|
Add(cxGetResourceString(@dxSBAR_COLOR_STR_2));
|
|
Add(cxGetResourceString(@dxSBAR_COLOR_STR_3));
|
|
Add(cxGetResourceString(@dxSBAR_COLOR_STR_4));
|
|
Add(cxGetResourceString(@dxSBAR_COLOR_STR_5));
|
|
Add(cxGetResourceString(@dxSBAR_COLOR_STR_6));
|
|
Add(cxGetResourceString(@dxSBAR_COLOR_STR_7));
|
|
Add(cxGetResourceString(@dxSBAR_COLOR_STR_8));
|
|
Add(cxGetResourceString(@dxSBAR_COLOR_STR_9));
|
|
Add(cxGetResourceString(@dxSBAR_COLOR_STR_10));
|
|
Add(cxGetResourceString(@dxSBAR_COLOR_STR_11));
|
|
Add(cxGetResourceString(@dxSBAR_COLOR_STR_12));
|
|
Add(cxGetResourceString(@dxSBAR_COLOR_STR_13));
|
|
Add(cxGetResourceString(@dxSBAR_COLOR_STR_14));
|
|
Add(cxGetResourceString(@dxSBAR_COLOR_STR_15));
|
|
end;
|
|
end;
|
|
|
|
function TdxBarColorCombo.GetColorByIndex(AIndex: Integer): TColor;
|
|
begin
|
|
if (0 <= AIndex) and (AIndex < 16 + Byte(FShowAutoColor)) then
|
|
if FShowAutoColor and (AIndex = 0) then
|
|
Result := FAutoColor
|
|
else
|
|
Result := Colors[AIndex - Byte(FShowAutoColor)]
|
|
else Result := FColor;
|
|
end;
|
|
|
|
function TdxBarColorCombo.GetIndexOfColor(AColor: TColor): Integer;
|
|
begin
|
|
if FShowAutoColor and (AColor = FAutoColor) then
|
|
Result := 0
|
|
else
|
|
begin
|
|
AColor := ColorToRGB(AColor);
|
|
for Result := Low(Colors) + Byte(FShowAutoColor) to High(Colors) + Byte(FShowAutoColor) do
|
|
if ColorToRGB(Colors[Result - Byte(FShowAutoColor)]) = AColor then Exit;
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function TdxBarColorCombo.IsAutoColorTextStored: Boolean;
|
|
begin
|
|
Result := FAutoColorText <> cxGetResourceString(@dxSBAR_COLORAUTOTEXT);
|
|
end;
|
|
|
|
function TdxBarColorCombo.IsCustomColorTextStored: Boolean;
|
|
begin
|
|
Result := FCustomColorText <> cxGetResourceString(@dxSBAR_COLORCUSTOMTEXT);
|
|
end;
|
|
|
|
function TdxBarColorCombo.IsDropDownCountStored: Boolean;
|
|
begin
|
|
Result := DropDownCount <> Byte(FShowAutoColor) + 16;
|
|
end;
|
|
|
|
procedure TdxBarColorCombo.Change;
|
|
begin
|
|
if not FSettingColor then
|
|
FColor := GetColorByIndex(ItemIndex);
|
|
if not FInRefreshColorNames then
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxBarColorCombo.DrawItem(AIndex: Integer; ARect: TRect; AState: TOwnerDrawState);
|
|
var
|
|
PrevBrushColor: TColor;
|
|
S: string;
|
|
R: TRect;
|
|
HasIndent: Boolean;
|
|
begin
|
|
if Assigned(OnDrawItem) then
|
|
inherited
|
|
else
|
|
with Canvas, ARect do
|
|
begin
|
|
PrevBrushColor := Brush.Color;
|
|
if AIndex = -1 then
|
|
S := FCustomColorText
|
|
else
|
|
S := Items[AIndex];
|
|
R := ARect;
|
|
HasIndent := (AIndex <> -1) or (FColor >= 0) or (FColor <= clInfoBk);
|
|
if HasIndent then Inc(R.Left, 30);
|
|
FillRect(R);
|
|
TextOut(R.Left + 1, (Top + Bottom - TextHeight(S)) div 2, S);
|
|
if HasIndent then
|
|
begin
|
|
R.Right := R.Left;
|
|
R.Left := Left;
|
|
FrameRect(R);
|
|
InflateRect(R, -1, -1);
|
|
Brush.Color := clBtnShadow;
|
|
FrameRect(R);
|
|
InflateRect(R, -1, -1);
|
|
Brush.Color := GetColorByIndex(AIndex);
|
|
FillRect(R);
|
|
end;
|
|
Brush.Color := PrevBrushColor;
|
|
if odFocused in AState then Windows.DrawFocusRect(Handle, ARect); // for hiding focus rect
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarColorCombo.MeasureItem(AIndex: Integer; var AHeight: Integer);
|
|
begin
|
|
if Assigned(OnMeasureItem) then inherited
|
|
else
|
|
AHeight := 2 + Canvas.TextHeight('0') + 2;
|
|
end;
|
|
|
|
procedure TdxBarColorCombo.MeasureItemWidth(AIndex: Integer; var AWidth: Integer);
|
|
begin
|
|
inherited;
|
|
Inc(AWidth, 30);
|
|
end;
|
|
|
|
procedure TdxBarColorCombo.DoClick;
|
|
begin
|
|
try
|
|
inherited;
|
|
if not Assigned(OnClick) and not ReadOnly then
|
|
with dxBarColorDialog do
|
|
begin
|
|
if FHasExchangeColor then
|
|
Color := FExchangeColor
|
|
else
|
|
Color := Self.Color;
|
|
if Execute then Self.Color := Color;
|
|
end;
|
|
finally
|
|
FHasExchangeColor := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarColorCombo.RefreshColorNames;
|
|
var
|
|
APrevItemIndex: Integer;
|
|
begin
|
|
APrevItemIndex := ItemIndex;
|
|
FInRefreshColorNames := True;
|
|
try
|
|
CreateItemsList;
|
|
ItemIndex := APrevItemIndex;
|
|
finally
|
|
FInRefreshColorNames := False;
|
|
end;
|
|
Update;
|
|
end;
|
|
|
|
{ TdxBarColorComboControl }
|
|
|
|
function TdxBarColorComboControl.GetItem: TdxBarColorCombo;
|
|
begin
|
|
Result := TdxBarColorCombo(ItemLink.Item);
|
|
end;
|
|
|
|
function TdxBarColorComboControl.DrawSelected: Boolean;
|
|
begin
|
|
Result := inherited DrawSelected or Pressed;
|
|
end;
|
|
|
|
procedure TdxBarColorComboControl.PressedChanged;
|
|
begin
|
|
Repaint;
|
|
if Pressed then
|
|
DroppedDown := False;
|
|
end;
|
|
|
|
procedure TdxBarColorComboControl.Paint(ARect: TRect; PaintType: TdxBarPaintType);
|
|
var
|
|
Selected: Boolean;
|
|
DC: HDC;
|
|
I: Integer;
|
|
begin
|
|
SetRectEmpty(FCustomColorButtonRect);
|
|
if not Item.ShowCustomColorButton then
|
|
begin
|
|
inherited;
|
|
Exit;
|
|
end;
|
|
with ARect do
|
|
begin
|
|
I := (Bottom - Top - 2 - 2) div 7 * 7 + 2 + 2;
|
|
if I >= (Right - Left) div 2 then
|
|
I := 0
|
|
else
|
|
Dec(Right, I);
|
|
end;
|
|
inherited;
|
|
// draw custom color button
|
|
if I = 0 then Exit;
|
|
Selected := DrawSelected;
|
|
DC := Parent.Canvas.Handle;
|
|
with ARect do
|
|
begin
|
|
Left := Right;
|
|
Right := Left + I;
|
|
end;
|
|
PainterClass.ColorComboDrawCustomButton(Self, DC, ARect, FCustomColorButtonRect, Selected, Pressed);
|
|
end;
|
|
|
|
procedure TdxBarColorComboControl.WndProc(var Message: TMessage);
|
|
var
|
|
R: TRect;
|
|
AllowPressed: Boolean;
|
|
RealItemLink: TdxBarItemLink;
|
|
AItem: TdxBarColorCombo;
|
|
begin
|
|
with Message do
|
|
if (Msg = WM_LBUTTONDOWN) or
|
|
(Msg = WM_KEYDOWN) and (wParam = VK_RETURN) and (GetKeyState(VK_CONTROL) < 0) then
|
|
begin
|
|
if Msg = WM_LBUTTONDOWN then
|
|
begin
|
|
R := CustomColorButtonRect;
|
|
MapWindowPoints(Parent.Handle, Handle, R, 2);
|
|
end;
|
|
if PtInRect(R, SmallPointToPoint(TSmallPoint(lParam))) or (Msg = WM_KEYDOWN) then
|
|
begin
|
|
AItem := Item;
|
|
with AItem do
|
|
begin
|
|
FHasExchangeColor := True;
|
|
FExchangeColor := CurColor;
|
|
end;
|
|
AllowPressed := CanVisuallyPressed;
|
|
RealItemLink := ItemLink.RealItemLink;
|
|
if RealItemLink <> nil then RealItemLink.BringToTopInRecentList(True);
|
|
if AllowPressed then
|
|
Pressed := True
|
|
else
|
|
Parent.HideAll;
|
|
try
|
|
AItem.DirectClick;
|
|
finally
|
|
try
|
|
if AllowPressed then Pressed := False;
|
|
except
|
|
end;
|
|
end;
|
|
Exit;
|
|
end;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
{ TdxBarFontNameCombo }
|
|
|
|
constructor TdxBarFontNameCombo.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
DropDownCount := 12;
|
|
Glyph.LoadFromResourceName(HInstance, 'DXBARFONTNAMECOMBO');
|
|
ShowEditor := False;
|
|
Sorted := True;
|
|
LoadFontNames;
|
|
Width := 160;
|
|
end;
|
|
|
|
procedure TdxBarFontNameCombo.DrawItem(AIndex: Integer; ARect: TRect; AState: TOwnerDrawState);
|
|
var
|
|
W, H: Integer;
|
|
CurrentBitmap: TBitmap;
|
|
R: TRect;
|
|
S: string;
|
|
begin
|
|
if Assigned(OnDrawItem) or (AIndex = -1) then
|
|
inherited
|
|
else
|
|
with Canvas, ARect do
|
|
begin
|
|
if Boolean(Items.Objects[AIndex]) then
|
|
CurrentBitmap := FTrueTypeFontBitmap
|
|
else
|
|
CurrentBitmap := FNonTrueTypeFontBitmap;
|
|
W := CurrentBitmap.Width;
|
|
H := CurrentBitmap.Height;
|
|
R := Bounds(Left, (Top + Bottom - H) div 2, W, H);
|
|
TransparentDraw(Handle, Brush.Handle, ARect, R, CurrentBitmap, nil, -1,
|
|
True, False, False, False, False, False, False, False, clNone{Faded}, BarManager.ImageListBkColor);
|
|
|
|
S := Items[AIndex];
|
|
TextOut(R.Right + 2, (Top + Bottom - TextHeight(S)) div 2, S);
|
|
if odFocused in AState then Windows.DrawFocusRect(Handle, ARect); // for hiding focus rect
|
|
end;
|
|
end;
|
|
|
|
function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
|
|
FontType: Integer; Data: Pointer): Integer; stdcall;
|
|
begin
|
|
TStrings(Data).AddObject(LogFont.lfFaceName, Pointer(FontType and TRUETYPE_FONTTYPE <> 0));
|
|
Result := 1;
|
|
end;
|
|
|
|
procedure TdxBarFontNameCombo.LoadFontNames;
|
|
var
|
|
DC: HDC;
|
|
AIsWindowDC: Boolean;
|
|
|
|
procedure EnumFonts(DC: HDC);
|
|
var
|
|
LogFont: TLogFont;
|
|
begin
|
|
with LogFont do
|
|
begin
|
|
lfCharset := DEFAULT_CHARSET;
|
|
lfFaceName := '';
|
|
lfPitchAndFamily := 0;
|
|
end;
|
|
EnumFontFamiliesEx(DC, LogFont, @EnumFontsProc, Integer(Items), 0);
|
|
end;
|
|
|
|
begin
|
|
if Printer.Printers.Count = 0 then
|
|
DC := 0
|
|
else
|
|
try
|
|
DC := Printer.Handle;
|
|
except
|
|
DC := 0;
|
|
end;
|
|
AIsWindowDC := DC = 0;
|
|
if AIsWindowDC then DC := GetDC(0);
|
|
try
|
|
EnumFonts(DC);
|
|
finally
|
|
if AIsWindowDC then ReleaseDC(0, DC);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarFontNameCombo.MeasureItemWidth(AIndex: Integer; var AWidth: Integer);
|
|
begin
|
|
inherited;
|
|
Inc(AWidth, FTrueTypeFontBitmap.Width + 1);
|
|
end;
|
|
|
|
procedure TdxBarFontNameCombo.SetText(Value: string);
|
|
var
|
|
AIndex: Integer;
|
|
begin
|
|
if CurItemLink <> nil then
|
|
begin
|
|
AIndex := GetNearestItemIndex(Value);
|
|
if (AIndex = -1) and (Value <> '') then Exit;
|
|
if AIndex > -1 then Value := Items[AIndex];
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxBarFontNameCombo.DoClick;
|
|
begin
|
|
inherited;
|
|
if not Assigned(OnClick) and not ReadOnly then
|
|
with dxBarFontDialog do
|
|
begin
|
|
Font.Name := Text;
|
|
if Execute then Text := Font.Name;
|
|
end;
|
|
end;
|
|
|
|
{ TdxBarDateCombo support classes }
|
|
|
|
procedure DecMonth(var AYear, AMonth: Word);
|
|
begin
|
|
if AMonth = 1 then
|
|
begin
|
|
Dec(AYear);
|
|
AMonth := 12;
|
|
end
|
|
else
|
|
Dec(AMonth);
|
|
end;
|
|
|
|
procedure IncMonth(var AYear, AMonth: Word);
|
|
begin
|
|
if AMonth = 12 then
|
|
begin
|
|
Inc(AYear);
|
|
AMonth := 1;
|
|
end
|
|
else
|
|
Inc(AMonth);
|
|
end;
|
|
|
|
procedure ChangeMonth(var AYear, AMonth: Word; Delta: Integer);
|
|
var
|
|
Month: Integer;
|
|
begin
|
|
Inc(AYear, Delta div 12);
|
|
Month := AMonth;
|
|
Inc(Month, Delta mod 12);
|
|
if Month < 1 then
|
|
begin
|
|
Dec(AYear);
|
|
Month := 12 + Month;
|
|
end;
|
|
if Month > 12 then
|
|
begin
|
|
Inc(AYear);
|
|
Month := Month - 12;
|
|
end;
|
|
AMonth := Month;
|
|
end;
|
|
|
|
function GetDateElement(ADate: TDateTime; Index: Integer): Integer;
|
|
var
|
|
AYear, AMonth, ADay: Word;
|
|
begin
|
|
DecodeDate(ADate, AYear, AMonth, ADay);
|
|
case Index of
|
|
1: Result := AYear;
|
|
2: Result := AMonth;
|
|
3: Result := ADay;
|
|
else Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function IsLeapYear(AYear: Integer): Boolean;
|
|
begin
|
|
Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
|
|
end;
|
|
|
|
function DaysPerMonth(AYear, AMonth: Integer): Integer;
|
|
const
|
|
DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
|
|
begin
|
|
Result := DaysInMonth[AMonth];
|
|
if (AMonth = 2) and IsLeapYear(AYear) then Inc(Result);
|
|
end;
|
|
|
|
function CheckDay(AYear, AMonth, ADay: Integer): Integer;
|
|
begin
|
|
if ADay < 1 then Result := 1
|
|
else
|
|
if ADay > DaysPerMonth(AYear, AMonth) then
|
|
Result := DaysPerMonth(AYear, AMonth)
|
|
else
|
|
Result := ADay;
|
|
end;
|
|
|
|
function DateOf(ADateTime: TDateTime): Integer;
|
|
begin
|
|
Result := Trunc(ADateTime + 1E-11);
|
|
end;
|
|
|
|
function dxBarColorDialog: TColorDialog;
|
|
begin
|
|
Result := FColorDialog;
|
|
end;
|
|
|
|
function dxBarFontDialog: TFontDialog;
|
|
begin
|
|
Result := FFontDialog;
|
|
end;
|
|
|
|
function TextToDate(AText: string): TDateTime;
|
|
var
|
|
I: Integer;
|
|
V1, V2: OleVariant;
|
|
begin
|
|
for I := 1 to Length(AText) do
|
|
if AText[I] = '.' then AText[I] := ' ';
|
|
V1 := AText;
|
|
if VariantChangeType(V2, V1, 0, VT_DATE) = S_OK then
|
|
Result := V2
|
|
else
|
|
Result := NullDate;
|
|
end;
|
|
|
|
function DateToText(ADate: TDateTime): string;
|
|
var
|
|
SystemTime: TSystemTime;
|
|
PS: PChar;
|
|
begin
|
|
if ADate = NullDate then Result := ''
|
|
else
|
|
begin
|
|
with SystemTime do
|
|
begin
|
|
DecodeDate(ADate, wYear, wMonth, wDay);
|
|
wDayOfWeek := Word(Abs(Trunc(ADate) - 1) mod 7);
|
|
DecodeTime(ADate, wHour, wMinute, wSecond, wMilliseconds);
|
|
end;
|
|
GetMem(PS, 100);
|
|
GetDateFormat(0, 0, @SystemTime, nil, PS, 100);
|
|
Result := PS;
|
|
FreeMem(PS, 100);
|
|
end;
|
|
end;
|
|
|
|
{ TAMonthListBox }
|
|
|
|
type
|
|
TAMonthListBox = class(TCustomControl)
|
|
private
|
|
FTopDate: TDateTime;
|
|
FItemHeight: Integer;
|
|
FItemIndex: Integer;
|
|
FItems: TStrings;
|
|
FTimer: UINT;
|
|
FTimerId: UINT;
|
|
|
|
procedure FreeTimer;
|
|
|
|
function GetDate: TDateTime;
|
|
procedure SetItemIndex(Value: Integer);
|
|
procedure SetTopDate(Value: TDateTime);
|
|
|
|
procedure WMDestroy(var Message: TMessage); message WM_DESTROY;
|
|
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
|
|
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
|
|
protected
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
procedure Paint; override;
|
|
|
|
property ItemHeight: Integer read FItemHeight;
|
|
property ItemIndex: Integer read FItemIndex write SetItemIndex;
|
|
property Items: TStrings read FItems;
|
|
property TopDate: TDateTime read FTopDate write SetTopDate;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
|
|
property Date: TDateTime read GetDate;
|
|
end;
|
|
|
|
constructor TAMonthListBox.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FTopDate := NullDate;
|
|
end;
|
|
|
|
procedure TAMonthListBox.FreeTimer;
|
|
begin
|
|
if FTimer > 0 then
|
|
begin
|
|
KillTimer(Handle, FTimerId);
|
|
FTimer := 0;
|
|
end;
|
|
end;
|
|
|
|
function TAMonthListBox.GetDate: TDateTime;
|
|
var
|
|
Year, Month, Day: Word;
|
|
begin
|
|
if ItemIndex = -1 then Result := NullDate
|
|
else
|
|
begin
|
|
DecodeDate(TopDate, Year, Month, Day);
|
|
ChangeMonth(Year, Month, ItemIndex);
|
|
Result := EncodeDate(Year, Month, 1);
|
|
end;
|
|
end;
|
|
|
|
procedure TAMonthListBox.SetItemIndex(Value: Integer);
|
|
var
|
|
PrevItemIndex: Integer;
|
|
|
|
procedure InvalidateItemRect(Index: Integer);
|
|
var
|
|
R: TRect;
|
|
begin
|
|
if Index = -1 then Exit;
|
|
with R do
|
|
begin
|
|
Left := 0;
|
|
Top := Index * ItemHeight;
|
|
Right := ClientWidth;
|
|
Bottom := Top + ItemHeight;
|
|
end;
|
|
InvalidateRect(Handle, @R, False);
|
|
end;
|
|
|
|
begin
|
|
if FItemIndex <> Value then
|
|
begin
|
|
PrevItemIndex := FItemIndex;
|
|
FItemIndex := Value;
|
|
InvalidateItemRect(PrevItemIndex);
|
|
InvalidateItemRect(FItemIndex);
|
|
end;
|
|
end;
|
|
|
|
procedure TAMonthListBox.SetTopDate(Value: TDateTime);
|
|
begin
|
|
if FTopDate <> Value then
|
|
begin
|
|
FTopDate := Value;
|
|
Repaint;
|
|
end;
|
|
end;
|
|
|
|
procedure TAMonthListBox.WMDestroy(var Message: TMessage);
|
|
begin
|
|
FreeTimer;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TAMonthListBox.WMEraseBkgnd(var Message: TWMEraseBkgnd);
|
|
begin
|
|
Message.Result := 1;
|
|
end;
|
|
|
|
procedure TAMonthListBox.CMFontChanged(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
Canvas.Font.Assign(Font);
|
|
with TdxBarDateNavigator(Parent) do
|
|
begin
|
|
FItemHeight := FHeaderHeight - 2;
|
|
Self.Width := 2 * GetSystemMetrics(SM_CXBORDER) + 6 * FColWidth;
|
|
Self.Height := 2 * GetSystemMetrics(SM_CYBORDER) + 7 * ItemHeight;
|
|
end;
|
|
end;
|
|
|
|
procedure TAMonthListBox.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
with Params do
|
|
begin
|
|
Style := WS_POPUP or WS_BORDER;
|
|
ExStyle := WS_EX_TOPMOST;
|
|
WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
|
|
end;
|
|
end;
|
|
|
|
procedure AMonthListBoxTimerProc(Wnd: HWND; Msg: UINT; idEvent: UINT;
|
|
Time: DWORD); stdcall;
|
|
var
|
|
AControl: TAMonthListBox;
|
|
Year, Month, Day: Word;
|
|
begin
|
|
AControl := TAMonthListBox(FindControl(Wnd));
|
|
with AControl do
|
|
begin
|
|
DecodeDate(TopDate, Year, Month, Day);
|
|
ChangeMonth(Year, Month, 2 * Integer(idEvent > 5) - 1);
|
|
TopDate := EncodeDate(Year, Month, 1);
|
|
end;
|
|
end;
|
|
|
|
procedure TAMonthListBox.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
const
|
|
Times: array[1..4] of UINT = (500, 250, 100, 50);
|
|
var
|
|
Delta, Sign: Integer;
|
|
NewTimerId: UINT;
|
|
begin
|
|
if PtInRect(ClientRect, Point(X, Y)) then
|
|
begin
|
|
FreeTimer;
|
|
ItemIndex := Y div ItemHeight;
|
|
end
|
|
else
|
|
begin
|
|
ItemIndex := -1;
|
|
if Y < 0 then Delta := Y
|
|
else
|
|
if Y >= ClientHeight then
|
|
Delta := 1 + Y - ClientHeight
|
|
else Exit;
|
|
Sign := Delta div Abs(Delta);
|
|
NewTimerId := Sign + Delta div 12;
|
|
if Abs(NewTimerId) > 4 then
|
|
NewTimerId := Sign * 4;
|
|
NewTimerId := NewTimerId + 5;
|
|
if (FTimer = 0) or (NewTimerId <> FTimerId) then
|
|
begin
|
|
FreeTimer;
|
|
FTimerId := NewTimerId;
|
|
FTimer := SetTimer(Handle, FTimerId, Times[Abs(FTimerId - 5)],
|
|
@AMonthListBoxTimerProc);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TAMonthListBox.Paint;
|
|
const
|
|
Colors: array[Boolean] of TColor = (clWindow, clWindowText);
|
|
var
|
|
I: Integer;
|
|
Year, Month, Day: Word;
|
|
Selected: Boolean;
|
|
Rect: TRect;
|
|
S: string;
|
|
begin
|
|
DecodeDate(TopDate, Year, Month, Day);
|
|
with Rect do
|
|
begin
|
|
Left := 0;
|
|
Top := 0;
|
|
Right := ClientWidth;
|
|
Bottom := ItemHeight;
|
|
end;
|
|
for I := 0 to 6 do
|
|
begin
|
|
Selected := I = ItemIndex;
|
|
with Canvas do
|
|
begin
|
|
Font.Color := Colors[not Selected];
|
|
Brush.Color := Colors[Selected];
|
|
Windows.FillRect(Handle, Rect, Brush.Handle);
|
|
S := LongMonthNames[Month] + ' ' + IntToStr(Year);
|
|
DrawText(Handle, PChar(S), Length(S), Rect,
|
|
DT_SINGLELINE or DT_NOCLIP or DT_CENTER or DT_VCENTER);
|
|
end;
|
|
IncMonth(Year, Month);
|
|
OffsetRect(Rect, 0, ItemHeight);
|
|
end;
|
|
end;
|
|
|
|
{ TdxBarCustomCalendar }
|
|
|
|
constructor TdxBarCustomCalendar.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ControlStyle := ControlStyle + [csDoubleClicks];
|
|
FFirstDate := Date;
|
|
FSelStart := FFirstDate;
|
|
FSelFinish := FSelStart;
|
|
FStyle := csFlat;
|
|
end;
|
|
|
|
function TdxBarCustomCalendar.GetFlat: Boolean;
|
|
begin
|
|
Result := FStyle <> cs3D;
|
|
end;
|
|
|
|
function TdxBarCustomCalendar.GetUltraFlat: Boolean;
|
|
begin
|
|
Result := Style = csUltraFlat;
|
|
end;
|
|
|
|
procedure TdxBarCustomCalendar.SetStyle(Value: TdxBarCalendarStyle);
|
|
begin
|
|
if FStyle <> Value then
|
|
begin
|
|
FStyle := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarCustomCalendar.WMCancelMode(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
CancelAll;
|
|
end;
|
|
|
|
procedure TdxBarCustomCalendar.WMCaptureChanged(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
with Message do
|
|
if (lParam <> 0) and (HWND(lParam) <> Handle) then CancelAll;
|
|
end;
|
|
|
|
procedure TdxBarCustomCalendar.WMEraseBkgnd(var Message: TWMEraseBkgnd);
|
|
begin
|
|
Message.Result := 1;
|
|
end;
|
|
|
|
function TdxBarCustomCalendar.GetStyle: TdxBarCalendarStyle;
|
|
begin
|
|
Result := FStyle;
|
|
end;
|
|
|
|
function TdxBarCustomCalendar.GetRealFirstDate: TDateTime;
|
|
begin
|
|
Result := FirstDate;
|
|
end;
|
|
|
|
function TdxBarCustomCalendar.GetRealLastDate: TDateTime;
|
|
begin
|
|
Result := LastDate;
|
|
end;
|
|
|
|
function TdxBarCustomCalendar.GetSelStart: TDateTime;
|
|
begin
|
|
if (FSelStart < FSelFinish) or (FSelFinish = NullDate) then
|
|
Result := FSelStart
|
|
else
|
|
Result := FSelFinish;
|
|
end;
|
|
|
|
function TdxBarCustomCalendar.GetSelFinish: TDateTime;
|
|
begin
|
|
if FSelStart < FSelFinish then
|
|
Result := FSelFinish
|
|
else
|
|
Result := FSelStart;
|
|
end;
|
|
|
|
procedure TdxBarCustomCalendar.SetFirstDate(Value: TDateTime);
|
|
begin
|
|
if FFirstDate <> Value then
|
|
begin
|
|
FFirstDate := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarCustomCalendar.SetSelStart(Value: TDateTime);
|
|
begin
|
|
FSelStart := Value;
|
|
FSelFinish := NullDate;
|
|
SelFinish := Value;
|
|
end;
|
|
|
|
procedure TdxBarCustomCalendar.SetSelFinish(Value: TDateTime);
|
|
var
|
|
OldSelFinish: TDateTime;
|
|
begin
|
|
if FSelFinish <> Value then
|
|
begin
|
|
CheckFirstDate;
|
|
OldSelFinish := FSelFinish;
|
|
FSelFinish := Value;
|
|
if FSelFinish <> OldSelFinish then
|
|
begin
|
|
CheckFirstDate;
|
|
Repaint;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarCustomCalendar.CancelAll;
|
|
begin
|
|
SendMessage(Handle, WM_LBUTTONUP, 0, LParam(PointToSmallPoint(Point(-1, -1))));
|
|
end;
|
|
|
|
procedure TdxBarCustomCalendar.DoDateTimeChanged;
|
|
begin
|
|
if Assigned(FOnDateTimeChanged) then FOnDateTimeChanged(Self);
|
|
end;
|
|
|
|
procedure TdxBarCustomCalendar.DoInternalSelectPeriod(ADate: TDateTime);
|
|
var
|
|
PrevSelFinish: TDateTime;
|
|
begin
|
|
if (SelFinish <> ADate) and (ADate <> NullDate) then
|
|
begin
|
|
PrevSelFinish := FSelFinish;
|
|
SelFinish := ADate;
|
|
if FSelFinish = PrevSelFinish then Repaint;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarCustomCalendar.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
with Params do
|
|
Style := Style or WS_CLIPCHILDREN;
|
|
end;
|
|
|
|
procedure TdxBarCustomCalendar.CreateWnd;
|
|
begin
|
|
inherited CreateWnd;
|
|
SendMessage(Handle, CM_FONTCHANGED, 0, 0);
|
|
end;
|
|
|
|
procedure TdxBarCustomCalendar.MouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
ADate: TDateTime;
|
|
begin
|
|
if ssDouble in Shift then Exit;
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
ADate := PosToDateTime(Point(X, Y));
|
|
if Button = mbLeft then
|
|
begin
|
|
FDragDate := SelStart;
|
|
if ADate <> NullDate then SelStart := ADate;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarCustomCalendar.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
ADate: TDateTime;
|
|
begin
|
|
ADate := NullDate;
|
|
if (ssLeft in Shift) and (GetCapture = Handle) then
|
|
ADate := PosToDateTime(Point(X, Y));
|
|
inherited MouseMove(Shift, X, Y);
|
|
if (ssLeft in Shift) and (GetCapture = Handle) then
|
|
if ADate <> NullDate then SelFinish := ADate
|
|
else
|
|
if not PtInRect(ClientRect, Point(X, Y)) then
|
|
DoInternalSelectPeriod(FDragDate);
|
|
Update;
|
|
end;
|
|
|
|
{ TdxBarDateNavigator }
|
|
|
|
constructor TdxBarDateNavigator.Create(AOwner: TComponent);
|
|
var
|
|
Year, Month, Day: Word;
|
|
begin
|
|
inherited Create(AOwner);
|
|
Visible := False;
|
|
DecodeDate(FFirstDate, Year, Month, Day);
|
|
FFirstDate := EncodeDate(Year, Month, 1);
|
|
Width := 20;
|
|
Height := 20;
|
|
FColCount := 1;
|
|
FRowCount := 1;
|
|
ShowTodayButton := True;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.CheckSelection(MarginDate: TDateTime);
|
|
begin
|
|
Repaint;
|
|
end;
|
|
|
|
function TdxBarDateNavigator.ColOfDate(ADate: TDateTime): Integer;
|
|
begin
|
|
Result := DayOfWeek(ADate) - StartOfWeek - 1;
|
|
if Result < 0 then Inc(Result, 7);
|
|
end;
|
|
|
|
function TdxBarDateNavigator.GetHeaderRect: TRect;
|
|
begin
|
|
with Result do
|
|
begin
|
|
Left := 0;
|
|
Top := 0;
|
|
Right := ClientWidth;
|
|
Bottom := Top + FHeaderHeight;
|
|
end;
|
|
end;
|
|
|
|
function TdxBarDateNavigator.GetInternalRect: TRect;
|
|
begin
|
|
with Result do
|
|
begin
|
|
Left := 0;
|
|
Top := FHeaderHeight + Byte(not Flat);
|
|
Right := ClientWidth;
|
|
Bottom := Top + FDaysOfWeekHeight + 6 * FRowHeight + 1;
|
|
end;
|
|
end;
|
|
|
|
function TdxBarDateNavigator.GetLeftArrowRect: TRect;
|
|
begin
|
|
SetRect(Result, 1, 1, FColWidth - 1, FHeaderHeight - 1);
|
|
end;
|
|
|
|
function TdxBarDateNavigator.GetRightArrowRect: TRect;
|
|
begin
|
|
SetRect(Result, ClientWidth - FColWidth, 1,
|
|
ClientWidth - 1 - Byte(not Flat), FHeaderHeight - 1);
|
|
end;
|
|
|
|
function TdxBarDateNavigator.GetMonthNameRect: TRect;
|
|
begin
|
|
Result := GetInternalRect;
|
|
with Result do
|
|
begin
|
|
Inc(Left, FColWidth);
|
|
Dec(Right, FColWidth + Byte(not Flat));
|
|
Bottom := Top - Byte(not Flat) - 1;
|
|
Top := Bottom - (FHeaderHeight - 2);
|
|
end;
|
|
end;
|
|
|
|
function TdxBarDateNavigator.GetTodayButtonRect: TRect;
|
|
begin
|
|
Result :=
|
|
Bounds(
|
|
(ClientWidth - FTodayButtonWidth - Byte(ShowClearButton) * FClearButtonWidth) div
|
|
(3 - Byte(not ShowClearButton)),
|
|
ClientHeight - FButtonsRegionHeight + FButtonsOffset,
|
|
FTodayButtonWidth, FButtonsHeight);
|
|
end;
|
|
|
|
function TdxBarDateNavigator.GetClearButtonRect: TRect;
|
|
begin
|
|
Result :=
|
|
Bounds(ClientWidth - FClearButtonWidth -
|
|
(ClientWidth - Byte(ShowTodayButton) * FTodayButtonWidth - FClearButtonWidth) div
|
|
(3 - Byte(not ShowTodayButton)),
|
|
ClientHeight - FButtonsRegionHeight + FButtonsOffset,
|
|
FClearButtonWidth, FButtonsHeight);
|
|
end;
|
|
|
|
function TdxBarDateNavigator.GetShowButtonsArea: Boolean;
|
|
begin
|
|
Result := ShowTodayButton or ShowClearButton;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.FreeTimer;
|
|
begin
|
|
if FTimer > 0 then
|
|
begin
|
|
KillTimer(Handle, FTimer);
|
|
FTimer := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.RepaintTodayButton;
|
|
var
|
|
R: TRect;
|
|
begin
|
|
R := GetTodayButtonRect;
|
|
InvalidateRect(Handle, @R, False);
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.RepaintClearButton;
|
|
var
|
|
R: TRect;
|
|
begin
|
|
R := GetClearButtonRect;
|
|
InvalidateRect(Handle, @R, False);
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.WMDestroy(var Message: TMessage);
|
|
begin
|
|
FreeTimer;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.WMNCCalcSize(var Message: TWMNCCalcSize);
|
|
begin
|
|
inherited;
|
|
if Flat then
|
|
InflateRect(Message.CalcSize_Params^.rgrc[0], -1, -1);
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.WMNCPaint(var Message: TWMNCPaint);
|
|
var
|
|
R, CR: TRect;
|
|
Delta: Integer;
|
|
DC: HDC;
|
|
begin
|
|
inherited;
|
|
if Flat then
|
|
begin
|
|
GetWindowRect(Handle, R);
|
|
OffsetRect(R, -R.Left, -R.Top);
|
|
DC := GetWindowDC(Handle);
|
|
if Style = csFlat then
|
|
begin
|
|
Windows.GetClientRect(Handle, CR);
|
|
Delta := (R.Right - CR.Right) div 2 - 1;
|
|
InflateRect(R, -Delta, -Delta);
|
|
DrawEdge(DC, R, BDR_SUNKENOUTER, BF_RECT);
|
|
end
|
|
else
|
|
FrameRect(DC, R, GetSysColorBrush(COLOR_BTNSHADOW));
|
|
ReleaseDC(Handle, DC);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.WMSize(var Message: TWMSize);
|
|
begin
|
|
inherited;
|
|
SetSize;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.CMFontChanged(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
Canvas.Font.Assign(Font);
|
|
FColWidth := 3 * Canvas.TextWidth('0');
|
|
FSideWidth := 2 * Canvas.TextWidth('0');
|
|
FRowHeight := Canvas.TextHeight('0') + 2;
|
|
FHeaderHeight := FRowHeight + 2 + Byte(Flat);
|
|
FDaysOfWeekHeight := FRowHeight + 1;
|
|
FTodayButtonWidth := Canvas.TextWidth(sdxBarDatePopupToday) +
|
|
FColWidth;
|
|
FClearButtonWidth := Canvas.TextWidth(sdxBarDatePopupClear) +
|
|
FColWidth;
|
|
FButtonsOffset := Font.Size div 2;
|
|
FButtonsHeight := MulDiv(Font.Size, 5, 2);
|
|
FButtonsRegionHeight := FButtonsOffset + FButtonsHeight +
|
|
Font.Size * 3 div 4;
|
|
SendMessage(Handle, WM_SIZE, 0, 0);
|
|
end;
|
|
|
|
function TdxBarDateNavigator.GetStyle: TdxBarCalendarStyle;
|
|
begin
|
|
Result := inherited GetStyle;
|
|
if (Result = csFlat) and FCombo.PainterClass.IsDateNavigatorFlat then
|
|
Result := csUltraFlat;
|
|
end;
|
|
|
|
function TdxBarDateNavigator.GetRealFirstDate: TDateTime;
|
|
var
|
|
ACol: Integer;
|
|
begin
|
|
Result := FirstDate;
|
|
ACol := ColOfDate(FirstDate);
|
|
if ACol = 0 then
|
|
Result := Result - 7
|
|
else
|
|
Result := Result - ACol;
|
|
end;
|
|
|
|
function TdxBarDateNavigator.GetRealLastDate: TDateTime;
|
|
var
|
|
Year, Month, Day: Word;
|
|
ACol: Integer;
|
|
begin
|
|
Result := LastDate;
|
|
DecodeDate(Result, Year, Month, Day);
|
|
ACol := ColOfDate(EncodeDate(Year, Month, 1));
|
|
Result := Result + 6 * 7 - DaysPerMonth(Year, Month) - ACol;
|
|
if ACol = 0 then Result := Result - 7;
|
|
end;
|
|
|
|
function TdxBarDateNavigator.GetLastDate: TDateTime;
|
|
var
|
|
Year, Month, Day: Word;
|
|
begin
|
|
DecodeDate(FirstDate, Year, Month, Day);
|
|
Result := EncodeDate(Year, Month, DaysPerMonth(Year, Month));
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.SetFirstDate(Value: TDateTime);
|
|
begin
|
|
Value := DateOf(Value) - (GetDateElement(Value, 3) - 1);
|
|
inherited SetFirstDate(Value);
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.SetSelFinish(Value: TDateTime);
|
|
begin
|
|
if FSelFinish <> Value then
|
|
begin
|
|
FSelStart := Value;
|
|
inherited SetSelFinish(Value);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.StepToPast;
|
|
var
|
|
Year, Month, Day: Word;
|
|
begin
|
|
DecodeDate(FirstDate, Year, Month, Day);
|
|
DecMonth(Year, Month);
|
|
FirstDate := EncodeDate(Year, Month, 1);
|
|
if SelStart > LastDate then
|
|
CheckSelection(LastDate)
|
|
else
|
|
Repaint;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.StepToFuture;
|
|
var
|
|
Year, Month, Day: Word;
|
|
begin
|
|
DecodeDate(FirstDate, Year, Month, Day);
|
|
IncMonth(Year, Month);
|
|
FirstDate := EncodeDate(Year, Month, 1);
|
|
if SelStart < FirstDate then
|
|
CheckSelection(FirstDate)
|
|
else
|
|
Repaint;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.CancelAll;
|
|
begin
|
|
inherited;
|
|
DeactivateAll;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.CheckFirstDate;
|
|
var
|
|
Year, Month, Day: Word;
|
|
begin
|
|
if FSelStart < RealFirstDate then
|
|
begin
|
|
DecodeDate(FSelStart, Year, Month, Day);
|
|
ChangeMonth(Year, Month, -1{(ColCount * RowCount - 1)});
|
|
FirstDate := EncodeDate(Year, Month, CheckDay(Year, Month, Day));
|
|
end;
|
|
if FSelStart > RealLastDate then
|
|
FirstDate := DateOf(FSelStart);
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.DeactivateAll;
|
|
begin
|
|
FreeTimer;
|
|
if FListBox <> nil then
|
|
begin
|
|
FListBox.Free;
|
|
FListBox := nil;
|
|
end;
|
|
FTodayButtonActive := False;
|
|
FClearButtonActive := False;
|
|
end;
|
|
|
|
function TdxBarDateNavigator.PosToDateTime(P: TPoint): TDateTime;
|
|
var
|
|
ACol, ARow, X, Y: Integer;
|
|
R: TRect;
|
|
Year, Month, Day, AYear, AMonth: Word;
|
|
ADate: TDateTime;
|
|
begin
|
|
if PtInRect(ClientRect, P) then
|
|
begin
|
|
ACol := P.X div (ClientWidth div ColCount);
|
|
ARow := P.Y div (ClientHeight div RowCount);
|
|
R := GetInternalRect;
|
|
with R do
|
|
begin
|
|
Inc(Top, FDaysOfWeekHeight);
|
|
Inc(Left, FSideWidth);
|
|
Dec(Right, FSideWidth);
|
|
Bottom := Top + 6 * FRowHeight;
|
|
if PtInRect(R, P) then
|
|
begin
|
|
Dec(P.X, Left);
|
|
Dec(P.Y, Top);
|
|
X := P.X div FColWidth;
|
|
Y := P.Y div FRowHeight;
|
|
DecodeDate(FirstDate, Year, Month, Day);
|
|
ChangeMonth(Year, Month, ARow * ColCount + ACol);
|
|
ADate := EncodeDate(Year, Month, 1);
|
|
Result := ADate - ColOfDate(ADate) + Y * 7 + X;
|
|
if (ACol + ARow = 0) and (ColOfDate(FirstDate) = 0) then
|
|
Result := Result - 7;
|
|
DecodeDate(Result, AYear, AMonth, Day);
|
|
if ((Result < ADate) and (ACol + ARow > 0)) or
|
|
((Result >= ADate + DaysPerMonth(Year, Month)) and
|
|
not ((ACol = ColCount - 1) and (ARow = RowCount - 1))) then
|
|
Result := NullDate;
|
|
end
|
|
else
|
|
Result := NullDate;
|
|
end;
|
|
end
|
|
else
|
|
Result := NullDate;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
with Params do
|
|
begin
|
|
if IsPopup then
|
|
begin
|
|
Style := WS_CHILD or Byte(not UltraFlat) * WS_DLGFRAME;
|
|
ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
|
|
WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
|
|
end;
|
|
if not Flat then
|
|
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.CreateWnd;
|
|
begin
|
|
inherited;
|
|
if FCombo.CurItemLink <> nil then
|
|
Font.Handle := CloneFont(FCombo.CurItemLink.BarControl.EditFontHandle);
|
|
Font.Color := clWindowText;
|
|
Canvas.Font := Font;
|
|
if IsPopup then
|
|
begin
|
|
Windows.SetParent(Handle, 0);
|
|
CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.DblClick;
|
|
var
|
|
P: TPoint;
|
|
begin
|
|
inherited;
|
|
GetCursorPos(P);
|
|
Windows.ScreenToClient(Handle, P);
|
|
if not IsPopup and (PosToDateTime(P) <> NullDate) then
|
|
FCombo.FForm.ModalResult := mrOk;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.KeyDown(var Key: Word; Shift: TShiftState);
|
|
var
|
|
AYear, AMonth, ADay: Word;
|
|
|
|
procedure MoveByMonth(AForward: Boolean);
|
|
begin
|
|
DecodeDate(SelStart, AYear, AMonth, ADay);
|
|
if AForward then
|
|
IncMonth(AYear, AMonth)
|
|
else
|
|
DecMonth(AYear, AMonth);
|
|
ADay := CheckDay(AYear, AMonth, ADay);
|
|
SelStart := EncodeDate(AYear, AMonth, ADay);
|
|
end;
|
|
|
|
begin
|
|
inherited KeyDown(Key, Shift);
|
|
if IsPopup then
|
|
case Key of
|
|
VK_RETURN:
|
|
if FListBox = nil then DoDateTimeChanged;
|
|
VK_LEFT: SelStart := SelStart - 1;
|
|
VK_RIGHT: SelStart := SelStart + 1;
|
|
VK_UP: SelStart := SelStart - 7;
|
|
VK_DOWN: SelStart := SelStart + 7;
|
|
VK_HOME:
|
|
if Shift = [ssCtrl] then
|
|
SelStart := SelStart - (GetDateElement(SelStart, 3) - 1)
|
|
else
|
|
SelStart := SelStart - ColOfDate(SelStart);
|
|
VK_END:
|
|
if Shift = [ssCtrl] then
|
|
begin
|
|
DecodeDate(SelStart, AYear, AMonth, ADay);
|
|
SelStart := SelStart + (DaysPerMonth(AYear, AMonth) - ADay)
|
|
end
|
|
else
|
|
SelStart := SelStart + (6 - ColOfDate(SelStart));
|
|
VK_PRIOR: MoveByMonth(False);
|
|
VK_NEXT: MoveByMonth(True)
|
|
end;
|
|
end;
|
|
|
|
procedure ADateNavigatorTimerProc(Wnd: HWND; Msg: UINT; idEvent: UINT;
|
|
Time: DWORD); stdcall;
|
|
var
|
|
AControl: TdxBarDateNavigator;
|
|
P: TPoint;
|
|
begin
|
|
AControl := TdxBarDateNavigator(FindControl(Wnd));
|
|
GetCursorPos(P);
|
|
P := AControl.ScreenToClient(P);
|
|
with AControl do
|
|
case idEvent of
|
|
1: if PtInRect(GetLeftArrowRect, P) then StepToPast;
|
|
2: if PtInRect(GetRightArrowRect, P) then StepToFuture;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.MouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
Col, Row: Integer;
|
|
Year, Month, Day: Word;
|
|
R: TRect;
|
|
begin
|
|
if (Button = mbLeft) and IsPopup then
|
|
if ShowTodayButton and PtInRect(GetTodayButtonRect, Point(X, Y)) then
|
|
begin
|
|
FTodayButtonActive := True;
|
|
FTodayButtonPressed := True;
|
|
RepaintTodayButton;
|
|
Exit;
|
|
end
|
|
else
|
|
if ShowClearButton and PtInRect(GetClearButtonRect, Point(X, Y)) then
|
|
begin
|
|
FClearButtonActive := True;
|
|
FClearButtonPressed := True;
|
|
RepaintClearButton;
|
|
Exit;
|
|
end
|
|
else
|
|
if ShowButtonsArea and (Y >= ClientHeight - FButtonsRegionHeight) then
|
|
Exit;
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
if Button = mbLeft then
|
|
begin
|
|
Col := X div (ClientWidth div ColCount);
|
|
Row := Y div (ClientHeight div RowCount);
|
|
if PtInRect(GetMonthNameRect, Point(X, Y)) then
|
|
begin // show month's list box
|
|
FListBoxDelta := Row * ColCount + Col;
|
|
FListBox := TAMonthListBox.Create(Self);
|
|
FListBox.Visible := False;
|
|
FListBox.Parent := Self;
|
|
DecodeDate(FirstDate, Year, Month, Day);
|
|
ChangeMonth(Year, Month, FListBoxDelta - 3);
|
|
R := GetMonthNameRect;
|
|
MapWindowPoints(Handle, 0, R, 2);
|
|
with TAMonthListBox(FListBox) do
|
|
begin
|
|
Font.Assign(Self.Font);
|
|
SendMessage(Handle, CM_FONTCHANGED, 0, 0);
|
|
TopDate := EncodeDate(Year, Month, 1);
|
|
Left := (R.Left + R.Right - Width) div 2;
|
|
Top := (R.Top + R.Bottom) div 2 - Height div 2;
|
|
ShowWindow(Handle, SW_SHOWNOACTIVATE);
|
|
end;
|
|
end
|
|
else
|
|
if PtInRect(GetLeftArrowRect, Point(X, Y)) then
|
|
begin // shift by month to past
|
|
StepToPast;
|
|
if FTimer = 0 then
|
|
FTimer := SetTimer(Handle, 1, ADateNavigatorTime,
|
|
@ADateNavigatorTimerProc);
|
|
end
|
|
else
|
|
if PtInRect(GetRightArrowRect, Point(X, Y)) then
|
|
begin // shift by month to future
|
|
StepToFuture;
|
|
if FTimer = 0 then
|
|
FTimer := SetTimer(Handle, 2, ADateNavigatorTime,
|
|
@ADateNavigatorTimerProc);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
P: TPoint;
|
|
begin
|
|
if FTimer > 0 then Exit;
|
|
if FListBox <> nil then
|
|
begin
|
|
P := Point(X, Y);
|
|
MapWindowPoints(Handle, FListBox.Handle, P, 1);
|
|
TAMonthListBox(FListBox).MouseMove(Shift, P.X, P.Y);
|
|
Exit;
|
|
end;
|
|
if FTodayButtonActive then
|
|
begin
|
|
if FTodayButtonPressed <> PtInRect(GetTodayButtonRect, Point(X, Y)) then
|
|
begin
|
|
FTodayButtonPressed := not FTodayButtonPressed;
|
|
RepaintTodayButton;
|
|
end;
|
|
Exit;
|
|
end;
|
|
if FClearButtonActive then
|
|
begin
|
|
if FClearButtonPressed <> PtInRect(GetClearButtonRect, Point(X, Y)) then
|
|
begin
|
|
FClearButtonPressed := not FClearButtonPressed;
|
|
RepaintClearButton;
|
|
end;
|
|
Exit;
|
|
end;
|
|
inherited MouseMove(Shift, X, Y);
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
var
|
|
ADate: TDateTime;
|
|
Year, Month, Day: Word;
|
|
P: TPoint;
|
|
begin
|
|
if FTimer > 0 then
|
|
begin
|
|
FreeTimer;
|
|
Exit;
|
|
end;
|
|
if FListBox <> nil then
|
|
begin
|
|
ADate := TAMonthListBox(FListBox).Date;
|
|
FListBox.Free;
|
|
FListBox := nil;
|
|
if ADate <> NullDate then
|
|
begin
|
|
DecodeDate(ADate, Year, Month, Day);
|
|
ChangeMonth(Year, Month, -FListBoxDelta);
|
|
FirstDate := EncodeDate(Year, Month, 1);
|
|
if SelStart < FirstDate then
|
|
CheckSelection(FirstDate)
|
|
else
|
|
if SelStart > LastDate then
|
|
CheckSelection(LastDate)
|
|
else
|
|
Repaint;
|
|
end;
|
|
Exit;
|
|
end;
|
|
if FTodayButtonActive then
|
|
begin
|
|
FTodayButtonActive := False;
|
|
if FTodayButtonPressed then
|
|
SelStart := Date
|
|
else
|
|
Exit;
|
|
end;
|
|
if FClearButtonActive then
|
|
begin
|
|
FClearButtonActive := False;
|
|
if FClearButtonPressed then
|
|
SelStart := NullDate
|
|
else
|
|
Exit;
|
|
end;
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
if not (ssDouble in Shift) then
|
|
begin
|
|
P := Point(X, Y);
|
|
if PtInRect(ClientRect, P) and
|
|
((PosToDateTime(P) <> NullDate) or
|
|
ShowTodayButton and PtInRect(GetTodayButtonRect, P) or
|
|
ShowClearButton and PtInRect(GetClearButtonRect, P)) then
|
|
DoDateTimeChanged
|
|
else
|
|
DoInternalSelectPeriod(FDragDate);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.Paint;
|
|
const
|
|
FontColors: array[Boolean] of Integer = (COLOR_WINDOWTEXT, COLOR_HIGHLIGHTTEXT);
|
|
BrushColors: array[Boolean, Boolean] of TColor =
|
|
((clWindow, clHighlight), (clWindow, clBtnFace));
|
|
var
|
|
I, J, ArrowHeight: Integer;
|
|
Region, Rgn: HRGN;
|
|
CurDate, ALastDate: TDateTime;
|
|
|
|
procedure ExcludeRect(const R: TRect);
|
|
begin
|
|
Rgn := CreateRectRgnIndirect(R);
|
|
CombineRgn(Region, Region, Rgn, RGN_DIFF);
|
|
DeleteObject(Rgn);
|
|
end;
|
|
|
|
procedure DrawArrow(const R: TRect; LeftArrow: Boolean);
|
|
var
|
|
X, Sign: Integer;
|
|
P: array[1..3] of TPoint;
|
|
Rgn: HRGN;
|
|
begin
|
|
with Canvas, R do
|
|
begin
|
|
if LeftArrow then
|
|
X := Left - 1
|
|
else
|
|
X := Right;
|
|
Sign := 2 * Byte(LeftArrow) - 1;
|
|
P[1] := Point(X + Sign * (FSideWidth - 1), (Top + Bottom - ArrowHeight) div 2);
|
|
P[2] := Point(P[1].X, P[1].Y + ArrowHeight - 1);
|
|
P[3] := Point(P[1].X - Sign * ArrowHeight div 2, P[1].Y + ArrowHeight div 2);
|
|
Pen.Color := clBtnText;
|
|
Brush.Color := clBtnText;
|
|
Polygon(P);
|
|
// exclude arrow area from clipregion
|
|
if LeftArrow then
|
|
begin
|
|
Inc(P[1].X);
|
|
Inc(P[2].X);
|
|
end
|
|
else
|
|
Inc(P[3].X);
|
|
Dec(P[1].Y);
|
|
Inc(P[2].Y);
|
|
Rgn := CreatePolygonRgn(P, 3, WINDING);
|
|
ExtSelectClipRgn(Handle, Rgn, RGN_DIFF);
|
|
DeleteObject(Rgn);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawMonth(Col, Row: Integer);
|
|
var
|
|
Size: TSize;
|
|
R, TextR, SideR: TRect;
|
|
I, J, DayBase, CurDay, ADaysPerMonth: Integer;
|
|
Year, Month, Day: Word;
|
|
ADate, DateBase: TDateTime;
|
|
S: string;
|
|
Selected: Boolean;
|
|
begin
|
|
DecodeDate(FirstDate, Year, Month, Day);
|
|
ChangeMonth(Year, Month, Row * ColCount + Col);
|
|
with Canvas do
|
|
begin
|
|
R := GetInternalRect;
|
|
with R do
|
|
ExcludeRect(Rect(Left + FSideWidth, Top, Right - FSideWidth, Bottom - 1));
|
|
// draw header's frame
|
|
TextR := GetHeaderRect;
|
|
with TextR do ArrowHeight := (Bottom - Top) div 2;
|
|
if not Odd(ArrowHeight) then Inc(ArrowHeight);
|
|
if not Flat then InflateRect(TextR, 0, 1);
|
|
ExcludeRect(TextR);
|
|
if not Flat then InflateRect(TextR, 0, -1);
|
|
Brush.Color := clBtnFace;
|
|
Pen.Color := clBtnText;
|
|
if not Flat then
|
|
with TextR do
|
|
begin
|
|
MoveToEx(Handle, Left, Bottom, nil);
|
|
Windows.LineTo(Handle, Right, Bottom);
|
|
if Col = ColCount - 1 then
|
|
begin
|
|
MoveToEx(Handle, Right - 1, Top, nil);
|
|
Windows.LineTo(Handle, Right - 1, Bottom);
|
|
Dec(TextR.Right);
|
|
end;
|
|
end;
|
|
if UltraFlat then
|
|
with TextR do
|
|
begin
|
|
Windows.FillRect(Handle, Rect(Left, Bottom - 1, Right, Bottom), COLOR_BTNSHADOW + 1);
|
|
Dec(Bottom);
|
|
end
|
|
else
|
|
begin
|
|
DrawEdge(Handle, TextR, BDR_RAISEDINNER, BF_TOP or BF_BOTTOM or
|
|
Byte(Col = 0) * BF_LEFT or Byte(Col = ColCount - 1) * BF_RIGHT);
|
|
InflateRect(TextR, -1, -1);
|
|
end;
|
|
{if Col < ColCount - 1 then
|
|
with TextR do
|
|
begin
|
|
SideR := Rect(Right - 1, Top + 2, Right + 1, Bottom - 2);
|
|
DrawEdge(Handle, SideR, EDGE_ETCHED, BF_LEFT);
|
|
with SideR do
|
|
begin
|
|
Windows.FillRect(Handle, Rect(Left, Top - 1, Right, Top), Brush.Handle);
|
|
Windows.FillRect(Handle, Rect(Left, Bottom, Right, Bottom + 1), Brush.Handle);
|
|
end;
|
|
end;}
|
|
// draw arrows
|
|
if Row = 0 then
|
|
begin
|
|
if Col = 0 then DrawArrow(TextR, True);
|
|
if Col = ColCount - 1 then DrawArrow(TextR, False);
|
|
end;
|
|
// write month's and year's names
|
|
S := LongMonthNames[Month] + ' ' + IntToStr(Year);
|
|
GetTextExtentPoint32(Handle, PChar(S), Length(S), Size);
|
|
SetTextColor(Handle, GetSysColor(COLOR_BTNTEXT));
|
|
Brush.Color := FCombo.PainterClass.DateNavigatorHeaderColor;
|
|
with TextR do
|
|
ExtTextOut(Handle, (Left + Right - Size.cX) div 2, (Top + Bottom - Size.cY) div 2,
|
|
ETO_CLIPPED or ETO_OPAQUE, @TextR, PChar(S), Length(S), nil);
|
|
// write first letters of day's names
|
|
Brush.Color := clWindow;
|
|
with TextR do
|
|
begin
|
|
Left := R.Left + FSideWidth;
|
|
Right := R.Right - FSideWidth;
|
|
Top := R.Top;
|
|
Bottom := Top + FDaysOfWeekHeight - 2;
|
|
Windows.FillRect(Handle, Rect(Left - 8, Top, Left, Bottom + 2), Brush.Handle);
|
|
Windows.FillRect(Handle, Rect(Right, Top, Right + 8, Bottom + 2), Brush.Handle);
|
|
Pen.Color := clBtnShadow;
|
|
MoveToEx(Handle, Left, Bottom, nil);
|
|
Windows.LineTo(Handle, Right, Bottom);
|
|
Pen.Color := clWindow;
|
|
MoveToEx(Handle, Left, Bottom + 1, nil);
|
|
Windows.LineTo(Handle, Right, Bottom + 1);
|
|
Right := Left;
|
|
end;
|
|
for I := 0 to 6 do
|
|
begin
|
|
with TextR do
|
|
begin
|
|
Left := Right;
|
|
Right := Left + FColWidth;
|
|
end;
|
|
J := StartOfWeek + 1 + I;
|
|
if J > 7 then Dec(J, 7);
|
|
if cxGetWritingDirection(Font.Charset, ShortDayNames[1]) = coRightToLeft then
|
|
S := AnsiLastChar(ShortDayNames[J])
|
|
else
|
|
S := WideString(ShortDayNames[J])[1];
|
|
GetTextExtentPoint32(Handle, PChar(S), Length(S), Size);
|
|
with TextR do
|
|
ExtTextOut(Handle, Right - 3 - Size.cX, (Top + Bottom - Size.cY) div 2,
|
|
ETO_OPAQUE, @TextR, PChar(S), Length(S), nil);
|
|
end;
|
|
// write numbers of days
|
|
DateBase := EncodeDate(Year, Month, 1) - 1;
|
|
DayBase := 1 - ColOfDate(DateBase + 1);
|
|
if (DayBase = 1) and (Col + Row = 0) then Dec(DayBase, 7);
|
|
ADaysPerMonth := DaysPerMonth(Year, Month);
|
|
for I := 0 to 6 do
|
|
for J := 0 to 5 do
|
|
begin
|
|
with TextR do
|
|
begin
|
|
Left := R.Left + FSideWidth + I * FColWidth;
|
|
Top := R.Top + FDaysOfWeekHeight + J * FRowHeight;
|
|
Right := Left + FColWidth;
|
|
Bottom := Top + FRowHeight;
|
|
end;
|
|
|
|
CurDay := DayBase + J * 7 + I;
|
|
if (CurDay < 1) and (Col + Row <> 0) or
|
|
(CurDay > ADaysPerMonth) and ((Col <> ColCount - 1) or (Row <> RowCount - 1)) then
|
|
ADate := NullDate
|
|
else
|
|
ADate := DateBase + CurDay;
|
|
Selected := (ADate >= SelStart) and (ADate <= SelFinish);
|
|
|
|
if ADate = NullDate then
|
|
begin
|
|
Brush.Color := clWindow;
|
|
Windows.FillRect(Handle, TextR, Brush.Handle);
|
|
Continue;
|
|
end;
|
|
|
|
SideR := TextR;
|
|
// draw frame around current date
|
|
if ADate = CurDate then
|
|
begin
|
|
Brush.Color := clMaroon;
|
|
FrameRect(TextR);
|
|
InflateRect(TextR, -1, -1);
|
|
end;
|
|
if Selected and UltraFlat then
|
|
Brush.Color := TDummyBarManager(FCombo.BarManager).FlatToolbarsSelColor
|
|
else
|
|
Brush.Color := BrushColors[Flat, Selected];
|
|
// draw text of day's number
|
|
if not Selected and
|
|
(((ADate < FirstDate) and (Col + Row = 0)) or
|
|
((ADate > ALastDate) and
|
|
(Col = ColCount - 1) and (Row = RowCount - 1))) then
|
|
SetTextColor(Handle, GetSysColor(COLOR_GRAYTEXT))
|
|
else
|
|
SetTextColor(Handle, GetSysColor(FontColors[Selected and not UltraFlat]));
|
|
|
|
S := IntToStr(GetDateElement(ADate, 3));
|
|
GetTextExtentPoint32(Handle, PChar(S), Length(S), Size);
|
|
with SideR do
|
|
ExtTextOut(Handle,
|
|
Right - 3 - Size.cX, (Top + Bottom - Size.cY) div 2,
|
|
ETO_OPAQUE, @TextR, PChar(S), Length(S), nil);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure DrawButton(R: TRect; ACaption: string; Pressed: Boolean);
|
|
begin
|
|
ExcludeRect(R);
|
|
FCombo.PainterClass.DateNavigatorDrawButton(FCombo, Canvas.Handle, R, ACaption, Pressed);
|
|
end;
|
|
|
|
begin
|
|
CurDate := Date;
|
|
ALastDate := LastDate;
|
|
Region := CreateRectRgnIndirect(ClientRect);
|
|
with Canvas do
|
|
begin
|
|
for I := 0 to RowCount - 1 do
|
|
for J := 0 to ColCount - 1 do DrawMonth(J, I);
|
|
if IsPopup and ShowButtonsArea then
|
|
begin
|
|
Pen.Color := clBtnShadow;
|
|
MoveTo(FSideWidth, ClientHeight - FButtonsRegionHeight - 1);
|
|
LineTo(ClientWidth - FSideWidth, PenPos.Y);
|
|
with PenPos do
|
|
ExcludeRect(Rect(FSideWidth, Y, X, Y + 1));
|
|
// draw today and clear buttons
|
|
if ShowTodayButton then
|
|
DrawButton(GetTodayButtonRect, sdxBarDatePopupToday,
|
|
FTodayButtonActive and FTodayButtonPressed);
|
|
if ShowClearButton then
|
|
DrawButton(GetClearButtonRect, sdxBarDatePopupClear,
|
|
FClearButtonActive and FClearButtonPressed);
|
|
end;
|
|
Brush.Color := clWindow;
|
|
PaintRgn(Handle, Region);
|
|
DeleteObject(Region);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarDateNavigator.SetSize;
|
|
begin
|
|
Width := GetWidth;
|
|
Height := GetHeight;
|
|
end;
|
|
|
|
function TdxBarDateNavigator.GetWidth: Integer;
|
|
var
|
|
WR, CR: TRect;
|
|
begin
|
|
GetWindowRect(Handle, WR);
|
|
OffsetRect(WR, -WR.Left, -WR.Top);
|
|
Windows.GetClientRect(Handle, CR);
|
|
Result := WR.Right - CR.Right + 2 * FSideWidth + 7 * FColWidth;
|
|
end;
|
|
|
|
function TdxBarDateNavigator.GetHeight: Integer;
|
|
var
|
|
WR, CR: TRect;
|
|
begin
|
|
GetWindowRect(Handle, WR);
|
|
OffsetRect(WR, -WR.Left, -WR.Top);
|
|
Windows.GetClientRect(Handle, CR);
|
|
Result := WR.Bottom - CR.Bottom +
|
|
FHeaderHeight + Byte(not Flat) + FDaysOfWeekHeight + 6 * FRowHeight + 1;
|
|
if IsPopup and ShowButtonsArea then
|
|
Inc(Result, FButtonsRegionHeight);
|
|
end;
|
|
|
|
{ TdxBarDateCombo }
|
|
|
|
constructor TdxBarDateCombo.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
Glyph.LoadFromResourceName(HInstance, 'DXBARDATECOMBO');
|
|
FShowTodayButton := True;
|
|
FShowClearButton := True;
|
|
FInternalUpdate := True;
|
|
try
|
|
Date := SysUtils.Date;
|
|
finally
|
|
FInternalUpdate := False;
|
|
end;
|
|
FDatePopup := TdxBarDateNavigator.Create(Self);
|
|
with FDatePopup do
|
|
begin
|
|
FCombo := Self;
|
|
IsPopup := True;
|
|
end;
|
|
FShowDayText := True;
|
|
end;
|
|
|
|
destructor TdxBarDateCombo.Destroy;
|
|
begin
|
|
FDatePopup.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TdxBarDateCombo.GetCurDate: TDateTime;
|
|
begin
|
|
Result := GetDateOfText(CurText);
|
|
end;
|
|
|
|
function TdxBarDateCombo.GetDate: TDateTime;
|
|
begin
|
|
Result := GetDateOfText(Text);
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.SetCurDate(Value: TDateTime);
|
|
begin
|
|
CurText := GetDateText(CheckDate(Value));
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.SetDate(Value: TDateTime);
|
|
begin
|
|
Text := GetDateText(CheckDate(Value));
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.DateChanged(Sender: TObject);
|
|
begin
|
|
if (CurItemLink <> nil) and (CurItemLink.RealItemLink <> nil) then
|
|
begin
|
|
CurItemLink.RealItemLink.BringToTopInRecentList(True);
|
|
BarManager.HideAll;
|
|
end;
|
|
Date := TdxBarDateNavigator(Sender).SelStart;
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.DialogClick(Sender: TObject);
|
|
begin
|
|
case TWinControl(Sender).Tag of
|
|
1: FDateNavigator.SelStart := SysUtils.Date;
|
|
2: FDateNavigator.SelStart := NullDate;
|
|
end;
|
|
DialogDateChanged(nil);
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.DialogDateChanged(Sender: TObject);
|
|
begin
|
|
FDateEdit.Text := GetDateText(FDateNavigator.SelStart);
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.DialogDateEditChange(Sender: TObject);
|
|
var
|
|
ADate: TDateTime;
|
|
begin
|
|
ADate := GetDateOfText(FDateEdit.Text);
|
|
if (ADate <> NullDate) or (FDateEdit.Text = '') then
|
|
FDateNavigator.SelStart := ADate;
|
|
end;
|
|
|
|
function TdxBarDateCombo.GetDateOfText(AText: string): TDateTime;
|
|
var
|
|
P: Integer;
|
|
begin
|
|
P := Pos(' ', AText);
|
|
if P > 0 then Delete(AText, 1, P);
|
|
Result := TextToDate(AText);
|
|
end;
|
|
|
|
function TdxBarDateCombo.GetDateText(ADate: TDateTime): string;
|
|
begin
|
|
if ADate = NullDate then
|
|
Result := ''
|
|
else
|
|
begin
|
|
if ShowDayText then
|
|
Result := FormatDateTime('ddd ', ADate)
|
|
else
|
|
Result := '';
|
|
Result := Result + DateToText(ADate);
|
|
end;
|
|
end;
|
|
|
|
function TdxBarDateCombo.IsMinDateStored: Boolean;
|
|
begin
|
|
Result := FMinDate <> 0;
|
|
end;
|
|
|
|
function TdxBarDateCombo.IsMaxDateStored: Boolean;
|
|
begin
|
|
Result := FMaxDate <> 0;
|
|
end;
|
|
|
|
function TdxBarDateCombo.IsTextStored: Boolean;
|
|
begin
|
|
Result := FDateOnStart = bdsCustom;
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.SetDateOnStart(Value: TdxBarDateOnStart);
|
|
begin
|
|
if FDateOnStart <> Value then
|
|
begin
|
|
FDateOnStart := Value;
|
|
CheckDateOnStart;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.SetMinDate(Value: TDateTime);
|
|
begin
|
|
if Value > FMaxDate then Value := FMaxDate;
|
|
if FMinDate <> Value then
|
|
begin
|
|
FMinDate := Value;
|
|
CheckRange;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.SetMaxDate(Value: TDateTime);
|
|
begin
|
|
if Value < FMinDate then Value := FMinDate;
|
|
if FMaxDate <> Value then
|
|
begin
|
|
FMaxDate := Value;
|
|
CheckRange;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.SetShowDayText(Value: Boolean);
|
|
begin
|
|
if FShowDayText <> Value then
|
|
begin
|
|
FShowDayText := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.Loaded;
|
|
begin
|
|
CheckDateOnStart;
|
|
inherited Loaded;
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.Changed;
|
|
begin
|
|
FInternalUpdate := True;
|
|
try
|
|
Date := Date; // reset
|
|
finally
|
|
FInternalUpdate := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.CheckDateOnStart;
|
|
begin
|
|
FInternalUpdate := True;
|
|
try
|
|
case DateOnStart of
|
|
bdsToday:
|
|
Date := SysUtils.Date;
|
|
bdsNullDate:
|
|
Date := NullDate;
|
|
bdsCustom:
|
|
Date := Date;
|
|
end;
|
|
finally
|
|
FInternalUpdate := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.CheckRange;
|
|
var
|
|
ADate: TDateTime;
|
|
begin
|
|
ADate := CheckDate(Date);
|
|
if Date <> ADate then
|
|
Date := ADate;
|
|
end;
|
|
|
|
function TdxBarDateCombo.CheckKeyForDropDownWindow(Key: Word; Shift: TShiftState): Boolean;
|
|
begin
|
|
Result := (Key = VK_RETURN) or
|
|
inherited CheckKeyForDropDownWindow(Key, Shift);
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.CloseUp;
|
|
begin
|
|
with FDatePopup do
|
|
if IsWindowVisible(Handle) then
|
|
begin
|
|
if GetCapture = Handle then ReleaseCapture;
|
|
DeactivateAll;
|
|
end;
|
|
inherited;
|
|
FDatePopup.Parent := nil;
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.DropDown(X, Y: Integer);
|
|
var
|
|
ADate: TDateTime;
|
|
begin
|
|
with FDatePopup do
|
|
begin
|
|
ADate := Date;
|
|
if ADate = NullDate then ADate := SysUtils.Date;
|
|
FirstDate := ADate;
|
|
SelStart := ADate;
|
|
OnDateTimeChanged := DateChanged;
|
|
ShowTodayButton := Self.ShowTodayButton;
|
|
ShowClearButton := Self.ShowClearButton;
|
|
Parent := CurItemLink.Control.Parent; //BarManager.MainForm;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
function TdxBarDateCombo.GetDropDownWindow: HWND;
|
|
begin
|
|
Result := inherited GetDropDownWindow;
|
|
if Result = 0 then Result := FDatePopup.Handle;
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.SetText(Value: string);
|
|
begin
|
|
Value := GetDateText(CheckDate(GetDateOfText(Value)));
|
|
if not FInternalUpdate then
|
|
FDateOnStart := bdsCustom;
|
|
inherited;
|
|
end;
|
|
|
|
function TdxBarDateCombo.CheckDate(ADate: TDateTime): TDateTime;
|
|
begin
|
|
if (MinDate <> 0) or (MaxDate <> 0) then
|
|
begin
|
|
if ADate < MinDate then ADate := MinDate;
|
|
if ADate > MaxDate then ADate := MaxDate;
|
|
end;
|
|
Result := ADate;
|
|
end;
|
|
|
|
procedure TdxBarDateCombo.DoClick;
|
|
var
|
|
ButtonOk, ButtonCancel, ButtonToday, ButtonClear: TButton;
|
|
W, H, D: Integer;
|
|
begin
|
|
inherited;
|
|
if not Assigned(OnClick) and not ReadOnly then
|
|
begin
|
|
FForm := TForm.Create(nil);
|
|
with FForm do
|
|
begin
|
|
BorderStyle := bsDialog;
|
|
Caption := cxGetResourceString(@dxSBAR_DATEDIALOGCAPTION);
|
|
Font := BarManager.Font;
|
|
Position := poScreenCenter;
|
|
|
|
FDateEdit := TEdit.Create(FForm);
|
|
with FDateEdit do
|
|
begin
|
|
Parent := FForm;
|
|
OnChange := DialogDateEditChange;
|
|
HandleNeeded;
|
|
end;
|
|
FDateNavigator := TdxBarDateNavigator.Create(FForm);
|
|
with FDateNavigator do
|
|
begin
|
|
Style := cs3D;
|
|
FCombo := Self;
|
|
Parent := FForm;
|
|
Visible := True;
|
|
OnDateTimeChanged := DialogDateChanged;
|
|
HandleNeeded;
|
|
end;
|
|
ButtonOk := TButton.Create(FForm);
|
|
with ButtonOk do
|
|
begin
|
|
Caption := cxGetResourceString(@dxSBAR_DIALOGOK);
|
|
Default := True;
|
|
ModalResult := mrOk;
|
|
Parent := FForm;
|
|
end;
|
|
ButtonCancel := TButton.Create(FForm);
|
|
with ButtonCancel do
|
|
begin
|
|
Caption := cxGetResourceString(@dxSBAR_DIALOGCANCEL);
|
|
Cancel := True;
|
|
ModalResult := mrCancel;
|
|
Parent := FForm;
|
|
end;
|
|
if ShowTodayButton then
|
|
begin
|
|
ButtonToday := TButton.Create(FForm);
|
|
with ButtonToday do
|
|
begin
|
|
Caption := sdxBarDatePopupToday;
|
|
Parent := FForm;
|
|
Tag := 1;
|
|
OnClick := DialogClick;
|
|
end;
|
|
end
|
|
else
|
|
ButtonToday := nil;
|
|
if ShowClearButton then
|
|
begin
|
|
ButtonClear := TButton.Create(FForm);
|
|
with ButtonClear do
|
|
begin
|
|
Caption := sdxBarDatePopupClear;
|
|
Parent := FForm;
|
|
Tag := 2;
|
|
OnClick := DialogClick;
|
|
end;
|
|
end
|
|
else
|
|
ButtonClear := nil;
|
|
|
|
W := MulDiv(FDateNavigator.FTodayButtonWidth, 3, 2);
|
|
H := MulDiv(FDateNavigator.FButtonsHeight, 7, 6);
|
|
D := FDateNavigator.FButtonsHeight div 4;
|
|
|
|
ClientWidth := D + FDateNavigator.Width + D + W + D;
|
|
ClientHeight := D + FDateEdit.Height + D + FDateNavigator.Height + D;
|
|
FDateEdit.SetBounds(D, D, FDateNavigator.Width, FDateEdit.Height);
|
|
FDateNavigator.SetBounds(D, FDateEdit.Top + FDateEdit.Height + D, 0, 0);
|
|
ButtonOk.SetBounds(FDateEdit.Left + FDateEdit.Width + D, D, W, H);
|
|
ButtonCancel.SetBounds(ButtonOk.Left, ButtonOk.Top + ButtonOk.Height + D, W, H);
|
|
if ButtonToday <> nil then
|
|
ButtonToday.SetBounds(ButtonOk.Left, ClientHeight - D - H - D - H, W, H);
|
|
if ButtonClear <> nil then
|
|
ButtonClear.SetBounds(ButtonOk.Left, ClientHeight - D - H, W, H);
|
|
|
|
FDateEdit.Text := GetDateText(Date);
|
|
if ShowModal = mrOk then
|
|
Date := GetDateOfText(FDateEdit.Text);
|
|
Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TdxBarDateComboControl }
|
|
|
|
function TdxBarDateComboControl.GetDate: TDateTime;
|
|
begin
|
|
Result := Item.GetDateOfText(Text);
|
|
end;
|
|
|
|
function TdxBarDateComboControl.GetItem: TdxBarDateCombo;
|
|
begin
|
|
Result := TdxBarDateCombo(ItemLink.Item);
|
|
end;
|
|
|
|
procedure TdxBarDateComboControl.SetDate(const Value: TDateTime);
|
|
begin
|
|
Text := Item.GetDateText(Value);
|
|
end;
|
|
|
|
procedure TdxBarDateComboControl.WndProc(var Message: TMessage);
|
|
begin
|
|
with Message do
|
|
if Msg = WM_CHAR then
|
|
case wParam of
|
|
Ord('+'):
|
|
begin
|
|
if Date <> NullDate then Date := Date + 1;
|
|
wParam := 0;
|
|
end;
|
|
Ord('-'):
|
|
begin
|
|
if Date <> NullDate then Date := Date - 1;
|
|
wParam := 0;
|
|
end;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
{$IFNDEF DELPHI6}
|
|
|
|
{ TdxBarTreeNode }
|
|
|
|
destructor TdxBarTreeNode.Destroy;
|
|
begin
|
|
if Owner.Owner <> nil then
|
|
TdxBarTreeView(Owner.Owner).Delete(Self);
|
|
inherited;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
{ TdxBarTreeView }
|
|
|
|
constructor TdxBarTreeView.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
Visible := False;
|
|
ReadOnly := True;
|
|
SetBounds(0, 0, 150, 200);
|
|
end;
|
|
|
|
destructor TdxBarTreeView.Destroy;
|
|
|
|
procedure FreeNode(ANode: TTreeNode);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to ANode.Count - 1 do
|
|
FreeNode(ANode[0]);
|
|
ANode.Free;
|
|
end;
|
|
|
|
begin
|
|
while Items.Count <> 0 do
|
|
FreeNode(Items.GetFirstNode);
|
|
inherited;
|
|
end;
|
|
|
|
function TdxBarTreeView.FindNode(const AText: string): TTreeNode;
|
|
var
|
|
ANode: TTreeNode;
|
|
|
|
function FindOne(ARootNode: TTreeNode): TTreeNode;
|
|
var
|
|
ANode: TTreeNode;
|
|
begin
|
|
if AnsiCompareText(AText, ARootNode.Text) = 0 then Result := ARootNode
|
|
else
|
|
begin
|
|
Result := nil;
|
|
ANode := ARootNode.GetFirstChild;
|
|
while ANode <> nil do
|
|
begin
|
|
Result := FindOne(ANode);
|
|
if Result <> nil then Exit;
|
|
ANode := ARootNode.GetNextChild(ANode);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Result := nil;
|
|
with Items do
|
|
begin
|
|
ANode := GetFirstNode;
|
|
while ANode <> nil do
|
|
begin
|
|
Result := FindOne(ANode);
|
|
if Result <> nil then Break;
|
|
ANode := ANode.GetNext;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarTreeView.SaveAndHide;
|
|
begin
|
|
if (Selected <> nil) and FCombo.DoCanSelectNode then
|
|
if IsPopup then
|
|
begin
|
|
with FCombo do
|
|
begin
|
|
if (CurItemLink <> nil) and (CurItemLink.RealItemLink <> nil) then
|
|
CurItemLink.RealItemLink.BringToTopInRecentList(True);
|
|
BarManager.HideAll;
|
|
end;
|
|
FCombo.SelectedNode := Selected;
|
|
end
|
|
else
|
|
begin
|
|
FCombo.Text := Selected.Text;
|
|
FCombo.FForm.ModalResult := mrOk;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarTreeView.TVMSetImageList(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
if IsPopup then FCombo.UpdateEx;//DoImageListChanged;
|
|
end;
|
|
|
|
procedure TdxBarTreeView.TVMSetItem(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
if (FCombo.SelectedNode <> nil) and
|
|
(PTVItem(Message.lParam)^.hitem = FCombo.SelectedNode.ItemId) then
|
|
FCombo.DoSelectedNodeChanged;
|
|
end;
|
|
|
|
procedure TdxBarTreeView.WMCaptureChanged(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
if FCloseButtonIsTracking then
|
|
begin
|
|
FCloseButtonIsTracking := False;
|
|
FMouseAboveCloseButton := False;
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarTreeView.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
|
|
begin
|
|
inherited;
|
|
Message.MinMaxInfo^.ptMinTrackSize := Point(100, 100);
|
|
end;
|
|
|
|
procedure TdxBarTreeView.WMLButtonUp(var Message: TWMLButtonUp);
|
|
begin
|
|
inherited;
|
|
if FCloseButtonIsTracking then
|
|
begin
|
|
FCloseButtonIsTracking := False;
|
|
ReleaseCapture;
|
|
if FMouseAboveCloseButton then
|
|
FCombo.BarManager.HideAll
|
|
else
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarTreeView.WMNCCalcSize(var Message: TWMNCCalcSize);
|
|
begin
|
|
inherited;
|
|
if IsPopup then
|
|
FCombo.PainterClass.SysPanelCalcSize(Handle, Message.CalcSize_Params^.rgrc[0],
|
|
FCorner, FCombo, FCombo.AllowResizing);
|
|
end;
|
|
|
|
procedure TdxBarTreeView.WMNCHitTest(var Message: TWMNCHitTest);
|
|
var
|
|
PrevMouseAboveCloseButton: Boolean;
|
|
begin
|
|
inherited;
|
|
with Message do
|
|
if PtInRect(FGripRect, SmallPointToPoint(Pos)) then
|
|
Result := GetHitTestByCorner(FCorner)
|
|
else
|
|
begin
|
|
PrevMouseAboveCloseButton := FMouseAboveCloseButton;
|
|
FMouseAboveCloseButton := (GetTopWindow(0) = Handle) and
|
|
((GetCapture = 0) or FCloseButtonIsTracking) and
|
|
PtInRect(FCloseButtonRect, SmallPointToPoint(Pos));
|
|
if FMouseAboveCloseButton then Result := HTBORDER;
|
|
if PrevMouseAboveCloseButton <> FMouseAboveCloseButton then
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarTreeView.WMNCLButtonDown(var Message: TWMNCLButtonDown);
|
|
begin
|
|
inherited;
|
|
if FMouseAboveCloseButton then
|
|
begin
|
|
FCloseButtonIsTracking := True;
|
|
SetCapture(Handle);
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarTreeView.WMNCPaint(var Message: TWMNCPaint);
|
|
begin
|
|
inherited;
|
|
if IsPopup then
|
|
FCombo.PainterClass.SysPanelDraw(Handle, FCombo.AllowResizing,
|
|
FMouseAboveCloseButton, FCloseButtonIsTracking, FCloseButtonRect, FGripRect, FCorner);
|
|
end;
|
|
|
|
procedure TdxBarTreeView.WMSysColorChange(var Message: TWMSysColorChange);
|
|
begin
|
|
inherited;
|
|
RecreateWnd;
|
|
end;
|
|
|
|
procedure TdxBarTreeView.CMMouseLeave(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
if FMouseAboveCloseButton then
|
|
begin
|
|
FMouseAboveCloseButton := False;
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarTreeView.CNNotify(var Message: TWMNotify);
|
|
begin
|
|
case Message.NMHdr^.code of
|
|
TVN_DELETEITEM:
|
|
if FCombo.SelectedNode <> nil then
|
|
with PNMTreeView(Pointer(Message.NMHdr))^ do
|
|
if itemOld.hItem = FCombo.SelectedNode.ItemId then
|
|
FCombo.FSelectedNode := nil;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxBarTreeView.Change(Node: TTreeNode);
|
|
begin
|
|
inherited;
|
|
if (FCombo.FocusedItemLink <> nil) and IsPopup and (Node <> nil) then
|
|
FCombo.CurText := Node.Text;
|
|
end;
|
|
|
|
{$IFNDEF DELPHI6}
|
|
|
|
function TdxBarTreeView.CreateNode: TTreeNode;
|
|
begin
|
|
Result := TdxBarTreeNode.Create(Items);
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
procedure TdxBarTreeView.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited;
|
|
with Params do
|
|
begin
|
|
if csDesigning in FCombo.ComponentState then
|
|
Style := Style and not WS_CHILD or WS_POPUP;
|
|
if IsPopup then
|
|
begin
|
|
ExStyle := ExStyle and not WS_EX_CLIENTEDGE or WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
|
|
WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarTreeView.CreateWnd;
|
|
begin
|
|
inherited;
|
|
if IsPopup then
|
|
begin
|
|
Windows.SetParent(Handle, 0);
|
|
CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarTreeView.DblClick;
|
|
var
|
|
P: TPoint;
|
|
begin
|
|
inherited;
|
|
if FCombo.ChooseByDblClick then
|
|
begin
|
|
GetCursorPos(P);
|
|
Windows.ScreenToClient(Handle, P);
|
|
if GetHitTestInfoAt(P.X, P.Y) * [htOnItem, htOnIcon, htOnLabel, htOnStateIcon] <> [] then
|
|
SaveAndHide;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarTreeView.KeyDown(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
inherited;
|
|
if Key = VK_RETURN then SaveAndHide;
|
|
end;
|
|
|
|
procedure TdxBarTreeView.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
inherited;
|
|
if not FCombo.ChooseByDblClick and
|
|
(GetHitTestInfoAt(X, Y) * [htOnItem, htOnIcon, htOnLabel, htOnStateIcon] <> []) then
|
|
SaveAndHide;
|
|
end;
|
|
|
|
procedure TdxBarTreeView.SetFocus;
|
|
begin
|
|
end;
|
|
|
|
{ TdxBarTreeViewCombo }
|
|
|
|
constructor TdxBarTreeViewCombo.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
Glyph.LoadFromResourceName(HInstance, 'DXBARTREEVIEWCOMBO');
|
|
ShowEditor := False;
|
|
FAllowResizing := True;
|
|
FChooseByDblClick := True;
|
|
FShowImageInEdit := True;
|
|
FTreeView := TdxBarTreeView.Create(Self);
|
|
with TdxBarTreeView(FTreeView) do
|
|
begin
|
|
IsPopup := True;
|
|
FCombo := Self;
|
|
if not (csDesigning in Self.ComponentState) then
|
|
Parent := BarManager.MainForm;
|
|
end;
|
|
end;
|
|
|
|
destructor TdxBarTreeViewCombo.Destroy;
|
|
begin
|
|
if FTreeView <> nil then FTreeView.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetDropDownHeight: Integer;
|
|
begin
|
|
Result := FTreeView.Height;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetDropDownWidth: Integer;
|
|
begin
|
|
Result := FTreeView.Width;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetImages: TCurImageList;
|
|
begin
|
|
Result := FTreeView.Images;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetIndent: Integer;
|
|
begin
|
|
Result := FTreeView.Indent;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetItems: TTreeNodes;
|
|
begin
|
|
Result := FTreeView.Items;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetShowButtons: Boolean;
|
|
begin
|
|
Result := FTreeView.ShowButtons;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetShowLines: Boolean;
|
|
begin
|
|
Result := FTreeView.ShowLines;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetShowRoot: Boolean;
|
|
begin
|
|
Result := FTreeView.ShowRoot;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetSortType: TSortType;
|
|
begin
|
|
Result := FTreeView.SortType;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetStateImages: TCurImageList;
|
|
begin
|
|
Result := FTreeView.StateImages;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetOnExpanded: TTVExpandedEvent;
|
|
begin
|
|
Result := FTreeView.OnExpanded;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetOnExpanding: TTVExpandingEvent;
|
|
begin
|
|
Result := FTreeView.OnExpanding;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetOnChanging: TTVChangingEvent;
|
|
begin
|
|
Result := FTreeView.OnChanging;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetOnCollapsed: TTVExpandedEvent;
|
|
begin
|
|
Result := FTreeView.OnCollapsed;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetOnCollapsing: TTVCollapsingEvent;
|
|
begin
|
|
Result := FTreeView.OnCollapsing;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetOnCompare: TTVCompareEvent;
|
|
begin
|
|
Result := FTreeView.OnCompare;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetOnGetImageIndex: TTVExpandedEvent;
|
|
begin
|
|
Result := FTreeView.OnGetImageIndex;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetOnGetSelectedIndex: TTVExpandedEvent;
|
|
begin
|
|
Result := FTreeView.OnGetSelectedIndex;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetOnTreeViewChange: TTVChangedEvent;
|
|
begin
|
|
Result := FTreeView.OnChange;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetDropDownHeight(Value: Integer);
|
|
begin
|
|
if Value < 100 then Value := 100;
|
|
FTreeView.Height := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetDropDownWidth(Value: Integer);
|
|
begin
|
|
if Value < 100 then Value := 100;
|
|
FTreeView.Width := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetImages(Value: TCurImageList);
|
|
begin
|
|
FTreeView.Images := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetIndent(Value: Integer);
|
|
begin
|
|
FTreeView.Indent := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetItems(Value: TTreeNodes);
|
|
begin
|
|
FTreeView.Items := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetSelectedNode(Value: TTreeNode);
|
|
begin
|
|
if FSelectedNode <> Value then
|
|
begin
|
|
FSelectedNode := Value;
|
|
DoSelectedNodeChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetShowButtons(Value: Boolean );
|
|
begin
|
|
FTreeView.ShowButtons := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetShowImageInEdit(Value: Boolean);
|
|
begin
|
|
if FShowImageInEdit <> Value then
|
|
begin
|
|
FShowImageInEdit := Value;
|
|
if (Images <> nil) or (StateImages <> nil) then UpdateEx;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetShowLines(Value: Boolean);
|
|
begin
|
|
FTreeView.ShowLines := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetShowRoot(Value: Boolean);
|
|
begin
|
|
FTreeView.ShowRoot := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetSortType(Value: TSortType);
|
|
begin
|
|
FTreeView.SortType := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetStateImages(Value: TCurImageList);
|
|
begin
|
|
FTreeView.StateImages := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetOnExpanded(Value: TTVExpandedEvent);
|
|
begin
|
|
FTreeView.OnExpanded := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetOnExpanding(Value: TTVExpandingEvent);
|
|
begin
|
|
FTreeView.OnExpanding := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetOnChanging(Value: TTVChangingEvent);
|
|
begin
|
|
FTreeView.OnChanging := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetOnCollapsed(Value: TTVExpandedEvent);
|
|
begin
|
|
FTreeView.OnCollapsed := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetOnCollapsing(Value: TTVCollapsingEvent);
|
|
begin
|
|
FTreeView.OnCollapsing := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetOnCompare(Value: TTVCompareEvent);
|
|
begin
|
|
FTreeView.OnCompare := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetOnGetImageIndex(Value: TTVExpandedEvent);
|
|
begin
|
|
FTreeView.OnGetImageIndex := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetOnGetSelectedIndex(Value: TTVExpandedEvent);
|
|
begin
|
|
FTreeView.OnGetSelectedIndex := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetOnTreeViewChange(Value: TTVChangedEvent);
|
|
begin
|
|
FTreeView.OnChange := Value;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.FormSize(Sender: TObject);
|
|
var
|
|
H, W, D: Integer;
|
|
begin
|
|
W := 12 * FForm.Canvas.TextWidth('0');
|
|
H := MulDiv(FForm.Canvas.TextHeight('0'), 5, 3);
|
|
D := H div 4;
|
|
|
|
with FFormTreeView do
|
|
begin
|
|
Left := D;
|
|
Top := D;
|
|
Width := FForm.ClientWidth - (D + D + W + D);
|
|
Height := FForm.ClientHeight - (D + D);
|
|
end;
|
|
FButtonOk.SetBounds(FForm.ClientWidth - D - W, D, W, H);
|
|
FButtonCancel.SetBounds(FButtonOk.Left, FButtonOk.Top + FButtonOk.Height + D, W, H);
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.CheckKeyForDropDownWindow(Key: Word; Shift: TShiftState): Boolean;
|
|
begin
|
|
Result := (Key = VK_RETURN) or inherited CheckKeyForDropDownWindow(Key, Shift);
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.DoCanSelectNode: Boolean;
|
|
begin
|
|
Result := True;
|
|
if Assigned(FOnCanSelectNode) then
|
|
FOnCanSelectNode(Self, TreeView.Selected, Result);
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.DoSelectedNodeChanged;
|
|
var
|
|
AText: string;
|
|
begin
|
|
FInSelectedNodeChanged := True;
|
|
try
|
|
if SelectedNode = nil then
|
|
AText := ''
|
|
else
|
|
AText := SelectedNode.Text;
|
|
if Text = AText then
|
|
Change
|
|
else
|
|
Text := AText;
|
|
Update;
|
|
finally
|
|
FInSelectedNodeChanged := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.DrawInterior(ABarEditControl: TdxBarEditControl; ACanvas: TCanvas;
|
|
R: TRect; ItemLink: TdxBarItemLink);
|
|
var
|
|
DC: HDC;
|
|
ANode: TTreeNode;
|
|
AIndex: Integer;
|
|
S: string;
|
|
begin
|
|
if not HasImageInEdit then
|
|
inherited
|
|
else
|
|
begin
|
|
if FocusedItemLink = ItemLink then
|
|
ANode := FTreeView.Selected
|
|
else
|
|
ANode := SelectedNode;
|
|
DC := ACanvas.Handle;
|
|
FillRect(DC, R, ACanvas.Brush.Handle);
|
|
with R do
|
|
begin
|
|
Inc(Left);
|
|
if (StateImages <> nil) and (ANode <> nil) and
|
|
(0 <= ANode.StateIndex) and (ANode.StateIndex < StateImages.Count) then
|
|
with StateImages do
|
|
begin
|
|
Draw(ACanvas, Left, (Top + Bottom - Height) div 2, ANode.StateIndex);
|
|
Inc(Left, Width);
|
|
end;
|
|
if Images <> nil then
|
|
with Images do
|
|
begin
|
|
if ANode = nil then
|
|
AIndex := -1
|
|
else
|
|
if (0 <= ANode.SelectedIndex) and (ANode.SelectedIndex < Count) then
|
|
AIndex := ANode.SelectedIndex
|
|
else
|
|
if (0 <= ANode.ImageIndex) and (ANode.ImageIndex < Count) then
|
|
AIndex := ANode.ImageIndex
|
|
else
|
|
AIndex := -1;
|
|
if AIndex <> -1 then
|
|
Draw(ACanvas, Left, (Top + Bottom - Height) div 2, AIndex);
|
|
Inc(Left, Width + 3);
|
|
end;
|
|
if FocusedItemLink <> nil then
|
|
S := CurText
|
|
else
|
|
S := Text;
|
|
//Canvas.TextOut(Left + 2, (Top + Bottom - Canvas.TextHeight(S)) div 2, S);
|
|
Inc(Left, 2);
|
|
Dec(Right, 2);
|
|
DrawText(DC, PChar(S), Length(S), R, DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.DropDown(X, Y: Integer);
|
|
begin
|
|
FTreeView.Font.Handle := CloneFont(CurItemLink.BarControl.EditFontHandle);
|
|
if FFullExpand then FTreeView.FullExpand;
|
|
if CurText <> Text then
|
|
FTreeView.Selected := FTreeView.FindNode(CurText);
|
|
if (FTreeView.Selected = nil) and (FTreeView.Items.Count > 0) then
|
|
with FTreeView.Items[0] do
|
|
begin
|
|
Focused := True;
|
|
MakeVisible;
|
|
end;
|
|
if FTreeView.Selected <> nil then
|
|
FTreeView.Selected.MakeVisible;
|
|
inherited;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.GetDropDownWindow: HWND;
|
|
begin
|
|
Result := inherited GetDropDownWindow;
|
|
if Result = 0 then Result := FTreeView.Handle;
|
|
end;
|
|
|
|
function TdxBarTreeViewCombo.HasImageInEdit: Boolean;
|
|
begin
|
|
Result := FShowImageInEdit and ((Images <> nil) or (StateImages <> nil));
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.Loaded;
|
|
begin
|
|
inherited;
|
|
Text := FLoadedText;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited;
|
|
if Operation = opRemove then
|
|
if AComponent = FTreeView then FTreeView := nil;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.SetText(Value: string);
|
|
begin
|
|
if Text <> Value then
|
|
if csLoading in ComponentState then FLoadedText := Value
|
|
else
|
|
begin
|
|
if not FInSelectedNodeChanged then
|
|
FSelectedNode := FTreeView.FindNode(Value);
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewCombo.DoClick;
|
|
var
|
|
W, H, D, I, J: Integer;
|
|
begin
|
|
inherited;
|
|
if Assigned(OnClick) or ReadOnly then Exit;
|
|
|
|
FForm := TForm.Create(nil);
|
|
with FForm do
|
|
begin
|
|
if FAllowResizing then
|
|
BorderIcons := []
|
|
else
|
|
BorderStyle := bsDialog;
|
|
Caption := cxGetResourceString(@dxSBAR_TREEVIEWDIALOGCAPTION);
|
|
Font := BarManager.Font;
|
|
Position := poScreenCenter;
|
|
|
|
FFormTreeView := TdxBarTreeView.Create(FForm);
|
|
with FFormTreeView do
|
|
begin
|
|
FCombo := Self;
|
|
Visible := True;
|
|
Parent := FForm;
|
|
|
|
Images := FTreeView.Images;
|
|
Indent := FTreeView.Indent;
|
|
Items.Assign(FTreeView.Items);
|
|
ShowButtons := FTreeView.ShowButtons;
|
|
ShowLines := FTreeView.ShowLines;
|
|
ShowRoot := FTreeView.ShowRoot;
|
|
SortType := FTreeView.SortType;
|
|
StateImages := FTreeView.StateImages;
|
|
|
|
HandleNeeded;
|
|
while (ClientHeight <> FTreeView.ClientHeight) or
|
|
(ClientWidth <> FTreeView.ClientWidth) do
|
|
begin
|
|
ClientHeight := FTreeView.ClientHeight;
|
|
ClientWidth := FTreeView.ClientWidth;
|
|
end;
|
|
end;
|
|
FButtonOk := TButton.Create(FForm);
|
|
with FButtonOk do
|
|
begin
|
|
Caption := cxGetResourceString(@dxSBAR_DIALOGOK);
|
|
Default := True;
|
|
ModalResult := mrOk;
|
|
Parent := FForm;
|
|
end;
|
|
FButtonCancel := TButton.Create(FForm);
|
|
with FButtonCancel do
|
|
begin
|
|
Caption := cxGetResourceString(@dxSBAR_DIALOGCANCEL);
|
|
Cancel := True;
|
|
ModalResult := mrCancel;
|
|
Parent := FForm;
|
|
end;
|
|
|
|
Canvas.Font := Font;
|
|
W := 12 * Canvas.TextWidth('0');
|
|
H := MulDiv(Canvas.TextHeight('0'), 5, 3);
|
|
D := H div 4;
|
|
|
|
with FFormTreeView do
|
|
begin
|
|
Left := D;
|
|
Top := D;
|
|
end;
|
|
FButtonOk.SetBounds(FFormTreeView.BoundsRect.Right + D, D, W, H);
|
|
FButtonCancel.SetBounds(FButtonOk.Left, FButtonOk.Top + FButtonOk.Height + D, W, H);
|
|
I := D + FFormTreeView.Width + D + W + D;
|
|
J := D + FFormTreeView.Height + D;
|
|
while (I <> ClientWidth) or (J <> ClientHeight) do
|
|
begin
|
|
ClientWidth := I;
|
|
ClientHeight := J;
|
|
end;
|
|
|
|
OnResize := FormSize;
|
|
if FFullExpand then FFormTreeView.FullExpand;
|
|
FFormTreeView.Selected := FFormTreeView.FindNode(Text);
|
|
if (FFormTreeView.Selected = nil) and (FFormTreeView.Items.Count > 0) then
|
|
with FFormTreeView.Items[0] do
|
|
begin
|
|
Focused := True;
|
|
MakeVisible;
|
|
end;
|
|
if (ShowModal = mrOk) and (FFormTreeView.Selected <> nil) then
|
|
Text := FFormTreeView.Selected.Text;
|
|
while (FTreeView.ClientHeight <> FFormTreeView.ClientHeight) or
|
|
(FTreeView.ClientWidth <> FFormTreeView.ClientWidth) do
|
|
begin
|
|
FTreeView.ClientHeight := FFormTreeView.ClientHeight;
|
|
FTreeView.ClientWidth := FFormTreeView.ClientWidth;
|
|
end;
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
{ TdxBarTreeViewComboControl }
|
|
|
|
function TdxBarTreeViewComboControl.GetItem: TdxBarTreeViewCombo;
|
|
begin
|
|
Result := TdxBarTreeViewCombo(ItemLink.Item);
|
|
end;
|
|
|
|
function TdxBarTreeViewComboControl.GetHeight: Integer;
|
|
var
|
|
AItem: TdxBarTreeViewCombo;
|
|
Value: Integer;
|
|
begin
|
|
Result := inherited GetHeight;
|
|
AItem := Item;
|
|
if not IsVertical(Parent) and AItem.HasImageInEdit then
|
|
begin
|
|
if AItem.Images = nil then
|
|
Value := 0
|
|
else
|
|
Value := AItem.Images.Height;
|
|
if (AItem.StateImages <> nil) and (AItem.StateImages.Height > Value) then
|
|
Value := AItem.StateImages.Height;
|
|
Value := 2 + 1 + Value + 1 + 2;
|
|
if Value > Result then Result := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarTreeViewComboControl.SetFocused(Value: Boolean);
|
|
begin
|
|
inherited;
|
|
if Value then
|
|
with Item do
|
|
if SelectedNode = nil then
|
|
TreeView.Selected := TreeView.FindNode(Text)
|
|
else
|
|
TreeView.Selected := SelectedNode;
|
|
end;
|
|
|
|
{ TdxBarImageCombo }
|
|
|
|
constructor TdxBarImageCombo.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
Glyph.LoadFromResourceName(HInstance, 'DXBARIMAGECOMBO');
|
|
ShowEditor := False;
|
|
FImageChangeLink := TChangeLink.Create;
|
|
FImageChangeLink.OnChange := ImageListChange;
|
|
FShowText := True;
|
|
end;
|
|
|
|
destructor TdxBarImageCombo.Destroy;
|
|
begin
|
|
FImageChangeLink.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TdxBarImageCombo.GetImageIndexes(Index: Integer): Integer;
|
|
begin
|
|
Result := Integer(Items.Objects[Index]) - 1;
|
|
end;
|
|
|
|
procedure TdxBarImageCombo.SetImageIndexes(Index: Integer; Value: Integer);
|
|
begin
|
|
Items.Objects[Index] := TObject(Value + 1);
|
|
if Index = ItemIndex then Update;
|
|
end;
|
|
|
|
procedure TdxBarImageCombo.SetImages(Value: TCurImageList);
|
|
begin
|
|
if FImages <> nil then
|
|
FImages.UnRegisterChanges(FImageChangeLink);
|
|
FImages := Value;
|
|
if FImages <> nil then
|
|
begin
|
|
FImages.RegisterChanges(FImageChangeLink);
|
|
FImages.FreeNotification(Self);
|
|
end;
|
|
if not (csLoading in ComponentState) then ImagesChanged;
|
|
end;
|
|
|
|
procedure TdxBarImageCombo.SetShowText(Value: Boolean);
|
|
begin
|
|
if FShowText <> Value then
|
|
begin
|
|
FShowText := Value;
|
|
Update;
|
|
end
|
|
end;
|
|
|
|
procedure TdxBarImageCombo.ImageListChange(Sender: TObject);
|
|
begin
|
|
if not (csLoading in ComponentState) then ImagesChanged;
|
|
end;
|
|
|
|
procedure TdxBarImageCombo.ReadImageIndexes(Reader: TReader);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Reader.ReadListBegin;
|
|
for I := 0 to Items.Count - 1 do
|
|
if Reader.EndOfList then Break
|
|
else
|
|
ImageIndexes[I] := Reader.ReadInteger;
|
|
Reader.ReadListEnd;
|
|
end;
|
|
|
|
procedure TdxBarImageCombo.WriteImageIndexes(Writer: TWriter);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Writer.WriteListBegin;
|
|
for I := 0 to Items.Count - 1 do
|
|
Writer.WriteInteger(ImageIndexes[I]);
|
|
Writer.WriteListEnd;
|
|
end;
|
|
|
|
procedure TdxBarImageCombo.DialogListBoxDblClick(Sender: TObject);
|
|
begin
|
|
FForm.ModalResult := mrOk;
|
|
end;
|
|
|
|
procedure TdxBarImageCombo.DialogListBoxDrawItem(Control: TWinControl; Index: Integer;
|
|
Rect: TRect; State: TOwnerDrawState);
|
|
begin
|
|
FCanvas := FDialogListBox.Canvas;
|
|
DrawItem(Index, Rect, State);
|
|
FCanvas := nil;
|
|
end;
|
|
|
|
procedure TdxBarImageCombo.DialogListBoxMeasureItem(Control: TWinControl; Index: Integer;
|
|
var Height: Integer);
|
|
begin
|
|
FCanvas := FDialogListBox.Canvas;
|
|
MeasureItem(Index, Height);
|
|
FCanvas := nil;
|
|
end;
|
|
|
|
procedure TdxBarImageCombo.DefineProperties(Filer: TFiler);
|
|
begin
|
|
inherited;
|
|
Filer.DefineProperty('ImageIndexes', ReadImageIndexes, WriteImageIndexes, True);
|
|
end;
|
|
|
|
procedure TdxBarImageCombo.DrawItem(AIndex: Integer; ARect: TRect; AState: TOwnerDrawState);
|
|
var
|
|
OriginX, AImageIndex: Integer;
|
|
R: TRect;
|
|
S: string;
|
|
begin
|
|
if Assigned(OnDrawItem) or (Images = nil) then
|
|
inherited
|
|
else
|
|
with Canvas, ARect do
|
|
begin
|
|
FillRect(ARect);
|
|
with Images do
|
|
begin
|
|
if FShowText then
|
|
OriginX := Left + 1
|
|
else
|
|
OriginX := (Left + Right - Width) div 2;
|
|
R := Bounds(OriginX, (Top + Bottom - Height) div 2, Width, Height);
|
|
if AIndex <> -1 then
|
|
begin
|
|
AImageIndex := ImageIndexes[AIndex];
|
|
if (0 <= AImageIndex) and (AImageIndex < Count) then
|
|
Draw(Canvas, R.Left, R.Top, AImageIndex)
|
|
else
|
|
if FocusedItemLink = nil then R.Right := R.Left;
|
|
end
|
|
else
|
|
if FocusedItemLink = nil then R.Right := R.Left;
|
|
end;
|
|
if FShowText then
|
|
begin
|
|
if AIndex = -1 then
|
|
S := Text
|
|
else
|
|
S := Items[AIndex];
|
|
TextOut(R.Right + 2, (Top + Bottom - TextHeight(S)) div 2, S);
|
|
end;
|
|
if odFocused in AState then Windows.DrawFocusRect(Handle, ARect); // for hiding focus rect
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarImageCombo.ImagesChanged;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to LinkCount - 1 do
|
|
if Links[I].Control is TdxBarImageComboControl then
|
|
TdxBarImageComboControl(Links[I].Control).ImagesChanged;
|
|
end;
|
|
|
|
procedure TdxBarImageCombo.MeasureItem(AIndex: Integer; var AHeight: Integer);
|
|
begin
|
|
if Assigned(OnMeasureItem) then inherited
|
|
else
|
|
begin
|
|
inherited;
|
|
if (Images <> nil) and (1 + Images.Height + 1 > AHeight) then
|
|
AHeight := 1 + Images.Height + 1;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarImageCombo.MeasureItemWidth(AIndex: Integer; var AWidth: Integer);
|
|
begin
|
|
inherited;
|
|
if Images <> nil then
|
|
begin
|
|
if not FShowText then AWidth := 0;
|
|
Inc(AWidth, 1 + Images.Width + 1);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarImageCombo.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited;
|
|
if (Operation = opRemove) and (AComponent = Images) then Images := nil;
|
|
end;
|
|
|
|
procedure TdxBarImageCombo.DoClick;
|
|
var
|
|
W, H, D, C: Integer;
|
|
FButtonOk, FButtonCancel: TButton;
|
|
begin
|
|
inherited;
|
|
if Assigned(OnClick) or ReadOnly then Exit;
|
|
|
|
FForm := TForm.Create(nil);
|
|
with FForm do
|
|
begin
|
|
BorderStyle := bsDialog;
|
|
Caption := cxGetResourceString(@dxSBAR_IMAGEDIALOGCAPTION);
|
|
Font := BarManager.Font;
|
|
Position := poScreenCenter;
|
|
|
|
Canvas.Font := Font;
|
|
W := 12 * Canvas.TextWidth('0');
|
|
H := MulDiv(Canvas.TextHeight('0'), 5, 3);
|
|
D := H div 4;
|
|
|
|
FDialogListBox := TListBox.Create(FForm);
|
|
with FDialogListBox do
|
|
begin
|
|
Parent := FForm;
|
|
Items.Assign(Self.Items);
|
|
FCanvas := Canvas;
|
|
if Items.Count < DropDownCount then C := Items.Count
|
|
else C := DropDownCount;
|
|
ClientHeight := ItemsHeight[0] * C;
|
|
if Height < H + D + H then Height := H + D + H;
|
|
ClientWidth := GetDropDownWidth - (2 + 2);
|
|
FCanvas := nil;
|
|
Style := lbOwnerDrawVariable;
|
|
OnDblClick := DialogListBoxDblClick;
|
|
OnDrawItem := DialogListBoxDrawItem;
|
|
OnMeasureItem := DialogListBoxMeasureItem;
|
|
end;
|
|
FButtonOk := TButton.Create(FForm);
|
|
with FButtonOk do
|
|
begin
|
|
Caption := cxGetResourceString(@dxSBAR_DIALOGOK);
|
|
Default := True;
|
|
ModalResult := mrOk;
|
|
Parent := FForm;
|
|
end;
|
|
FButtonCancel := TButton.Create(FForm);
|
|
with FButtonCancel do
|
|
begin
|
|
Caption := cxGetResourceString(@dxSBAR_DIALOGCANCEL);
|
|
Cancel := True;
|
|
ModalResult := mrCancel;
|
|
Parent := FForm;
|
|
end;
|
|
|
|
ClientWidth := D + FDialogListBox.Width + D + W + D;
|
|
ClientHeight := D + FDialogListBox.Height + D;
|
|
with FDialogListBox do
|
|
begin
|
|
Left := D;
|
|
Top := D;
|
|
end;
|
|
FButtonOk.SetBounds(ClientWidth - D - W, D, W, H);
|
|
FButtonCancel.SetBounds(FButtonOk.Left, FButtonOk.Top + FButtonOk.Height + D, W, H);
|
|
|
|
FDialogListBox.ItemIndex := ItemIndex;
|
|
if ShowModal = mrOk then ItemIndex := FDialogListBox.ItemIndex;
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
{ TdxBarImageComboControl }
|
|
|
|
function TdxBarImageComboControl.GetHeight: Integer;
|
|
var
|
|
AItem: TdxBarImageCombo;
|
|
Value: Integer;
|
|
begin
|
|
Result := inherited GetHeight;
|
|
AItem := TdxBarImageCombo(Item);
|
|
if not IsVertical(Parent) and (AItem.Images <> nil) then
|
|
begin
|
|
Value := 2 + 1 + AItem.Images.Height + 1 + 2;
|
|
if Value > Result then Result := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarImageComboControl.ImagesChanged;
|
|
begin
|
|
Parent.RepaintBar;
|
|
end;
|
|
|
|
{ TdxBarToolbarsListItem }
|
|
|
|
function TdxBarToolbarsListItem.HasDesignTimeLinks: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
{ TdxBarToolbarsListItemControl }
|
|
|
|
procedure TdxBarToolbarsListItemControl.CreateSubMenuControl;
|
|
begin
|
|
if BarManager.IsCustomizing then Exit;
|
|
ClearInternalItemList;
|
|
Item.ItemLinks.Clear;
|
|
BarManager.CreateToolbarsPopupList(Item.ItemLinks);
|
|
Item.ItemLinks.BarControl := TdxBarSubMenuControl.Create(BarManager);
|
|
SubMenuControl.ItemLinks := Item.ItemLinks;
|
|
end;
|
|
|
|
{ TdxBarSpinEdit }
|
|
|
|
constructor TdxBarSpinEdit.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FIncrement := 1;
|
|
FPrefixPlace := ppEnd;
|
|
Text := '0';
|
|
end;
|
|
|
|
function TdxBarSpinEdit.GetCurValue: Extended;
|
|
begin
|
|
Result := TextToValue(CurText);
|
|
end;
|
|
|
|
function TdxBarSpinEdit.GetIntCurValue: Integer;
|
|
begin
|
|
Result := Trunc(CurValue);
|
|
end;
|
|
|
|
function TdxBarSpinEdit.GetIntValue: Integer;
|
|
begin
|
|
Result := Trunc(Value);
|
|
end;
|
|
|
|
function TdxBarSpinEdit.GetValue: Extended;
|
|
begin
|
|
Result := TextToValue(Text);
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.SetCurValue(Value: Extended);
|
|
begin
|
|
Value := GetCheckedValue(Value);
|
|
if CurValue <> Value then CurText := ValueToText(Value);
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.SetIncrement(Value: Extended);
|
|
begin
|
|
PrepareValue(Value);
|
|
case FValueType of
|
|
svtInteger:
|
|
if Value < 1 then Value := 1;
|
|
svtFloat:
|
|
if Value <= 0 then Value := 1;
|
|
end;
|
|
FIncrement := Value;
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.SetIntCurValue(Value: Integer);
|
|
begin
|
|
CurValue := Value;
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.SetIntValue(Value: Integer);
|
|
begin
|
|
Self.Value := Value;
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.SetMaxValue(Value: Extended);
|
|
begin
|
|
PrepareValue(Value);
|
|
if FMaxValue <> Value then
|
|
begin
|
|
FMaxValue := Value;
|
|
if FMinValue > FMaxValue then FMinValue := FMaxValue;
|
|
Self.Value := GetCheckedValue(Self.Value);
|
|
CurValue := GetCheckedValue(CurValue);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.SetMinValue(Value: Extended);
|
|
begin
|
|
PrepareValue(Value);
|
|
if FMinValue <> Value then
|
|
begin
|
|
FMinValue := Value;
|
|
if FMaxValue < FMinValue then FMaxValue := FMinValue;
|
|
Self.Value := GetCheckedValue(Self.Value);
|
|
CurValue := GetCheckedValue(CurValue);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.SetPrefix(const Value: string);
|
|
var
|
|
AValue: Extended;
|
|
begin
|
|
AValue := Self.Value;
|
|
if FPrefix <> Value then
|
|
begin
|
|
FPrefix := Value;
|
|
Text := ValueToText(AValue);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.SetPrefixPlace(Value: TdxBarSpinEditPrefixPlace);
|
|
begin
|
|
if FPrefixPlace <> Value then
|
|
begin
|
|
FPrefixPlace := Value;
|
|
Text := ValueToText(Self.Value);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.SetValue(Value: Extended);
|
|
begin
|
|
Value := GetCheckedValue(Value);
|
|
if Self.Value <> Value then Text := ValueToText(Value);
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.SetValueType(Value: TdxBarSpinEditValueType);
|
|
var
|
|
PrevValue, PrevCurValue: Extended;
|
|
begin
|
|
if FValueType <> Value then
|
|
begin
|
|
PrevValue := Self.Value;
|
|
PrevCurValue := Self.CurValue;
|
|
FValueType := Value;
|
|
if Value = svtInteger then
|
|
begin
|
|
Increment := Increment;
|
|
MinValue := MinValue;
|
|
MaxValue := MaxValue;
|
|
Self.Value := PrevValue;
|
|
CurValue := PrevCurValue;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TdxBarSpinEdit.IsIncrementStored: Boolean;
|
|
begin
|
|
Result := FIncrement <> 1;
|
|
end;
|
|
|
|
function TdxBarSpinEdit.IsMaxValueStored: Boolean;
|
|
begin
|
|
Result := FMaxValue <> 0;
|
|
end;
|
|
|
|
function TdxBarSpinEdit.IsMinValueStored: Boolean;
|
|
begin
|
|
Result := FMinValue <> 0;
|
|
end;
|
|
|
|
function TdxBarSpinEdit.IsValueStored: Boolean;
|
|
begin
|
|
Result := Value <> 0;
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.AddPrefix(var Text: string);
|
|
begin
|
|
if FPrefixPlace = ppEnd then
|
|
Text := Text + FPrefix
|
|
else
|
|
Text := FPrefix + Text;
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.RemovePrefix(var Text: string);
|
|
var
|
|
P: Integer;
|
|
begin
|
|
P := Pos(FPrefix, Text);
|
|
if P <> 0 then Delete(Text, P, Length(FPrefix));
|
|
end;
|
|
|
|
function TdxBarSpinEdit.CheckRange: Boolean;
|
|
begin
|
|
Result := (FMinValue <> FMaxValue) or (FMinValue <> 0);
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.DoButtonClick(Button: TdxBarSpinEditButton);
|
|
begin
|
|
case Button of
|
|
sbUp: CurValue := CurValue + Increment;
|
|
sbDown: CurValue := CurValue - Increment;
|
|
end;
|
|
if Assigned(FOnButtonClick) then FOnButtonClick(Self, Button);
|
|
end;
|
|
|
|
function TdxBarSpinEdit.GetCheckedValue(Value: Extended): Extended;
|
|
begin
|
|
Result := Value;
|
|
PrepareValue(Result);
|
|
if CheckRange then
|
|
begin
|
|
if Result < FMinValue then Result := FMinValue;
|
|
if Result > FMaxValue then Result := FMaxValue;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
|
|
const
|
|
Buttons: array[Boolean] of TdxBarSpinEditButton = (sbDown, sbUp);
|
|
var
|
|
Control: TdxBarSpinEditControl;
|
|
begin
|
|
inherited;
|
|
if (Key in [VK_UP, VK_DOWN]) and (FocusedItemLink <> nil) and not ReadOnly then
|
|
begin
|
|
Control := TdxBarSpinEditControl(FocusedItemLink.Control);
|
|
if Control.FTimerID = 0 then
|
|
begin
|
|
Control.ActiveButton := Buttons[Key = VK_UP];
|
|
DoButtonClick(Buttons[Key = VK_UP]);
|
|
end;
|
|
Key := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.KeyPress(var Key: Char);
|
|
var
|
|
KeySet: set of Char;
|
|
begin
|
|
inherited;
|
|
KeySet := [Chr(VK_BACK), ^C, ^V, ^X, '0'..'9'];
|
|
if FMinValue < 0 then Include(KeySet, '-');
|
|
if FValueType = svtFloat then Include(KeySet, DecimalSeparator);
|
|
if not (Key in KeySet) then Key := #0;
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.KeyUp(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
inherited;
|
|
if FocusedItemLink <> nil then
|
|
with TdxBarSpinEditControl(FocusedItemLink.Control) do
|
|
if (Key in [VK_UP, VK_DOWN]) and (FTimerID = 0) then
|
|
ActiveButton := sbNone;
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.PrepareValue(var Value: Extended);
|
|
begin
|
|
if FValueType = svtInteger then Value := Trunc(Value);
|
|
end;
|
|
|
|
function TdxBarSpinEdit.TextToValue(Text: string): Extended;
|
|
begin
|
|
RemovePrefix(Text);
|
|
try
|
|
if FValueType = svtInteger then
|
|
Result := StrToInt(Text)
|
|
else
|
|
Result := StrToFloat(Text);
|
|
except
|
|
on EConvertError do Result := FMinValue;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarSpinEdit.SetText(Value: string);
|
|
begin
|
|
RemovePrefix(Value);
|
|
try
|
|
if FValueType = svtInteger then
|
|
StrToInt(Value)
|
|
else
|
|
StrToFloat(Value);
|
|
except
|
|
on EConvertError do Exit;
|
|
end;
|
|
inherited SetText(ValueToText(GetCheckedValue(TextToValue(Value))));
|
|
end;
|
|
|
|
function TdxBarSpinEdit.ValueToText(Value: Extended): string;
|
|
begin
|
|
if FValueType = svtInteger then
|
|
Result := IntToStr(Trunc(Value))
|
|
else
|
|
Result := FloatToStr(Value);
|
|
AddPrefix(Result);
|
|
end;
|
|
|
|
{ TdxBarSpinEditControl }
|
|
|
|
function TdxBarSpinEditControl.GetItem: TdxBarSpinEdit;
|
|
begin
|
|
Result := TdxBarSpinEdit(ItemLink.Item);
|
|
end;
|
|
|
|
procedure TdxBarSpinEditControl.SetActiveButton(Value: TdxBarSpinEditButton);
|
|
begin
|
|
if FActiveButton <> Value then
|
|
begin
|
|
FActiveButton := Value;
|
|
ButtonPressed := Value <> sbNone;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarSpinEditControl.SetButtonPressed(Value: Boolean);
|
|
begin
|
|
if FButtonPressed <> Value then
|
|
begin
|
|
FButtonPressed := Value;
|
|
Repaint;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarSpinEditControl.BreakProcess;
|
|
begin
|
|
if GetCapture = Handle then ReleaseCapture;
|
|
ActiveButton := sbNone;
|
|
if FTimerID <> 0 then
|
|
begin
|
|
KillTimer(Handle, FTimerID);
|
|
FTimerID := 0;
|
|
end;
|
|
end;
|
|
|
|
function TdxBarSpinEditControl.ButtonFromPoint(P: TPoint): TdxBarSpinEditButton;
|
|
var
|
|
R: TRect;
|
|
begin
|
|
MapWindowPoints(Handle, Parent.Handle, P, 1);
|
|
R := FButtonsRect;
|
|
if PtInRect(R, P) and not Item.ReadOnly then
|
|
begin
|
|
with R do
|
|
Bottom := (Top + Bottom) div 2;
|
|
if PtInRect(R, P) then
|
|
Result := sbUp
|
|
else
|
|
Result := sbDown;
|
|
end
|
|
else
|
|
Result := sbNone;
|
|
end;
|
|
|
|
procedure TdxBarSpinEditControl.Paint(ARect: TRect; PaintType: TdxBarPaintType);
|
|
var
|
|
XSize, YSize, Size: Integer;
|
|
Selected: Boolean;
|
|
DC: HDC;
|
|
|
|
procedure DrawButton(AButton: TdxBarSpinEditButton);
|
|
begin
|
|
PainterClass.SpinEditControlDrawButton(Self, DC, ARect, XSize, YSize, Size,
|
|
Selected, AButton, FActiveButton, ButtonPressed);
|
|
end;
|
|
|
|
begin
|
|
SetRectEmpty(FButtonsRect);
|
|
with ARect do
|
|
begin
|
|
YSize := ((Bottom - Top) div 2 - 2) div 2;
|
|
XSize := 2 * YSize - 1;
|
|
Size := XSize + 2 * (1 + 1 + YSize);
|
|
if Size >= (Right - Left) div 2 then
|
|
Size := 0
|
|
else
|
|
Dec(Right, Size);
|
|
end;
|
|
inherited;
|
|
if Size = 0 then Exit;
|
|
Selected := DrawSelected;
|
|
DC := Parent.Canvas.Handle;
|
|
with ARect do
|
|
begin
|
|
Left := Right;
|
|
Right := Left + Size;
|
|
PainterClass.SpinEditControlDrawFrame(Self, DC, ARect);
|
|
FButtonsRect := ARect;
|
|
Size := (Bottom - Top) div 2;
|
|
DrawButton(sbUp);
|
|
DrawButton(sbDown);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarSpinEditControl.WndProc(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
with Message do
|
|
case Msg of
|
|
WM_MOUSEWHEEL:
|
|
begin
|
|
if SmallInt(HIWORD(TWMMOuse(Message).Keys)) > 0 then
|
|
Item.DoButtonClick(sbUp)
|
|
else
|
|
Item.DoButtonClick(sbDown);
|
|
end;
|
|
WM_CAPTURECHANGED:
|
|
if FTimerID <> 0 then BreakProcess;
|
|
WM_KILLFOCUS:
|
|
if FActiveButton <> sbNone then BreakProcess;
|
|
{WM_LBUTTONDBLCLK, }WM_LBUTTONDOWN:
|
|
if FActiveButton = sbNone then
|
|
begin
|
|
ActiveButton := ButtonFromPoint(SmallPointToPoint(TSmallPoint(lParam)));
|
|
if FActiveButton <> sbNone then
|
|
begin
|
|
SetCapture(Handle);
|
|
Item.DoButtonClick(FActiveButton);
|
|
FTimerID := SetTimer(Handle, 1, GetDoubleClickTime - 100, nil);
|
|
end;
|
|
end;
|
|
WM_LBUTTONUP:
|
|
if FTimerID <> 0 then BreakProcess;
|
|
WM_MOUSEMOVE:
|
|
if (FTimerID <> 0) and (FActiveButton <> sbNone) then
|
|
ButtonPressed := FActiveButton = ButtonFromPoint(SmallPointToPoint(TSmallPoint(lParam)));
|
|
WM_TIMER:
|
|
case wParam of
|
|
1: begin
|
|
KillTimer(Handle, FTimerID);
|
|
FTimerID := SetTimer(Handle, 2, 100, nil);
|
|
end;
|
|
2: if ButtonPressed then Item.DoButtonClick(FActiveButton);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TdxBarControlContainerItem }
|
|
|
|
constructor TdxBarControlContainerItem.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FPlace := TPlaceForm.CreateNew(nil);
|
|
with TPlaceForm(FPlace) do
|
|
BorderStyle := bsNone;
|
|
end;
|
|
|
|
destructor TdxBarControlContainerItem.Destroy;
|
|
begin
|
|
Control := nil;
|
|
FPlace.Free;
|
|
FPlace := nil;
|
|
inherited;
|
|
end;
|
|
|
|
function TdxBarControlContainerItem.GetControlVisible: Boolean;
|
|
begin
|
|
Result := (FPlace <> nil) and FPlace.Visible;
|
|
end;
|
|
|
|
function TdxBarControlContainerItem.GetInPlaceControl: Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to LinkCount - 1 do
|
|
begin
|
|
Result := (Links[I].Control <> nil) and
|
|
TdxBarControlContainerControl(Links[I].Control).InPlaceControl;
|
|
if Result then Exit;
|
|
end;
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TdxBarControlContainerItem.SetControl(Value: TControl);
|
|
begin
|
|
if (Value <> nil) and IsControlAssigned(Value) then
|
|
raise Exception.Create(dxSBAR_CANTASSIGNCONTROL);
|
|
if FControl <> Value then
|
|
begin
|
|
if FControl <> nil then
|
|
begin
|
|
FControl.WindowProc := FPrevControlWndProc;
|
|
if not (csDestroying in FControl.ComponentState) and
|
|
not BarManager.Designing then
|
|
FControl.Parent := nil;
|
|
end;
|
|
FControl := Value;
|
|
if FControl <> nil then
|
|
begin
|
|
FControl.FreeNotification(Self);
|
|
FPrevControlWndProc := FControl.WindowProc;
|
|
FControl.WindowProc := ControlWndProc;
|
|
SaveControlSize;
|
|
end;
|
|
UpdateEx;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarControlContainerItem.ControlWndProc(var Message: TMessage);
|
|
|
|
function IsSizeChanged: Boolean;
|
|
begin
|
|
with Control, FPrevControlSize do
|
|
Result := (Width <> X) or (Height <> Y);
|
|
end;
|
|
|
|
begin
|
|
if Message.Msg = CM_RECREATEWND then
|
|
begin
|
|
Control.WindowProc := FPrevControlWndProc;
|
|
try
|
|
FPrevControlWndProc(Message);
|
|
finally
|
|
if Control <> nil then
|
|
begin
|
|
FPrevControlWndProc := Control.WindowProc;
|
|
Control.WindowProc := ControlWndProc;
|
|
end;
|
|
end;
|
|
Exit;
|
|
end;
|
|
|
|
FPrevControlWndProc(Message);
|
|
with Message do
|
|
if not InPlaceControl and IsSizeChanged and
|
|
((Msg = WM_SIZE) or (Msg = WM_WINDOWPOSCHANGED) and (lParam = 0)) then
|
|
begin
|
|
SaveControlSize;
|
|
UpdateEx;
|
|
end;
|
|
end;
|
|
|
|
function TdxBarControlContainerItem.IsControlAssigned(AControl: TControl): Boolean;
|
|
var
|
|
I: Integer;
|
|
ABarItem: TdxBarItem;
|
|
begin
|
|
Result := True;
|
|
for I := 0 to BarManager.ItemCount - 1 do
|
|
begin
|
|
ABarItem := BarManager.Items[I];
|
|
if (ABarItem is TdxBarControlContainerItem) and (ABarItem <> Self) and
|
|
(TdxBarControlContainerItem(ABarItem).Control = AControl) then Exit;
|
|
end;
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TdxBarControlContainerItem.SaveControlSize;
|
|
begin
|
|
with Control do
|
|
FPrevControlSize := Point(Width, Height);
|
|
end;
|
|
|
|
procedure TdxBarControlContainerItem.SetControlVisible(Value: Boolean);
|
|
begin
|
|
if ControlVisible <> Value then
|
|
begin
|
|
if FPlace <> nil then
|
|
FPlace.Visible := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarControlContainerItem.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited;
|
|
if (Operation = opRemove) and (AComponent = Control) then Control := nil;
|
|
end;
|
|
|
|
procedure TdxBarControlContainerItem.SetName(const NewName: TComponentName);
|
|
begin
|
|
inherited;
|
|
if (Control = nil) and not IsLoading then UpdateEx;
|
|
end;
|
|
|
|
function TdxBarControlContainerItem.CanClicked: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TdxBarControlContainerItem.GetHidden: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TdxBarControlContainerItem.HasAccel(AItemLink: TdxBarItemLink): Boolean;
|
|
begin
|
|
Result :=
|
|
(AItemLink.Control <> nil) and
|
|
TdxBarControlContainerControl(AItemLink.Control).ParentIsQuickCustControl;
|
|
end;
|
|
|
|
procedure TdxBarControlContainerItem.HideControl(AControl: TdxBarItemControl);
|
|
begin
|
|
if TdxBarControlContainerControl(AControl).ShowsControl then
|
|
begin
|
|
FPlace.Visible := False;
|
|
FPlace.ParentWindow := 0;
|
|
end;
|
|
end;
|
|
|
|
function TdxBarControlContainerItem.NeedToBeHidden: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
{ TdxBarControlContainerControl }
|
|
|
|
destructor TdxBarControlContainerControl.Destroy;
|
|
begin
|
|
Item.HideControl(Self);
|
|
inherited;
|
|
end;
|
|
|
|
function TdxBarControlContainerControl.GetControl: TControl;
|
|
begin
|
|
if Item = nil then
|
|
Result := nil
|
|
else
|
|
Result := Item.Control;
|
|
end;
|
|
|
|
function TdxBarControlContainerControl.GetItem: TdxBarControlContainerItem;
|
|
begin
|
|
Result := TdxBarControlContainerItem(ItemLink.Item);
|
|
end;
|
|
|
|
function TdxBarControlContainerControl.GetPlace: TCustomForm;
|
|
begin
|
|
Result := Item.Place;
|
|
end;
|
|
|
|
procedure TdxBarControlContainerControl.BeforeDestroyParentHandle;
|
|
begin
|
|
inherited;
|
|
if IsShowingControl and (Control is TWinControl) then
|
|
begin
|
|
TDummyWinControl(Control).DestroyHandle;
|
|
Place.Visible := False; // work-around for the controls that
|
|
Place.ParentWindow := 0; // don't check HandleAllocated
|
|
end;
|
|
end;
|
|
|
|
function TdxBarControlContainerControl.CanClicked: Boolean;
|
|
begin
|
|
Result := ParentIsQuickCustControl;
|
|
end;
|
|
|
|
function TdxBarControlContainerControl.CanSelect: Boolean;
|
|
begin
|
|
if ParentIsQuickCustControl then
|
|
Result := True
|
|
else
|
|
Result := BarManager.Designing;
|
|
end;
|
|
|
|
function TdxBarControlContainerControl.GetHeight: Integer;
|
|
begin
|
|
if (Control = nil) or ParentIsQuickCustControl then
|
|
begin
|
|
Result := Parent.TextSize;
|
|
if Parent is TdxBarControl then
|
|
with TDummyBarManager(BarManager) do
|
|
if Result < ButtonHeight then Result := ButtonHeight;
|
|
end
|
|
else
|
|
Result := Control.Height;
|
|
end;
|
|
|
|
function TdxBarControlContainerControl.GetWidth: Integer;
|
|
begin
|
|
if ParentIsQuickCustControl then
|
|
with BarManager, Parent.Canvas do
|
|
begin
|
|
Result := TextWidth(GetTextOf(Caption));
|
|
if ImageExists then
|
|
Inc(Result, TDummyBarManager(BarManager).ButtonWidth + 4)
|
|
else
|
|
Inc(Result, Font.Size);
|
|
end
|
|
else
|
|
if Control = nil then
|
|
if Parent is TdxBarSubMenuControl then
|
|
begin
|
|
Result := 2 * Parent.TextSize + 3 +
|
|
Parent.Canvas.TextWidth(GetTextOf(Item.Name)) + 3;
|
|
Inc(Result, PainterClass.ContainerControlSubMenuOffset);
|
|
end
|
|
else
|
|
with BarManager, Parent.Canvas do
|
|
Result := TextWidth(GetTextOf(Item.Name)) + Font.Size
|
|
else
|
|
Result := Control.Width;
|
|
end;
|
|
|
|
function TdxBarControlContainerControl.IsDestroyOnClick: Boolean;
|
|
begin
|
|
Result := ParentIsQuickCustControl;
|
|
end;
|
|
|
|
function TdxBarControlContainerControl.IsShowingControl: Boolean;
|
|
begin
|
|
Result := (Control <> nil) and (Place.ParentWindow = Parent.Handle);
|
|
end;
|
|
|
|
function TdxBarControlContainerControl.NeedCaptureMouse: Boolean;
|
|
begin
|
|
Result := ParentIsQuickCustControl;
|
|
end;
|
|
|
|
procedure TdxBarControlContainerControl.Paint(ARect: TRect;
|
|
PaintType: TdxBarPaintType);
|
|
const
|
|
Borders: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER);
|
|
var
|
|
R: TRect;
|
|
DC: HDC;
|
|
ABrush: HBRUSH;
|
|
ALogBrush: TLogBrush;
|
|
PrevBkColor: COLORREF;
|
|
S: string;
|
|
APressed: Boolean;
|
|
ATemp: array[0..12] of Byte absolute ALogBrush; // to avoid a bug with GetObject
|
|
begin
|
|
R := ARect;
|
|
DC := Parent.Canvas.Handle;
|
|
if ParentIsQuickCustControl then
|
|
begin
|
|
APressed := DrawSelected and Parent.IsActive and MousePressed;
|
|
DrawGlyph(R, nil, PaintType, False, DrawSelected, False, APressed, False, False, False, False);
|
|
if ImageExists then
|
|
Inc(R.Left, TDummyBarManager(BarManager).ButtonWidth)
|
|
else
|
|
Inc(R.Left, Parent.Canvas.Font.Size div 2);
|
|
PainterClass.OffsetEllipsisBounds(Self, APressed, R);
|
|
DrawItemText(DC, Caption, R, DT_LEFT, Enabled, False, False, False, False);
|
|
end
|
|
else
|
|
if (Control = nil) or BarManager.Designing then
|
|
begin
|
|
FrameRect(DC, R, GetSysColorBrush(COLOR_BTNSHADOW));
|
|
InflateRect(R, -1, -1);
|
|
|
|
ABrush := CreateHatchBrush(HS_BDIAGONAL, GetSysColor(COLOR_BTNSHADOW));
|
|
GetObject(Parent.BkBrush, SizeOf(ALogBrush), @ALogBrush);
|
|
PrevBkColor := SetBkColor(DC, ALogBrush.lbColor);
|
|
FillRect(DC, R, ABrush);
|
|
SetBkColor(DC, PrevBkColor);
|
|
DeleteObject(ABrush);
|
|
|
|
if Control = nil then
|
|
S := Item.Name
|
|
else
|
|
S := cxGetResourceString(@dxSBAR_PLACEFORCONTROL) + Control.Name;
|
|
DrawItemText(DC, S, R, DT_CENTER, True, False, PaintType = ptVert, True, False);
|
|
end
|
|
else
|
|
PlaceControl;
|
|
end;
|
|
|
|
procedure TdxBarControlContainerControl.PlaceControl;
|
|
var
|
|
LogBrush: TLogBrush;
|
|
begin
|
|
if ShowsControl then
|
|
begin
|
|
if FInPlaceControl or Item.InPlaceControl then Exit;
|
|
FInPlaceControl := True;
|
|
try
|
|
if not IsRectEmpty(ItemLink.ItemRect) or (Item.LinkCount = 1) then
|
|
Place.ParentWindow := Parent.Handle;
|
|
{$IFDEF DELPHI9}
|
|
TPlaceForm(Place).Position := poDesigned;
|
|
{$ENDIF}
|
|
if not IsRectEmpty(ItemLink.ItemRect) or IsShowingControl then
|
|
Place.BoundsRect := ItemLink.ItemRect;
|
|
Control.Parent := Place;
|
|
if not IsRectEmpty(ItemLink.ItemRect) then
|
|
with Control do
|
|
begin
|
|
BoundsRect := Parent.ClientRect;
|
|
Visible := True;
|
|
end;
|
|
GetObject(Parent.BkBrush, SizeOf(LogBrush), @LogBrush);
|
|
Place.Brush.Color := LogBrush.lbColor;
|
|
TPlaceForm(Place).FBarItemControl := Self;
|
|
Place.Visible := True;
|
|
FPlacedControl := True;
|
|
finally
|
|
FInPlaceControl := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarControlContainerControl.RealVisibleChanging(AVisible: Boolean);
|
|
begin
|
|
if FPlacedControl then
|
|
Item.ControlVisible := AVisible;
|
|
end;
|
|
|
|
function TdxBarControlContainerControl.ShowsControl: Boolean;
|
|
begin
|
|
Result :=
|
|
not ParentIsQuickCustControl and (Control <> nil) and not BarManager.Designing;
|
|
end;
|
|
|
|
{ TdxBarProgressItem }
|
|
|
|
constructor TdxBarProgressItem.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
BorderStyle := sbsLowered;
|
|
FColor := clDefault;
|
|
FMax := 100;
|
|
FStep := 10;
|
|
end;
|
|
|
|
procedure TdxBarProgressItem.SetColor(Value: TColor);
|
|
begin
|
|
if FColor <> Value then
|
|
begin
|
|
FColor := Value;
|
|
UpdateBar;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarProgressItem.SetMax(Value: Integer);
|
|
var
|
|
AMin, AMax: Integer;
|
|
begin
|
|
if FMax <> Value then
|
|
begin
|
|
AMin := FMin;
|
|
AMax := Value;
|
|
if AMin > AMax then AMin := AMax;
|
|
SetParams(AMin, AMax);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarProgressItem.SetMin(Value: Integer);
|
|
var
|
|
AMin, AMax: Integer;
|
|
begin
|
|
if FMin <> Value then
|
|
begin
|
|
AMin := Value;
|
|
AMax := FMax;
|
|
if AMax < AMin then AMax := AMin;
|
|
SetParams(AMin, AMax);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarProgressItem.SetPosition(Value: Integer);
|
|
begin
|
|
if Value < FMin then Value := FMin;
|
|
if Value > FMax then Value := FMax;
|
|
if FPosition <> Value then
|
|
begin
|
|
FPosition := Value;
|
|
UpdateBar;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarProgressItem.SetSmooth(Value: Boolean);
|
|
begin
|
|
if FSmooth <> Value then
|
|
begin
|
|
FSmooth := Value;
|
|
UpdateBar;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarProgressItem.SetStep(Value: Integer);
|
|
begin
|
|
FStep := Value;
|
|
end;
|
|
|
|
procedure TdxBarProgressItem.UpdateBar;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if not IsLoading then
|
|
for I := 0 to LinkCount - 1 do
|
|
if Links[I].Control <> nil then
|
|
TdxBarProgressControl(Links[I].Control).UpdateBar;
|
|
end;
|
|
|
|
procedure TdxBarProgressItem.SetParams(AMin, AMax: Integer);
|
|
begin
|
|
if (FMin <> AMin) or (FMax <> AMax) then
|
|
begin
|
|
FMin := AMin;
|
|
FMax := AMax;
|
|
if IsLoading then Exit;
|
|
if FMin > FMax then FMin := FMax;
|
|
if FPosition < FMin then
|
|
Position := FMin
|
|
else
|
|
if FPosition > FMax then
|
|
Position := FMax
|
|
else
|
|
UpdateBar;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarProgressItem.StepBy(Delta: Integer);
|
|
begin
|
|
Position := Position + Delta;
|
|
end;
|
|
|
|
procedure TdxBarProgressItem.StepIt;
|
|
begin
|
|
if FPosition + FStep > FMax then
|
|
Position := FPosition + FStep - FMax
|
|
else
|
|
if FPosition + FStep < FMin then
|
|
Position := FMax - (FMin - (FPosition + FStep))
|
|
else
|
|
Position := Position + Step;
|
|
end;
|
|
|
|
{ TdxBarProgressControl }
|
|
|
|
function TdxBarProgressControl.GetItem: TdxBarProgressItem;
|
|
begin
|
|
Result := TdxBarProgressItem(ItemLink.Item);
|
|
end;
|
|
|
|
function TdxBarProgressControl.BarBrushColor: TColorRef;
|
|
begin
|
|
if Item.Color = clDefault then
|
|
Result := PainterClass.ProgressControlBarBrushColor
|
|
else
|
|
Result := ColorToRGB(Item.Color);
|
|
end;
|
|
|
|
function TdxBarProgressControl.BarHeight: Integer;
|
|
begin
|
|
with ItemLink.ItemRect do
|
|
if IsVertical(Parent) then
|
|
begin
|
|
Result := MulDiv(Right - Left - 2 * BorderWidth, 2, 3);
|
|
if Odd(Right - Left) <> Odd(Result) then Inc(Result);
|
|
end
|
|
else
|
|
begin
|
|
Result := MulDiv(Bottom - Top - 2 * BorderWidth, 2, 3);
|
|
if Odd(Bottom - Top) <> Odd(Result) then Inc(Result);
|
|
end;
|
|
end;
|
|
|
|
function TdxBarProgressControl.BarRect: TRect;
|
|
var
|
|
W, H, RightOffset: Integer;
|
|
begin
|
|
W := BarWidth - PainterClass.ProgressControlIndent(Self);
|
|
H := BarHeight;
|
|
RightOffset := W + ProgressBarIndent + BorderWidth + RightIndent;
|
|
with ItemLink.ItemRect do
|
|
if IsVertical(Parent) then
|
|
Result := Bounds((Left + Right - H) div 2, Bottom - RightOffset, H, W)
|
|
else
|
|
Result := Bounds(Right - RightOffset, (Top + Bottom - H) div 2, W, H);
|
|
end;
|
|
|
|
function TdxBarProgressControl.BarWidth: Integer;
|
|
var
|
|
AWidth: Integer;
|
|
begin
|
|
if (Width = 0) and (Align <> iaClient) then
|
|
Result := ProgressBarDefaultWidth
|
|
else
|
|
begin
|
|
if Parent is TdxBarSubMenuControl then
|
|
with ItemLink.ItemRect do
|
|
AWidth := Right - Left
|
|
else
|
|
if Align = iaClient then
|
|
if IsVertical(Parent) then
|
|
with ItemLink.ItemRect do
|
|
AWidth := Bottom - Top
|
|
else
|
|
with ItemLink.ItemRect do
|
|
AWidth := Right - Left
|
|
else
|
|
AWidth := Width;
|
|
Result := AWidth - GetAutoWidth -
|
|
(Byte(not Item.ShowCaption) + 1) * ProgressBarIndent;
|
|
if Result < 0 then Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TdxBarProgressControl.CanHaveZeroSize: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TdxBarProgressControl.DrawInterior(DC: HDC; ARect: TRect;
|
|
PaintType: TdxBarPaintType);
|
|
var
|
|
BarR: TRect;
|
|
Rgn: HRGN;
|
|
AIndent: Integer;
|
|
begin
|
|
BarR := BarRect;
|
|
if IsRectEmpty(BarR) then
|
|
Rgn := 0
|
|
else
|
|
begin
|
|
Rgn := CreateRectRgn(0, 0, 0, 0);
|
|
if GetClipRgn(DC, Rgn) <> 1 then
|
|
begin
|
|
DeleteObject(Rgn);
|
|
Rgn := 0;
|
|
end;
|
|
with BarR do
|
|
ExcludeClipRect(DC, Left, Top, Right, Bottom);
|
|
end;
|
|
|
|
AIndent := PainterClass.ProgressControlIndent(Self);
|
|
if AIndent <> 0 then
|
|
with ARect do
|
|
PainterClass.DrawBackground(Self, DC, Rect(Left, Top, Left + AIndent, Bottom), Parent.BkBrush, False);
|
|
Inc(ARect.Left, AIndent);
|
|
DrawGlyphAndCaption(DC, ARect, PaintType, False);
|
|
|
|
if Rgn = 0 then
|
|
SelectClipRgn(DC, 0)
|
|
else
|
|
begin
|
|
SelectClipRgn(DC, Rgn);
|
|
DeleteObject(Rgn);
|
|
end;
|
|
|
|
if not IsRectEmpty(BarR) then
|
|
PainterClass.ProgressControlDrawBar(Self, DC, BarR, BarBrushColor, PaintType,
|
|
Item.Smooth, Item.Position, Item.Min, Item.Max);
|
|
end;
|
|
|
|
function TdxBarProgressControl.GetAlignment: TAlignment;
|
|
begin
|
|
Result := taLeftJustify;
|
|
end;
|
|
|
|
function TdxBarProgressControl.GetDefaultHeight: Integer;
|
|
var
|
|
ABarHeight: Integer;
|
|
begin
|
|
Result := inherited GetDefaultHeight;
|
|
ABarHeight := PainterClass.ProgressControlBarHeight(Self) + 2 * (BorderWidth + 1);
|
|
if Result < ABarHeight then
|
|
Result := ABarHeight;
|
|
end;
|
|
|
|
function TdxBarProgressControl.GetDefaultWidth: Integer;
|
|
begin
|
|
Result := inherited GetDefaultWidth;
|
|
if Width = 0 then
|
|
Inc(Result, (Byte(not Item.ShowCaption) + 1) * ProgressBarIndent +
|
|
ProgressBarDefaultWidth);
|
|
Inc(Result, PainterClass.ProgressControlIndent(Self));
|
|
end;
|
|
|
|
procedure TdxBarProgressControl.UpdateBar;
|
|
var
|
|
R: TRect;
|
|
begin
|
|
R := BarRect;
|
|
InvalidateRect(Parent.Handle, @R, False);
|
|
end;
|
|
|
|
{ TdxBarMRUListItem }
|
|
|
|
constructor TdxBarMRUListItem.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FMaxItemCount := 5;
|
|
end;
|
|
|
|
procedure TdxBarMRUListItem.SetMaxItemCount(Value: Integer);
|
|
begin
|
|
if Value < 0 then Value := 0;
|
|
if FMaxItemCount <> Value then
|
|
begin
|
|
FMaxItemCount := Value;
|
|
CheckItemCount;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarMRUListItem.CheckItemCount;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if FMaxItemCount = 0 then Exit;
|
|
for I := Items.Count - 1 downto FMaxItemCount do
|
|
Items.Delete(I);
|
|
end;
|
|
|
|
function TdxBarMRUListItem.GetDisplayText(const AText: string): string;
|
|
begin
|
|
Result := GetAdjustedString(inherited GetDisplayText(AText));
|
|
end;
|
|
|
|
procedure TdxBarMRUListItem.DirectClick;
|
|
begin
|
|
inherited;
|
|
if ((CurItemLink = nil) or (CurItemLink.Item <> Self)) and
|
|
not BarManager.IsCustomizing and FRemoveItemOnClick then
|
|
begin
|
|
RemoveItem(Items[ItemIndex], nil);
|
|
ItemIndex := -1;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarMRUListItem.AddItem(const S: string; AObject: TObject);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := Items.IndexOf(S);
|
|
if (I = -1) and (AObject <> nil) then
|
|
I := Items.IndexOfObject(AObject);
|
|
if I = -1 then
|
|
begin
|
|
Items.InsertObject(0, S, AObject);
|
|
CheckItemCount;
|
|
end
|
|
else
|
|
Items.Move(I, 0);
|
|
end;
|
|
|
|
procedure TdxBarMRUListItem.RemoveItem(const S: string; AObject: TObject);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
with Items do
|
|
begin
|
|
if S <> '' then
|
|
I := IndexOf(S)
|
|
else
|
|
I := IndexOfObject(AObject);
|
|
if I <> -1 then Delete(I);
|
|
end;
|
|
end;
|
|
|
|
{ TdxBarInPlaceSubItem }
|
|
|
|
procedure TdxBarInPlaceSubItem.SetExpanded(Value: Boolean);
|
|
var
|
|
List: TList;
|
|
I: Integer;
|
|
begin
|
|
if FExpanded <> Value then
|
|
begin
|
|
if not Value then
|
|
for I := 0 to LinkCount - 1 do
|
|
DoBeforeCollapse(Links[I]);
|
|
FExpanded := Value;
|
|
if not IsLoading then
|
|
begin
|
|
List := TList.Create;
|
|
FExpandedChanging := True;
|
|
try
|
|
for I := 0 to LinkCount - 1 do
|
|
with Links[I] do
|
|
if (Control <> nil) and (Control.Parent is TdxBarSubMenuControl) and
|
|
(List.IndexOf(Control.Parent) = -1) then
|
|
begin
|
|
List.Add(Control.Parent);
|
|
Control.Parent.RepaintBar;
|
|
end;
|
|
finally
|
|
FExpandedChanging := False;
|
|
List.Free;
|
|
end;
|
|
end;
|
|
if Value then
|
|
for I := 0 to LinkCount - 1 do
|
|
DoAfterExpand(Links[I]);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarInPlaceSubItem.AddListedItemLinks(AItemLinks: TdxBarItemLinks;
|
|
AIndex: Integer; FirstCall: Boolean; CallingItemLink: TdxBarItemLink);
|
|
begin
|
|
if FExpanded then inherited;
|
|
end;
|
|
|
|
procedure TdxBarInPlaceSubItem.DeleteListedItemLinks(AItemLinks: TdxBarItemLinks;
|
|
AIndex: Integer);
|
|
begin
|
|
if FExpanded and not FExpandedChanging or
|
|
not FExpanded and FExpandedChanging then inherited;
|
|
end;
|
|
|
|
function TdxBarInPlaceSubItem.HideWhenRun: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TdxBarInPlaceSubItem.InternalActuallyVisible: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TdxBarInPlaceSubItem.ChangeNextItemLinkBeginGroup(ALink: TdxBarItemLink;
|
|
Value: Boolean);
|
|
var
|
|
NextItemLinkIndex: Integer;
|
|
begin
|
|
if FKeepBeginGroupWhileExpanded then
|
|
with ALink.Owner do
|
|
if not (BarControl is TdxBarControl) then
|
|
begin
|
|
NextItemLinkIndex := ALink.VisibleIndex + 1;
|
|
if not BarManager.Designing then
|
|
Inc(NextItemLinkIndex, ItemLinks.VisibleItemCount);
|
|
if NextItemLinkIndex <= VisibleItemCount - 1 then
|
|
VisibleItems[NextItemLinkIndex].BeginGroup := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarInPlaceSubItem.DoAfterExpand(ALink: TdxBarItemLink);
|
|
begin
|
|
if Assigned(FOnAfterExpand) then FOnAfterExpand(Self, ALink);
|
|
ChangeNextItemLinkBeginGroup(ALink, True);
|
|
end;
|
|
|
|
procedure TdxBarInPlaceSubItem.DoBeforeCollapse(ALink: TdxBarItemLink);
|
|
begin
|
|
if Assigned(FOnBeforeCollapse) then FOnBeforeCollapse(Self, ALink);
|
|
ChangeNextItemLinkBeginGroup(ALink, False);
|
|
end;
|
|
|
|
{ TdxBarInPlaceSubItemControl }
|
|
|
|
function TdxBarInPlaceSubItemControl.GetItem: TdxBarInPlaceSubItem;
|
|
begin
|
|
Result := TdxBarInPlaceSubItem(ItemLink.Item);
|
|
end;
|
|
|
|
procedure TdxBarInPlaceSubItemControl.ControlClick(ByMouse: Boolean);
|
|
var
|
|
AParent: TdxBarSubMenuControl;
|
|
AOriginalItemLink: TdxBarItemLink;
|
|
ASelectedItemLinkIndex: Integer;
|
|
begin
|
|
inherited;
|
|
if Parent is TdxBarSubMenuControl then
|
|
begin
|
|
AParent := TdxBarSubMenuControl(Parent);
|
|
AOriginalItemLink := ItemLink.OriginalItemLink;
|
|
if IsSelected then
|
|
ASelectedItemLinkIndex := ItemLink.Index
|
|
else
|
|
ASelectedItemLinkIndex := -1;
|
|
with Item do
|
|
begin
|
|
DirectClick;
|
|
Expanded := not Expanded;
|
|
end;
|
|
if ASelectedItemLinkIndex <> -1 then
|
|
with TDummyCustomBarControl(AParent) do
|
|
if (ASelectedItemLinkIndex < ItemLinks.VisibleItemCount) and
|
|
(ItemLinks[ASelectedItemLinkIndex].OriginalItemLink = AOriginalItemLink) then
|
|
SelectedItem := ItemLinks[ASelectedItemLinkIndex].Control;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarInPlaceSubItemControl.DblClick;
|
|
begin
|
|
if Enabled then ControlClick(True);
|
|
end;
|
|
|
|
function TdxBarInPlaceSubItemControl.GetDefaultHeight: Integer;
|
|
begin
|
|
Result := inherited GetDefaultHeight;
|
|
if Parent is TdxBarSubMenuControl then Inc(Result);
|
|
end;
|
|
|
|
function TdxBarInPlaceSubItemControl.GetDefaultWidth: Integer;
|
|
begin
|
|
if Parent is TdxBarSubMenuControl then
|
|
Result := 5 + Parent.Canvas.TextWidth(GetTextOf(Caption)) + Parent.TextSize
|
|
else
|
|
Result := inherited GetDefaultWidth;
|
|
end;
|
|
|
|
function TdxBarInPlaceSubItemControl.HasSubMenu: Boolean;
|
|
begin
|
|
Result := not (Parent is TdxBarSubMenuControl);
|
|
end;
|
|
|
|
function TdxBarInPlaceSubItemControl.IsExpandable: Boolean;
|
|
begin
|
|
Result := not (Parent is TdxBarSubMenuControl) and inherited IsExpandable;
|
|
end;
|
|
|
|
function TdxBarInPlaceSubItemControl.IsInvertTextColor: Boolean;
|
|
begin
|
|
Result := Parent is TdxBarSubMenuControl;
|
|
end;
|
|
|
|
procedure TdxBarInPlaceSubItemControl.KeyDown(Key: Word);
|
|
begin
|
|
case Key of
|
|
VK_LEFT:
|
|
ControlClick(False);
|
|
VK_RIGHT:
|
|
ControlClick(False);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxBarInPlaceSubItemControl.Paint(ARect: TRect; PaintType: TdxBarPaintType);
|
|
const
|
|
Arrows: array[Boolean] of TdxArrowType = (atRight, atDown);
|
|
var
|
|
Selected: Boolean;
|
|
DC: HDC;
|
|
begin
|
|
if PaintType = ptMenu then
|
|
begin
|
|
if ARect.Left = ARect.Right then Exit;
|
|
Selected := DrawSelected;
|
|
DC := Parent.Canvas.Handle;
|
|
PainterClass.InPlaceSubItemControlDrawInMenu(Self, DC, Selected, Item.Expanded, ARect);
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
function TdxBarInPlaceSubItemControl.WantsKey(Key: Word): Boolean;
|
|
begin
|
|
if Parent is TdxBarSubMenuControl then
|
|
Result :=
|
|
(Key = VK_LEFT) and Item.Expanded or
|
|
(Key = VK_RIGHT) and not Item.Expanded
|
|
else
|
|
Result := inherited WantsKey(Key);
|
|
end;
|
|
|
|
initialization
|
|
FTrueTypeFontBitmap := TBitmap.Create;
|
|
FTrueTypeFontBitmap.LoadFromResourceName(HInstance, 'DXBARTRUETYPEFONT');
|
|
FNonTrueTypeFontBitmap := TBitmap.Create;
|
|
FNonTrueTypeFontBitmap.LoadFromResourceName(HInstance, 'DXBARNONTRUETYPEFONT');
|
|
FColorDialog := TColorDialog.Create(nil);
|
|
FFontDialog := TFontDialog.Create(nil);
|
|
|
|
if GetLocaleInfo(GetThreadLocale, LOCALE_IFIRSTDAYOFWEEK,
|
|
@StartOfWeek, SizeOf(StartOfWeek)) = 0 then
|
|
StartOfWeek := 0
|
|
else
|
|
begin
|
|
StartOfWeek := StrToInt(Chr(StartOfWeek));
|
|
Inc(StartOfWeek);
|
|
if StartOfWeek > 6 then StartOfWeek := 0;
|
|
end;
|
|
|
|
dxBarRegisterItem(TdxBarStatic, TdxBarStaticControl, True);
|
|
dxBarRegisterItem(TdxBarLargeButton, TdxBarLargeButtonControl, True);
|
|
dxBarRegisterItem(TdxBarColorCombo, TdxBarColorComboControl, True);
|
|
dxBarRegisterItem(TdxBarFontNameCombo, TdxBarComboControl, True);
|
|
dxBarRegisterItem(TdxBarDateCombo, TdxBarDateComboControl, True);
|
|
dxBarRegisterItem(TdxBarTreeViewCombo, TdxBarTreeViewComboControl, True);
|
|
dxBarRegisterItem(TdxBarImageCombo, TdxBarImageComboControl, True);
|
|
dxBarRegisterItem(TdxBarToolbarsListItem, TdxBarToolbarsListItemControl, True);
|
|
dxBarRegisterItem(TdxBarSpinEdit, TdxBarSpinEditControl, True);
|
|
dxBarRegisterItem(TdxBarControlContainerItem, TdxBarControlContainerControl, True);
|
|
dxBarRegisterItem(TdxBarProgressItem, TdxBarProgressControl, True);
|
|
dxBarRegisterItem(TdxBarMRUListItem, TdxBarContainerItemControl, True);
|
|
dxBarRegisterItem(TdxBarInPlaceSubItem, TdxBarInPlaceSubItemControl, True);
|
|
|
|
finalization
|
|
dxBarUnregisterItem(TdxBarInPlaceSubItem);
|
|
dxBarUnregisterItem(TdxBarMRUListItem);
|
|
dxBarUnregisterItem(TdxBarProgressItem);
|
|
dxBarUnregisterItem(TdxBarControlContainerItem);
|
|
dxBarUnregisterItem(TdxBarSpinEdit);
|
|
dxBarUnregisterItem(TdxBarToolbarsListItem);
|
|
dxBarUnregisterItem(TdxBarImageCombo);
|
|
dxBarUnregisterItem(TdxBarTreeViewCombo);
|
|
dxBarUnregisterItem(TdxBarDateCombo);
|
|
dxBarUnregisterItem(TdxBarFontNameCombo);
|
|
dxBarUnregisterItem(TdxBarColorCombo);
|
|
dxBarUnregisterItem(TdxBarLargeButton);
|
|
dxBarUnregisterItem(TdxBarStatic);
|
|
|
|
FFontDialog.Free;
|
|
FColorDialog.Free;
|
|
FNonTrueTypeFontBitmap.Free;
|
|
FTrueTypeFontBitmap.Free;
|
|
|
|
end.
|