Componentes.Terceros.DevExp.../internal/x.46/2/ExpressEditors Library 5/Sources/cxHyperLinkEdit.pas

622 lines
19 KiB
ObjectPascal

{********************************************************************}
{ }
{ Developer Express Visual Component Library }
{ ExpressEditors }
{ }
{ 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 EXPRESSEDITORS 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 cxHyperLinkEdit;
{$I cxVer.inc}
interface
uses
Messages,
Windows,
{$IFDEF DELPHI6}
Types,
{$ENDIF}
SysUtils, Graphics, Classes, Controls, Menus, cxGraphics, cxContainer,
cxControls, cxEdit, cxTextEdit, cxEditConsts, cxFilterControlUtils;
const
cxHyperLinkEditDefaultLinkColor = clBlue;
type
{ TcxHyperLinkEditViewInfo }
TcxCustomHyperLinkEdit = class;
TcxHyperLinkEditViewInfo = class(TcxCustomTextEditViewInfo)
protected
procedure GetColorSettingsByPainter(out ABackground, ATextColor: TColor); override;
function GetHyperLinkTextColor: TColor; virtual;
public
function IsHotTrack: Boolean; override;
function IsHotTrack(P: TPoint): Boolean; override;
procedure PrepareCanvasFont(ACanvas: TCanvas); override;
end;
{ TcxCustomHyperLinkEditProperties }
TcxHyperLinkEditUsePrefix = (upAlways, upOnlyOnExecute, upNever);
TcxCustomHyperLinkEditProperties = class(TcxCustomTextEditProperties)
private
FSingleClick: Boolean;
FLinkColor: TColor;
FOnStartClick: TNotifyEvent;
FPrefix: string;
FStartKey: TShortCut;
FUsePrefix: TcxHyperLinkEditUsePrefix;
function GetAutoComplete: Boolean;
function GetPrefixStored: Boolean;
procedure ReadPrefix(Reader: TReader);
procedure SetAutoComplete(Value: Boolean);
procedure SetLinkColor(const Value: TColor);
procedure SetSingleClick(Value: Boolean);
procedure WritePrefix(Writer: TWriter);
protected
procedure DefineProperties(AFiler: TFiler); override;
function AddPrefixTo(AStr: string): string; virtual;
public
constructor Create(AOwner: TPersistent); override;
procedure Assign(Source: TPersistent); override;
class function GetContainerClass: TcxContainerClass; override;
class function GetStyleClass: TcxCustomEditStyleClass; override;
function GetSupportedOperations: TcxEditSupportedOperations; override;
class function GetViewInfoClass: TcxContainerViewInfoClass; override;
procedure ValidateDisplayValue(var ADisplayValue: TcxEditValue;
var AErrorText: TCaption; var Error: Boolean; AEdit: TcxCustomEdit); override;
// !!!
property AutoComplete: Boolean read GetAutoComplete write SetAutoComplete
stored False; // deprecated
property AutoSelect default False;
property LinkColor: TColor read FLinkColor write SetLinkColor
default cxHyperLinkEditDefaultLinkColor;
property Prefix: string read FPrefix write FPrefix stored False;
property SingleClick: Boolean read FSingleClick write SetSingleClick
default False;
property StartKey: TShortCut read FStartKey write FStartKey
default VK_RETURN + scCtrl;
property UsePrefix: TcxHyperLinkEditUsePrefix read FUsePrefix
write FUsePrefix default upAlways;
property OnStartClick: TNotifyEvent read FOnStartClick write FOnStartClick;
end;
{ TcxHyperLinkEditProperties }
TcxHyperLinkEditProperties = class(TcxCustomHyperLinkEditProperties)
published
property Alignment;
property AssignedValues;
property AutoComplete; // deprecated
property AutoSelect;
property ClearKey;
property ImeMode;
property ImeName;
property IncrementalSearch;
property LinkColor;
property LookupItems;
property LookupItemsSorted;
property Prefix;
property ReadOnly;
property StartKey;
property SingleClick;
property UseLeftAlignmentOnEditing;
property UsePrefix;
property ValidateOnEnter;
property OnChange;
property OnEditValueChanged;
property OnStartClick;
property OnValidate;
end;
{ TcxHyperLinkStyle }
TcxHyperLinkStyle = class(TcxEditStyle)
protected
function GetTextColor: TColor; override;
function GetTextStyle: TFontStyles; override;
end;
{ TcxCustomHyperLinkEdit }
TcxCustomHyperLinkEdit = class(TcxCustomTextEdit)
private
FSaveCursor: TCursor;
function GetActiveProperties: TcxCustomHyperLinkEditProperties;
function GetProperties: TcxCustomHyperLinkEditProperties;
function GetStyle: TcxHyperLinkStyle;
procedure InternalSetCursor(ACursor: TCursor);
procedure SetProperties(const Value: TcxCustomHyperLinkEditProperties);
procedure SetStyle(Value: TcxHyperLinkStyle);
protected
function DoOnStartClick: Boolean;
procedure DoStart; virtual;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseEnter(AControl: TControl); override;
procedure MouseLeave(AControl: TControl); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure PropertiesChanged(Sender: TObject); override;
public
procedure ActivateByMouse(Shift: TShiftState; X, Y: Integer;
var AEditData: TcxCustomEditData); override;
class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
procedure SelectAll; override;
property ActiveProperties: TcxCustomHyperLinkEditProperties read GetActiveProperties;
property Properties: TcxCustomHyperLinkEditProperties read GetProperties
write SetProperties;
property Style: TcxHyperLinkStyle read GetStyle write SetStyle;
end;
{ TcxHyperLinkEdit }
TcxHyperLinkEdit = class(TcxCustomHyperLinkEdit)
private
function GetActiveProperties: TcxHyperLinkEditProperties;
function GetProperties: TcxHyperLinkEditProperties;
procedure SetProperties(Value: TcxHyperLinkEditProperties);
public
class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
property ActiveProperties: TcxHyperLinkEditProperties read GetActiveProperties;
published
property Anchors;
property AutoSize;
property BeepOnEnter;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property ImeMode;
property ImeName;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property Properties: TcxHyperLinkEditProperties read GetProperties write SetProperties;
property ShowHint;
property Style;
property StyleDisabled;
property StyleFocused;
property StyleHot;
property TabOrder;
property TabStop;
property Text;
{$IFDEF DELPHI12}
property TextHint;
{$ENDIF}
property Visible;
property OnClick;
{$IFDEF DELPHI5}
property OnContextPopup;
{$ENDIF}
property OnDblClick;
property OnEditing;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property BiDiMode;
property ParentBiDiMode;
property OnEndDock;
property OnStartDock;
end;
{ TcxFilterHyperLinkEditHelper }
TcxFilterHyperLinkEditHelper = class(TcxFilterTextEditHelper)
public
class function GetFilterEditClass: TcxCustomEditClass; override;
end;
implementation
uses
ShellAPI,
{$IFDEF DELPHI6}
Variants,
{$ENDIF}
Forms, cxVariants, cxClasses, cxLibraryConsts, cxLookAndFeelPainters;
{ TcxHyperLinkEditViewInfo }
procedure TcxHyperLinkEditViewInfo.GetColorSettingsByPainter(
out ABackground, ATextColor: TColor);
begin
inherited GetColorSettingsByPainter(ABackground, ATextColor);
ATextColor := GetHyperLinkTextColor;
end;
function TcxHyperLinkEditViewInfo.GetHyperLinkTextColor: TColor;
begin
Result := TcxCustomHyperLinkEditProperties(EditProperties).LinkColor;
if (Painter <> nil) and (Result = cxHyperLinkEditDefaultLinkColor) then
Result := Painter.DefaultHyperlinkTextColor
end;
function TcxHyperLinkEditViewInfo.IsHotTrack: Boolean;
begin
Result := inherited IsHotTrack or
TcxCustomHyperLinkEditProperties(EditProperties).SingleClick;
end;
function TcxHyperLinkEditViewInfo.IsHotTrack(P: TPoint): Boolean;
begin
Result := IsHotTrack;
end;
procedure TcxHyperLinkEditViewInfo.PrepareCanvasFont(ACanvas: TCanvas);
begin
inherited PrepareCanvasFont(ACanvas);
if Edit = nil then
begin
ACanvas.Font.Style := ACanvas.Font.Style + [fsUnderline];
if IsSelected then
ACanvas.Font.Color := TextColor
else
ACanvas.Font.Color := GetHyperLinkTextColor;
end;
end;
{ TcxCustomHyperLinkEditProperties }
constructor TcxCustomHyperLinkEditProperties.Create(AOwner: TPersistent);
begin
inherited Create(AOwner);
AutoSelect := False;
FLinkColor := clBlue;
FPrefix := cxGetResourceString(@scxSHyperLinkPrefix);
FSingleClick := False;
FStartKey := VK_RETURN + scCtrl;
FUsePrefix := upAlways;
end;
function TcxCustomHyperLinkEditProperties.GetAutoComplete: Boolean;
begin
Result := not (UsePrefix = upNever);
end;
function TcxCustomHyperLinkEditProperties.GetPrefixStored: Boolean;
begin
Result := FPrefix <> cxGetResourceString(@scxSHyperLinkPrefix);
end;
procedure TcxCustomHyperLinkEditProperties.ReadPrefix(Reader: TReader);
begin
Prefix := Reader.ReadString;
end;
procedure TcxCustomHyperLinkEditProperties.SetAutoComplete(Value: Boolean);
begin
if Value then
UsePrefix := upAlways
else
UsePrefix := upNever;
end;
procedure TcxCustomHyperLinkEditProperties.SetLinkColor(
const Value: TColor);
begin
if FLinkColor <> Value then
begin
FLinkColor := Value;
Changed;
end;
end;
procedure TcxCustomHyperLinkEditProperties.SetSingleClick(Value: Boolean);
begin
if Value <> FSingleClick then
begin
FSingleClick := Value;
Changed;
end;
end;
procedure TcxCustomHyperLinkEditProperties.WritePrefix(Writer: TWriter);
begin
Writer.WriteString(Prefix);
end;
procedure TcxCustomHyperLinkEditProperties.Assign(Source: TPersistent);
begin
if Source is TcxCustomHyperLinkEditProperties then
begin
BeginUpdate;
try
inherited Assign(Source);
with TcxCustomHyperLinkEditProperties(Source) do
begin
Self.LinkColor := LinkColor;
Self.Prefix := Prefix;
Self.SingleClick := SingleClick;
Self.StartKey := StartKey;
Self.UsePrefix := UsePrefix;
Self.OnStartClick := OnStartClick;
end;
finally
EndUpdate
end
end
else
inherited Assign(Source);
end;
class function TcxCustomHyperLinkEditProperties.GetContainerClass: TcxContainerClass;
begin
Result := TcxHyperLinkEdit;
end;
class function TcxCustomHyperLinkEditProperties.GetStyleClass: TcxCustomEditStyleClass;
begin
Result := TcxHyperLinkStyle;
end;
function TcxCustomHyperLinkEditProperties.GetSupportedOperations: TcxEditSupportedOperations;
begin
Result := inherited GetSupportedOperations;
if SingleClick then
Include(Result, esoAlwaysHotTrack);
end;
class function TcxCustomHyperLinkEditProperties.GetViewInfoClass: TcxContainerViewInfoClass;
begin
Result := TcxHyperLinkEditViewInfo;
end;
procedure TcxCustomHyperLinkEditProperties.ValidateDisplayValue(
var ADisplayValue: TcxEditValue; var AErrorText: TCaption; var Error: Boolean;
AEdit: TcxCustomEdit);
begin
if UsePrefix = upAlways then
ADisplayValue := AddPrefixTo(VarToStr(ADisplayValue));
inherited ValidateDisplayValue(ADisplayValue, AErrorText, Error, AEdit);
end;
procedure TcxCustomHyperLinkEditProperties.DefineProperties(AFiler: TFiler);
begin
inherited DefineProperties(AFiler);
AFiler.DefineProperty('Prefix', ReadPrefix, WritePrefix, GetPrefixStored);
end;
function TcxCustomHyperLinkEditProperties.AddPrefixTo(AStr: string): string;
begin
Result := Trim(AStr);
if (Prefix <> '') and (Result <> '') and (Pos(Prefix, Result) <> 1) then
Result := Trim(Prefix + Result);
end;
{ TcxHyperLinkStyle }
function TcxHyperLinkStyle.GetTextColor: TColor;
begin
if DirectAccessMode then
Result := inherited GetTextColor
else
begin
if (Container = nil) or (TcxCustomHyperLinkEdit(Container).ActiveProperties = nil) then
Result := cxHyperLinkEditDefaultLinkColor
else
Result := TcxCustomHyperLinkEdit(Container).ActiveProperties.LinkColor;
end;
end;
function TcxHyperLinkStyle.GetTextStyle: TFontStyles;
begin
Result := inherited GetTextStyle + [fsUnderline];
end;
{ TcxCustomHyperLinkEdit }
function TcxCustomHyperLinkEdit.DoOnStartClick: Boolean;
begin
Result := Assigned(Properties.OnStartClick) or
Assigned(ActiveProperties.OnStartClick);
with Properties do
if Assigned(OnStartClick) then
OnStartClick(Self);
if RepositoryItem <> nil then
with ActiveProperties do
if Assigned(OnStartClick) then
OnStartClick(Self);
end;
procedure TcxCustomHyperLinkEdit.DoStart;
var
AText: string;
begin
if not DoOnStartClick then
begin
AText := Trim(DisplayValue);
if ActiveProperties.UsePrefix <> upNever then
AText := ActiveProperties.AddPrefixTo(AText);
if AText <> '' then
ShellExecute(0, 'OPEN', PChar(AText),
nil, nil, SW_SHOWMAXIMIZED);
end;
end;
function TcxCustomHyperLinkEdit.GetActiveProperties: TcxCustomHyperLinkEditProperties;
begin
Result := TcxCustomHyperLinkEditProperties(InternalGetActiveProperties);
end;
function TcxCustomHyperLinkEdit.GetProperties: TcxCustomHyperLinkEditProperties;
begin
Result := TcxCustomHyperLinkEditProperties(FProperties);
end;
function TcxCustomHyperLinkEdit.GetStyle: TcxHyperLinkStyle;
begin
Result := TcxHyperLinkStyle(FStyles.Style);
end;
procedure TcxCustomHyperLinkEdit.InternalSetCursor(ACursor: TCursor);
begin
InnerTextEdit.Control.Cursor := ACursor;
Cursor := ACursor;
SetCursor(Screen.Cursors[ACursor]);
end;
procedure TcxCustomHyperLinkEdit.SetProperties(
const Value: TcxCustomHyperLinkEditProperties);
begin
FProperties.Assign(Value);
end;
procedure TcxCustomHyperLinkEdit.SetStyle(Value: TcxHyperLinkStyle);
begin
FStyles.Style := Value;
end;
procedure TcxCustomHyperLinkEdit.KeyDown(var Key: Word;
Shift: TShiftState);
begin
if (ShortCut(Key, Shift) <> 0) and (ActiveProperties.StartKey = ShortCut(Key, Shift)) then
begin
DoStart;
Key := 0;
end
else
inherited KeyDown(Key, Shift);
end;
procedure TcxCustomHyperLinkEdit.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
if (Button = mbLeft) and PtInRect(ViewInfo.ClientRect, Point(X, Y)) and
(not ActiveProperties.SingleClick and (ssDouble in Shift)) then
DoStart;
end;
procedure TcxCustomHyperLinkEdit.MouseEnter(AControl: TControl);
begin
inherited MouseEnter(AControl);
if ActiveProperties.SingleClick and (Cursor = crDefault) then
begin
FSaveCursor := Cursor;
InternalSetCursor(crcxHandPoint);
end;
end;
procedure TcxCustomHyperLinkEdit.MouseLeave(AControl: TControl);
begin
inherited MouseLeave(AControl);
if ActiveProperties.SingleClick then
InternalSetCursor(FSaveCursor);
end;
procedure TcxCustomHyperLinkEdit.MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if (Button = mbLeft) and PtInRect(ViewInfo.ClientRect, Point(X, Y)) and
ActiveProperties.SingleClick and (SelLength = 0) then
DoStart;
end;
procedure TcxCustomHyperLinkEdit.PropertiesChanged(Sender: TObject);
begin
inherited PropertiesChanged(Sender);
ContainerStyleChanged(Style);
end;
class function TcxCustomHyperLinkEdit.GetPropertiesClass: TcxCustomEditPropertiesClass;
begin
Result := TcxCustomHyperLinkEditProperties;
end;
procedure TcxCustomHyperLinkEdit.ActivateByMouse(Shift: TShiftState; X, Y: Integer;
var AEditData: TcxCustomEditData);
begin
if IsInplace and ActiveProperties.SingleClick and (Cursor = crDefault) then
begin
FSaveCursor := Cursor;
InternalSetCursor(crcxHandPoint);
end;
inherited;
end;
procedure TcxCustomHyperLinkEdit.SelectAll;
begin
if not (IsInplace and ActiveProperties.SingleClick) then
inherited SelectAll;
end;
{ TcxHyperLinkEdit }
class function TcxHyperLinkEdit.GetPropertiesClass: TcxCustomEditPropertiesClass;
begin
Result := TcxHyperLinkEditProperties;
end;
function TcxHyperLinkEdit.GetActiveProperties: TcxHyperLinkEditProperties;
begin
Result := TcxHyperLinkEditProperties(InternalGetActiveProperties);
end;
function TcxHyperLinkEdit.GetProperties: TcxHyperLinkEditProperties;
begin
Result := TcxHyperLinkEditProperties(FProperties);
end;
procedure TcxHyperLinkEdit.SetProperties(Value: TcxHyperLinkEditProperties);
begin
FProperties.Assign(Value);
end;
{ TcxFilterHyperLinkEditHelper }
class function TcxFilterHyperLinkEditHelper.GetFilterEditClass: TcxCustomEditClass;
begin
Result := TcxHyperLinkEdit;
end;
initialization
GetRegisteredEditProperties.Register(TcxHyperLinkEditProperties, scxSEditRepositoryHyperLinkItem);
FilterEditsController.Register(TcxHyperLinkEditProperties, TcxFilterHyperLinkEditHelper);
finalization
FilterEditsController.Unregister(TcxHyperLinkEditProperties, TcxFilterHyperLinkEditHelper);
end.