You've already forked lazarus-ccr
jvcllaz: Add TJvPanel (and related infrastructure).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7001 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
131
components/jvcllaz/run/JvCore/JvExtComponent.pas
Normal file
131
components/jvcllaz/run/JvCore/JvExtComponent.pas
Normal file
@ -0,0 +1,131 @@
|
||||
{-----------------------------------------------------------------------------
|
||||
The contents of this file are subject to the Mozilla Public License
|
||||
Version 1.1 (the "License"); you may not use this file except in compliance
|
||||
with the License. You may obtain a copy of the License at
|
||||
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||
|
||||
Software distributed under the License is distributed on an "AS IS" basis,
|
||||
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||
the specific language governing rights and limitations under the License.
|
||||
|
||||
The Original Code is: JvExtComponent.pas, released on 2006-03-11.
|
||||
|
||||
The Initial Developer of the Original Code is Joe Doe .
|
||||
Portions created by Joe Doe are Copyright (C) 1999 Joe Doe.
|
||||
All Rights Reserved.
|
||||
|
||||
Contributor(s): -
|
||||
|
||||
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||
located at http://jvcl.delphi-jedi.org
|
||||
|
||||
Known Issues:
|
||||
-----------------------------------------------------------------------------}
|
||||
// $Id$
|
||||
|
||||
unit JvExtComponent;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Types,
|
||||
Classes, Graphics, ExtCtrls,
|
||||
JvExExtCtrls;
|
||||
// JvExComCtrls;
|
||||
|
||||
type
|
||||
TJvPaintPanelContentEvent = procedure(Sender: TObject; Canvas: TCanvas; R: TRect) of object;
|
||||
|
||||
TJvCustomPanel = class(TJvExCustomPanel)
|
||||
private
|
||||
FOnPaintContent: TJvPaintPanelContentEvent;
|
||||
protected
|
||||
(******************** NOT CONVERTED ***
|
||||
function GetFlat: Boolean;
|
||||
procedure ReadCtl3D(Reader: TReader);
|
||||
procedure ReadParentCtl3D(Reader: TReader);
|
||||
procedure SetFlat(const Value: Boolean);
|
||||
function GetParentFlat: Boolean;
|
||||
procedure SetParentFlat(const Value: Boolean);
|
||||
**************************************)
|
||||
|
||||
procedure Paint; override;
|
||||
procedure PaintContent(const R: TRect); virtual;
|
||||
|
||||
procedure DefineProperties(Filer: TFiler); override;
|
||||
|
||||
(******************* NOT CONVERTED ****
|
||||
property Flat: Boolean read GetFlat write SetFlat default False;
|
||||
property ParentFlat: Boolean read GetParentFlat write SetParentFlat default True;
|
||||
**************************************)
|
||||
|
||||
property OnPaintContent: TJvPaintPanelContentEvent read FOnPaintContent write FOnPaintContent;
|
||||
end;
|
||||
|
||||
(*************** NOT CONVERTED *********
|
||||
TJvPubCustomPanel = TJvExPubCustomPanel;
|
||||
TJvCustomTreeView = TJvExCustomTreeView;
|
||||
***************************************)
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TJvCustomPanel }
|
||||
|
||||
|
||||
(***************** NOT CONVERTED ***
|
||||
function TJvCustomPanel.GetFlat: Boolean;
|
||||
begin
|
||||
Result := not Ctl3D;
|
||||
end;
|
||||
|
||||
function TJvCustomPanel.GetParentFlat: Boolean;
|
||||
begin
|
||||
Result := ParentCtl3D;
|
||||
end;
|
||||
|
||||
procedure TJvCustomPanel.SetFlat(const Value: Boolean);
|
||||
begin
|
||||
Ctl3D := not Value;
|
||||
end;
|
||||
|
||||
procedure TJvCustomPanel.SetParentFlat(const Value: Boolean);
|
||||
begin
|
||||
ParentCtl3D := Value;
|
||||
end;
|
||||
|
||||
procedure TJvCustomPanel.ReadCtl3D(Reader: TReader);
|
||||
begin
|
||||
Flat := not Reader.ReadBoolean;
|
||||
end;
|
||||
|
||||
procedure TJvCustomPanel.ReadParentCtl3D(Reader: TReader);
|
||||
begin
|
||||
ParentFlat := Reader.ReadBoolean;
|
||||
end;
|
||||
************************)
|
||||
|
||||
procedure TJvCustomPanel.Paint;
|
||||
begin
|
||||
inherited Paint;
|
||||
PaintContent(ClientRect);
|
||||
end;
|
||||
|
||||
procedure TJvCustomPanel.PaintContent(const R: TRect);
|
||||
begin
|
||||
if Assigned(FOnPaintContent) then
|
||||
FOnPaintContent(Self, Canvas, R);
|
||||
end;
|
||||
|
||||
procedure TJvCustomPanel.DefineProperties(Filer: TFiler);
|
||||
begin
|
||||
inherited DefineProperties(Filer);
|
||||
(**************** NOT CONVERTED ****
|
||||
Filer.DefineProperty('Ctl3D', ReadCtl3D, nil, False);
|
||||
Filer.DefineProperty('ParentCtl3D', ReadParentCtl3D, nil, False);
|
||||
***********************************)
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -64,7 +64,9 @@ const
|
||||
******************** NOT CONVERTED *)
|
||||
|
||||
type
|
||||
(********************** NOT CONVERTED ****
|
||||
TJvHotTrackOptions = class;
|
||||
*****************************************)
|
||||
|
||||
{ IJvExControl is used for the identification of an JvExXxx control. }
|
||||
IJvExControl = interface
|
||||
@ -79,6 +81,7 @@ type
|
||||
end;
|
||||
|
||||
|
||||
(***************************** NOT CONVERTED ****
|
||||
{ IJvHotTrack is Specifies whether Control are highlighted when the mouse passes over them}
|
||||
IJvHotTrack = interface
|
||||
['{8F1B40FB-D8E3-46FE-A7A3-21CE4B199A8F}']
|
||||
@ -118,6 +121,7 @@ type
|
||||
property FrameVisible: Boolean read FFrameVisible write SetFrameVisible default False;
|
||||
property FrameColor: TColor read FFrameColor write SetFrameColor default $006A240A;
|
||||
end;
|
||||
***********************)
|
||||
|
||||
type
|
||||
TStructPtrMessage = class(TObject)
|
||||
@ -133,8 +137,11 @@ type
|
||||
procedure DrawDotNetControl(Control: TWinControl; AColor: TColor; InControl: Boolean);
|
||||
procedure HandleDotNetHighlighting(Control: TWinControl; const Msg: TLMessage;
|
||||
MouseOver: Boolean; Color: TColor);
|
||||
function CreateWMMessage(Msg: Integer; WParam: PtrInt; LParam: PtrInt): TLMessage; overload; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF}
|
||||
function CreateWMMessage(Msg: Integer; WParam: PtrInt; LParam: TControl): TLMessage; overload; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF}
|
||||
|
||||
procedure CreateWMMessage(var Mesg: TLMessage; Msg: Cardinal; WParam: WPARAM; LParam: LPARAM); overload; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF}
|
||||
//function CreateWMMessage(Msg: Integer; WParam: PtrInt; LParam: PtrInt): TLMessage; overload; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF}
|
||||
//function CreateWMMessage(Msg: Integer; WParam: PtrInt; LParam: TControl): TLMessage; overload; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF}
|
||||
|
||||
function SmallPointToLong(const Pt: TSmallPoint): LongInt; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF}
|
||||
function ShiftStateToKeyData(Shift: TShiftState): Longint;
|
||||
|
||||
@ -153,6 +160,11 @@ type
|
||||
//******************** NOT CONVERTED
|
||||
//WINCONTROL_DECL_DEFAULT(WinControl)
|
||||
|
||||
TJvDoEraseBackgroundMethod = function(Canvas: TCanvas; Param: LPARAM): Boolean of object;
|
||||
|
||||
function IsDefaultEraseBackground(Method: TJvDoEraseBackgroundMethod; MethodPtr: Pointer): Boolean;
|
||||
|
||||
type
|
||||
TJvExCustomControl = class(TCustomControl)
|
||||
private
|
||||
// TODO:
|
||||
@ -163,9 +175,9 @@ type
|
||||
FOnMouseEnter: TNotifyEvent;
|
||||
FOnMouseLeave: TNotifyEvent;
|
||||
FOnParentColorChanged: TNotifyEvent;
|
||||
function BaseWndProc(Msg: Integer; WParam: PtrInt = 0; LParam: Longint = 0): Integer; overload;
|
||||
function BaseWndProc(Msg: Integer; WParam: Ptrint; LParam: TControl): Integer; overload;
|
||||
function BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer;
|
||||
function BaseWndProc(Msg: Integer; WParam: PtrInt = 0; LParam: Longint = 0): LRESULT; overload;
|
||||
function BaseWndProc(Msg: Integer; WParam: Ptrint; LParam: TControl): LRESULT; overload;
|
||||
function BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): LRESULT;
|
||||
protected
|
||||
procedure WndProc(var Msg: TLMessage); override;
|
||||
procedure FocusChanged(AControl: TWinControl); dynamic;
|
||||
@ -348,6 +360,15 @@ end;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure CreateWMMessage(var Mesg: TLMessage; Msg: Cardinal; WParam: WPARAM; LParam: LPARAM);
|
||||
begin
|
||||
Mesg.Msg := Msg;
|
||||
Mesg.WParam := WParam;
|
||||
Mesg.LParam := LParam;
|
||||
Mesg.Result := 0;
|
||||
end;
|
||||
|
||||
{ --- replaced by newer version above
|
||||
function CreateWMMessage(Msg: Integer; WParam: PtrInt; LParam: PtrInt): TLMessage;
|
||||
begin
|
||||
Result.Msg := Msg;
|
||||
@ -360,6 +381,7 @@ function CreateWMMessage(Msg: Integer; WParam: PtrInt; LParam: TControl): TLMess
|
||||
begin
|
||||
Result := CreateWMMessage(Msg, WParam, Ptrint(LParam));
|
||||
end;
|
||||
}
|
||||
|
||||
{ TStructPtrMessage }
|
||||
constructor TStructPtrMessage.Create(AMsg: Integer; WParam: Integer; var LParam);
|
||||
@ -483,6 +505,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
(**************************** NOT CONVERTED ***
|
||||
|
||||
//=== { TJvHotTrackOptions } ======================================
|
||||
|
||||
@ -561,6 +584,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
*********************************)
|
||||
|
||||
//============================================================================
|
||||
|
||||
//******************** NOT CONVERTED
|
||||
@ -579,18 +604,14 @@ function TJvExGraphicControl.BaseWndProc(Msg: Integer; WParam: Integer = 0; LPar
|
||||
var
|
||||
Mesg: TLMessage;
|
||||
begin
|
||||
Mesg := CreateWMMessage(Msg, WParam, LParam);
|
||||
CreateWMMessage(Mesg, Msg, WParam, LParam);
|
||||
inherited WndProc(Mesg);
|
||||
Result := Mesg.Result;
|
||||
end;
|
||||
|
||||
function TJvExGraphicControl.BaseWndProc(Msg: Integer; WParam: Integer; LParam: TControl): Integer;
|
||||
var
|
||||
Mesg: TLMessage;
|
||||
begin
|
||||
Mesg := CreateWMMessage(Msg, WParam, LParam);
|
||||
inherited WndProc(Mesg);
|
||||
Result := Mesg.Result;
|
||||
Result := BaseWndProc(Msg, WParam, LCLType.LPARAM(LParam));
|
||||
end;
|
||||
|
||||
function TJvExGraphicControl.BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer;
|
||||
@ -758,31 +779,35 @@ end;
|
||||
|
||||
//============================================================================
|
||||
|
||||
function IsDefaultEraseBackground(Method: TJvDoEraseBackgroundMethod;
|
||||
MethodPtr: Pointer): Boolean;
|
||||
begin
|
||||
Result := TMethod(Method).Code = MethodPtr;
|
||||
end;
|
||||
|
||||
//============================================================================
|
||||
|
||||
constructor TJvExCustomControl.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FHintColor := clDefault;
|
||||
end;
|
||||
|
||||
function TJvExCustomControl.BaseWndProc(Msg: Integer; WParam: PtrInt = 0; LParam: Longint = 0): Integer;
|
||||
function TJvExCustomControl.BaseWndProc(Msg: Integer; WParam: PtrInt = 0; LParam: Longint = 0): LRESULT;
|
||||
var
|
||||
Mesg: TLMessage;
|
||||
begin
|
||||
Mesg := CreateWMMessage(Msg, WParam, LParam);
|
||||
CreateWMMessage(Mesg, Msg, WParam, LParam);
|
||||
inherited WndProc(Mesg);
|
||||
Result := Mesg.Result;
|
||||
end;
|
||||
|
||||
function TJvExCustomControl.BaseWndProc(Msg: Integer; WParam: PtrInt; LParam: TControl): Integer;
|
||||
var
|
||||
Mesg: TLMessage;
|
||||
function TJvExCustomControl.BaseWndProc(Msg: Integer; WParam: PtrInt; LParam: TControl): LRESULT;
|
||||
begin
|
||||
Mesg := CreateWMMessage(Msg, WParam, LParam);
|
||||
inherited WndProc(Mesg);
|
||||
Result := Mesg.Result;
|
||||
Result := BaseWndProc(Msg, WParam, LCLType.LPARAM(LParam));
|
||||
end;
|
||||
|
||||
function TJvExCustomControl.BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer;
|
||||
function TJvExCustomControl.BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): LRESULT;
|
||||
var
|
||||
Mesg: TStructPtrMessage;
|
||||
begin
|
||||
|
||||
@ -44,7 +44,9 @@ unit JvExExtCtrls;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Controls, ExtCtrls, Forms, Graphics, JvExControls, LCLIntf, LMessages;
|
||||
LCLIntf, LCLType, LMessages,
|
||||
Classes, Controls, ExtCtrls, Forms, Graphics,
|
||||
JvExControls;
|
||||
|
||||
type
|
||||
//******************** NOT CONVERTED
|
||||
@ -62,6 +64,66 @@ type
|
||||
//******************** NOT CONVERTED
|
||||
//WINCONTROL_DECL_DEFAULT(CustomPanel)
|
||||
|
||||
TJvExCustomPanel = class(TCustomPanel, IJvExControl)
|
||||
private
|
||||
FHintColor: TColor;
|
||||
FMouseOver: Boolean;
|
||||
FHintWindowClass: THintWindowClass;
|
||||
FOnMouseEnter: TNotifyEvent;
|
||||
FOnMouseLeave: TNotifyEvent;
|
||||
FOnParentColorChanged: TNotifyEvent;
|
||||
function BaseWndProc(Msg: Cardinal; WParam: WPARAM = 0; LParam: LPARAM = 0): LRESULT; overload;
|
||||
function BaseWndProc(Msg: Cardinal; WParam: WPARAM; LParam: TObject): LRESULT; overload;
|
||||
function BaseWndProcEx(Msg: Cardinal; WParam: WPARAM; var StructLParam): LRESULT;
|
||||
protected
|
||||
procedure WndProc(var Msg: TLMessage); override;
|
||||
procedure FocusChanged(AControl: TWinControl); dynamic;
|
||||
procedure VisibleChanged; reintroduce; dynamic;
|
||||
procedure EnabledChanged; reintroduce; dynamic;
|
||||
procedure TextChanged; reintroduce; virtual;
|
||||
procedure ColorChanged; reintroduce; dynamic;
|
||||
procedure FontChanged; reintroduce; dynamic;
|
||||
procedure ParentFontChanged; reintroduce; dynamic;
|
||||
procedure ParentColorChanged; reintroduce; dynamic;
|
||||
procedure ParentShowHintChanged; reintroduce; dynamic;
|
||||
function WantKey(Key: Integer; Shift: TShiftState): Boolean; virtual;
|
||||
function HintShow(var HintInfo: THintInfo): Boolean; reintroduce; dynamic;
|
||||
function HitTest(X, Y: Integer): Boolean; reintroduce; virtual;
|
||||
procedure MouseEnter; override;
|
||||
procedure MouseLeave; override;
|
||||
property MouseOver: Boolean read FMouseOver write FMouseOver;
|
||||
property HintColor: TColor read FHintColor write FHintColor default clDefault;
|
||||
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
|
||||
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
|
||||
property OnParentColorChange: TNotifyEvent read FOnParentColorChanged write FOnParentColorChanged;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
property HintWindowClass: THintWindowClass read FHintWindowClass write FHintWindowClass;
|
||||
private
|
||||
FDotNetHighlighting: Boolean;
|
||||
protected
|
||||
procedure BoundsChanged; reintroduce; virtual;
|
||||
procedure CursorChanged; reintroduce; dynamic;
|
||||
procedure ShowingChanged; reintroduce; dynamic;
|
||||
procedure ShowHintChanged; reintroduce; dynamic;
|
||||
procedure ControlsListChanging(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
|
||||
procedure ControlsListChanged(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
|
||||
procedure GetDlgCode(var Code: TDlgCodes); virtual;
|
||||
procedure FocusSet(PrevWnd: THandle); virtual;
|
||||
procedure FocusKilled(NextWnd: THandle); virtual;
|
||||
function DoEraseBackground(ACanvas: TCanvas; AParam: LPARAM): Boolean; virtual;
|
||||
{$IFDEF JVCLThemesEnabledD6}
|
||||
private
|
||||
function GetParentBackground: Boolean;
|
||||
protected
|
||||
procedure SetParentBackground(Value: Boolean); virtual;
|
||||
property ParentBackground: Boolean read GetParentBackground write SetParentBackground;
|
||||
{$ENDIF JVCLThemesEnabledD6}
|
||||
published
|
||||
property DotNetHighlighting: Boolean read FDotNetHighlighting write FDotNetHighlighting default False;
|
||||
end;
|
||||
|
||||
|
||||
(******************** NOT CONVERTED
|
||||
TJvExPubCustomPanel = class(TJvExCustomPanel)
|
||||
COMMON_PUBLISHED
|
||||
@ -185,6 +247,307 @@ uses
|
||||
//******************** NOT CONVERTED
|
||||
//WINCONTROL_IMPL_DEFAULT(Panel)
|
||||
|
||||
constructor TJvExCustomPanel.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FHintColor := clDefault;
|
||||
end;
|
||||
|
||||
function TJvExCustomPanel.BaseWndProc(Msg: Cardinal; WParam: WPARAM = 0; LParam: LPARAM = 0): LRESULT;
|
||||
var
|
||||
Mesg: TLMessage;
|
||||
begin
|
||||
CreateWMMessage(Mesg, Msg, WParam, LParam);
|
||||
inherited WndProc(Mesg);
|
||||
Result := Mesg.Result;
|
||||
end;
|
||||
|
||||
function TJvExCustomPanel.BaseWndProc(Msg: Cardinal; WParam: WPARAM; LParam: TObject): LRESULT;
|
||||
begin
|
||||
Result := BaseWndProc(Msg, WParam, LCLType.LPARAM(LParam));
|
||||
end;
|
||||
|
||||
function TJvExCustomPanel.BaseWndProcEx(Msg: Cardinal; WParam: WPARAM; var StructLParam): LRESULT;
|
||||
begin
|
||||
Result := BaseWndProc(Msg, WParam, LCLType.LPARAM(@StructLParam));
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.VisibleChanged;
|
||||
begin
|
||||
BaseWndProc(CM_VISIBLECHANGED);
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.EnabledChanged;
|
||||
begin
|
||||
BaseWndProc(CM_ENABLEDCHANGED);
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.TextChanged;
|
||||
begin
|
||||
BaseWndProc(CM_TEXTCHANGED);
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.FontChanged;
|
||||
begin
|
||||
BaseWndProc(CM_FONTCHANGED);
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.ColorChanged;
|
||||
begin
|
||||
BaseWndProc(CM_COLORCHANGED);
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.ParentFontChanged;
|
||||
begin
|
||||
BaseWndProc(CM_PARENTFONTCHANGED);
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.ParentColorChanged;
|
||||
begin
|
||||
BaseWndProc(CM_PARENTCOLORCHANGED);
|
||||
if Assigned(OnParentColorChange) then
|
||||
OnParentColorChange(Self);
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.ParentShowHintChanged;
|
||||
begin
|
||||
BaseWndProc(CM_PARENTSHOWHINTCHANGED);
|
||||
end;
|
||||
|
||||
function TJvExCustomPanel.WantKey(Key: Integer; Shift: TShiftState): Boolean;
|
||||
begin
|
||||
Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0;
|
||||
end;
|
||||
|
||||
function TJvExCustomPanel.HitTest(X, Y: Integer): Boolean;
|
||||
begin
|
||||
Result := BaseWndProc(CM_HITTEST, 0, SmallPointToLong(PointToSmallPoint(Point(X, Y)))) <> 0;
|
||||
end;
|
||||
|
||||
function TJvExCustomPanel.HintShow(var HintInfo: THintInfo): Boolean;
|
||||
begin
|
||||
GetHintColor(HintInfo, Self, FHintColor);
|
||||
if FHintWindowClass <> nil then
|
||||
HintInfo.HintWindowClass := FHintWindowClass;
|
||||
Result := BaseWndProcEx(CM_HINTSHOW, 0, HintInfo) <> 0;
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.MouseEnter;
|
||||
begin
|
||||
inherited;
|
||||
FMouseOver := True;
|
||||
{ --not needed
|
||||
if Assigned(FOnMouseEnter) then
|
||||
FOnMouseEnter(Self);
|
||||
BaseWndProc(CM_MOUSEENTER, 0, AControl);
|
||||
------}
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.MouseLeave;
|
||||
begin
|
||||
FMouseOver := False;
|
||||
inherited;
|
||||
{ ------ not needed in LCL
|
||||
BaseWndProc(CM_MOUSELEAVE, 0, AControl);
|
||||
if Assigned(FOnMouseLeave) then
|
||||
FOnMouseLeave(Self);
|
||||
------------- }
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.FocusChanged(AControl: TWinControl);
|
||||
begin
|
||||
BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.BoundsChanged;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.CursorChanged;
|
||||
begin
|
||||
BaseWndProc(CM_CURSORCHANGED);
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.ShowingChanged;
|
||||
begin
|
||||
BaseWndProc(CM_SHOWINGCHANGED);
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.ShowHintChanged;
|
||||
begin
|
||||
BaseWndProc(CM_SHOWHINTCHANGED);
|
||||
end;
|
||||
|
||||
{ VCL sends CM_CONTROLLISTCHANGE and CM_CONTROLCHANGE in a different order than
|
||||
the CLX methods are used. So we must correct it by evaluating "Inserting". }
|
||||
procedure TJvExCustomPanel.ControlsListChanging(Control: TControl; Inserting: Boolean);
|
||||
begin
|
||||
if Inserting then
|
||||
BaseWndProc(CM_CONTROLLISTCHANGE, WPARAM(Control), LPARAM(Inserting))
|
||||
else
|
||||
BaseWndProc(CM_CONTROLCHANGE, WPARAM(Control), LPARAM(Inserting));
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.ControlsListChanged(Control: TControl; Inserting: Boolean);
|
||||
begin
|
||||
if not Inserting then
|
||||
BaseWndProc(CM_CONTROLLISTCHANGE, WPARAM(Control), LPARAM(Inserting))
|
||||
else
|
||||
BaseWndProc(CM_CONTROLCHANGE, WPARAM(Control), LPARAM(Inserting));
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.GetDlgCode(var Code: TDlgCodes);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.FocusSet(PrevWnd: THandle);
|
||||
begin
|
||||
BaseWndProc(LM_SETFOCUS, WPARAM(PrevWnd), 0);
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.FocusKilled(NextWnd: THandle);
|
||||
begin
|
||||
BaseWndProc(LM_KILLFOCUS, WPARAM(NextWnd), 0);
|
||||
end;
|
||||
|
||||
function TJvExCustomPanel.DoEraseBackground(ACanvas: TCanvas; AParam: LPARAM): Boolean;
|
||||
begin
|
||||
Result := BaseWndProc(LM_ERASEBKGND, ACanvas.Handle, AParam) <> 0;
|
||||
end;
|
||||
|
||||
{$IFDEF JVCLThemesEnabledD6}
|
||||
function TJvExCustomPanel.GetParentBackground: Boolean;
|
||||
begin
|
||||
Result := JvThemes.GetParentBackground(Self);
|
||||
end;
|
||||
|
||||
procedure TJvExCustomPanel.SetParentBackground(Value: Boolean);
|
||||
begin
|
||||
JvThemes.SetParentBackground(Self, Value);
|
||||
end;
|
||||
{$ENDIF JVCLThemesEnabledD6}
|
||||
|
||||
procedure TJvExCustomPanel.WndProc(var Msg: TLMessage);
|
||||
var
|
||||
IdSaveDC: Integer;
|
||||
DlgCodes: TDlgCodes;
|
||||
lCanvas: TCanvas;
|
||||
begin
|
||||
if not DispatchIsDesignMsg(Self, Msg) then
|
||||
begin
|
||||
case Msg.Msg of
|
||||
(*********** NOT CONVERTED ****
|
||||
CM_DENYSUBCLASSING:
|
||||
Msg.Result := LRESULT(Ord(GetInterfaceEntry(IJvDenySubClassing) <> nil));
|
||||
*******************************)
|
||||
CM_DIALOGCHAR:
|
||||
with TCMDialogChar{$IFDEF CLR}.Create{$ENDIF}(Msg) do
|
||||
Result := LRESULT(Ord(WantKey(CharCode, KeyDataToShiftState(KeyData))));
|
||||
CM_HINTSHOW:
|
||||
with TCMHintShow(Msg) do
|
||||
Result := LRESULT(HintShow(HintInfo^));
|
||||
CM_HITTEST:
|
||||
with TCMHitTest(Msg) do
|
||||
Result := LRESULT(HitTest(XPos, YPos));
|
||||
{ -------------- not needed in LCL ----------
|
||||
CM_MOUSEENTER:
|
||||
MouseEnter(TControl(Msg.LParam));
|
||||
CM_MOUSELEAVE:
|
||||
MouseLeave(TControl(Msg.LParam));
|
||||
--------------------------------------------}
|
||||
CM_VISIBLECHANGED:
|
||||
VisibleChanged;
|
||||
CM_ENABLEDCHANGED:
|
||||
EnabledChanged;
|
||||
CM_TEXTCHANGED:
|
||||
TextChanged;
|
||||
CM_FONTCHANGED:
|
||||
FontChanged;
|
||||
CM_COLORCHANGED:
|
||||
ColorChanged;
|
||||
CM_FOCUSCHANGED:
|
||||
FocusChanged(TWinControl(Msg.LParam));
|
||||
CM_PARENTFONTCHANGED:
|
||||
ParentFontChanged;
|
||||
CM_PARENTCOLORCHANGED:
|
||||
ParentColorChanged;
|
||||
CM_PARENTSHOWHINTCHANGED:
|
||||
ParentShowHintChanged;
|
||||
CM_CURSORCHANGED:
|
||||
CursorChanged;
|
||||
CM_SHOWINGCHANGED:
|
||||
ShowingChanged;
|
||||
CM_SHOWHINTCHANGED:
|
||||
ShowHintChanged;
|
||||
CM_CONTROLLISTCHANGE:
|
||||
if Msg.LParam <> 0 then
|
||||
ControlsListChanging(TControl(Msg.WParam), True)
|
||||
else
|
||||
ControlsListChanged(TControl(Msg.WParam), False);
|
||||
CM_CONTROLCHANGE:
|
||||
if Msg.LParam = 0 then
|
||||
ControlsListChanging(TControl(Msg.WParam), False)
|
||||
else
|
||||
ControlsListChanged(TControl(Msg.WParam), True);
|
||||
LM_SETFOCUS:
|
||||
FocusSet(THandle(Msg.WParam));
|
||||
LM_KILLFOCUS:
|
||||
FocusKilled(THandle(Msg.WParam));
|
||||
LM_SIZE, LM_MOVE:
|
||||
begin
|
||||
inherited WndProc(Msg);
|
||||
BoundsChanged;
|
||||
end;
|
||||
LM_ERASEBKGND:
|
||||
if (Msg.WParam <> 0) and not IsDefaultEraseBackground(@DoEraseBackground, @TJvExCustomPanel.DoEraseBackground) then
|
||||
begin
|
||||
IdSaveDC := SaveDC(HDC(Msg.WParam)); // protect DC against Stock-Objects from Canvas
|
||||
lCanvas := TCanvas.Create;
|
||||
try
|
||||
lCanvas.Handle := HDC(Msg.WParam);
|
||||
Msg.Result := Ord(DoEraseBackground(lCanvas, Msg.LParam));
|
||||
finally
|
||||
lCanvas.Handle := 0;
|
||||
lCanvas.Free;
|
||||
RestoreDC(HDC(Msg.WParam), IdSaveDC);
|
||||
end;
|
||||
end
|
||||
else
|
||||
inherited WndProc(Msg);
|
||||
(*************************** NOT CONVERTED ***
|
||||
{$IFNDEF DELPHI2007_UP}
|
||||
LM_PRINTCLIENT, LM_PRINT: // VCL bug fix
|
||||
begin
|
||||
IdSaveDC := SaveDC(HDC(Msg.WParam)); // protect DC against changes
|
||||
try
|
||||
inherited WndProc(Msg);
|
||||
finally
|
||||
RestoreDC(HDC(Msg.WParam), IdSaveDC);
|
||||
end;
|
||||
end;
|
||||
{$ENDIF ~DELPHI2007_UP}
|
||||
*********************************************)
|
||||
LM_GETDLGCODE:
|
||||
begin
|
||||
inherited WndProc(Msg);
|
||||
DlgCodes := [dcNative] + DlgcToDlgCodes(Msg.Result);
|
||||
GetDlgCode(DlgCodes);
|
||||
if not (dcNative in DlgCodes) then
|
||||
Msg.Result := DlgCodesToDlgc(DlgCodes);
|
||||
end;
|
||||
else
|
||||
inherited WndProc(Msg);
|
||||
end;
|
||||
case Msg.Msg of // precheck message to prevent access violations on released controls
|
||||
CM_MOUSEENTER, CM_MOUSELEAVE, LM_KILLFOCUS, LM_SETFOCUS, LM_NCPAINT:
|
||||
if DotNetHighlighting then
|
||||
HandleDotNetHighlighting(Self, Msg, MouseOver, Color);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
//******************** NOT CONVERTED
|
||||
//WINCONTROL_IMPL_DEFAULT(RadioGroup)
|
||||
|
||||
@ -222,18 +585,14 @@ function TJvExSplitter.BaseWndProc(Msg: Integer; WParam: Integer = 0; LParam: Lo
|
||||
var
|
||||
Mesg: TLMessage;
|
||||
begin
|
||||
Mesg := CreateWMMessage(Msg, WParam, LParam);
|
||||
CreateWMMessage(Mesg, Msg, WParam, LParam);
|
||||
inherited WndProc(Mesg);
|
||||
Result := Mesg.Result;
|
||||
end;
|
||||
|
||||
function TJvExSplitter.BaseWndProc(Msg: Integer; WParam: Integer; LParam: TControl): Integer;
|
||||
var
|
||||
Mesg: TLMessage;
|
||||
begin
|
||||
Mesg := CreateWMMessage(Msg, WParam, LParam);
|
||||
inherited WndProc(Mesg);
|
||||
Result := Mesg.Result;
|
||||
Result := BaseWndProc(Msg, WParam, LCLType.LPARAM(LParam));
|
||||
end;
|
||||
|
||||
function TJvExSplitter.BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer;
|
||||
|
||||
@ -1234,12 +1234,14 @@ type
|
||||
|
||||
property OnChange: TIntegerListChange read FOnChange write FOnChange;
|
||||
end;
|
||||
***************************)
|
||||
|
||||
type
|
||||
TCollectionSortProc = function(Item1, Item2: TCollectionItem): Integer;
|
||||
|
||||
procedure CollectionSort(Collection: Classes.TCollection; SortProc: TCollectionSortProc);
|
||||
|
||||
(********************* NOT CONVERTED
|
||||
{$IFDEF COMPILER5}
|
||||
function SecondsBetween(const Now: TDateTime; const FTime: TDateTime): Integer;
|
||||
{$ENDIF COMPILER5}
|
||||
@ -9851,6 +9853,8 @@ end;
|
||||
{$ENDIF COMPILER5}
|
||||
{$ENDIF !BCB}
|
||||
|
||||
**********************)
|
||||
|
||||
procedure CollectionQuickSort(List: Classes.TCollection; L, R: Integer; SortProc: TCollectionSortProc);
|
||||
var
|
||||
I, J, pix: Integer;
|
||||
@ -9902,6 +9906,7 @@ begin
|
||||
CollectionQuickSort(Collection, 0, Collection.Count - 1, SortProc);
|
||||
end;
|
||||
|
||||
(********************* NOT CONVERTED
|
||||
{$IFDEF COMPILER5}
|
||||
function SecondsBetween(const Now: TDateTime; const FTime: TDateTime): Integer;
|
||||
begin
|
||||
|
||||
@ -104,14 +104,19 @@ type
|
||||
// Base class for persistent properties that can show events.
|
||||
// By default, Delphi and BCB don't show the events of a class
|
||||
// derived from TPersistent unless it also derives from
|
||||
// TComponent. However, up until version 5, you couldn't have
|
||||
// a Component as a Sub Component of another one, thus preventing
|
||||
// from having events for a sub property.
|
||||
// TComponent.
|
||||
// The design time editor associated with TJvPersistent will display
|
||||
// the events, thus mimicking a Sub Component.
|
||||
TJvPersistent = class(TComponent)
|
||||
private
|
||||
FOwner: TPersistent;
|
||||
function _GetOwner: TPersistent;
|
||||
protected
|
||||
function GetOwner: TPersistent; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
constructor Create(AOwner: TPersistent); reintroduce; virtual;
|
||||
function GetNamePath: string; override;
|
||||
property Owner: TPersistent read _GetOwner;
|
||||
end;
|
||||
|
||||
// Added by dejoy (2005-04-20)
|
||||
@ -120,13 +125,13 @@ type
|
||||
// and property change notify.
|
||||
TJvPropertyChangeEvent = procedure(Sender: TObject; const PropName: string) of object;
|
||||
|
||||
TJvPersistentProperty = class(TPersistent) // ?? TJvPersistent)
|
||||
TJvPersistentProperty = class(TJvPersistent)
|
||||
private
|
||||
FUpdateCount: Integer;
|
||||
FOnChanging: TNotifyEvent;
|
||||
FOnChange: TNotifyEvent;
|
||||
FOnChanged: TNotifyEvent;
|
||||
FOnChangingProperty: TJvPropertyChangeEvent;
|
||||
FOnChangeProperty: TJvPropertyChangeEvent;
|
||||
FOnChangedProperty: TJvPropertyChangeEvent;
|
||||
protected
|
||||
procedure Changed; virtual;
|
||||
procedure Changing; virtual;
|
||||
@ -137,9 +142,9 @@ type
|
||||
public
|
||||
procedure BeginUpdate; virtual;
|
||||
procedure EndUpdate; virtual;
|
||||
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
|
||||
property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
|
||||
property OnChangeProperty: TJvPropertyChangeEvent read FOnChangeProperty write FOnChangeProperty;
|
||||
property OnChangedProperty: TJvPropertyChangeEvent read FOnChangedProperty write FOnChangedProperty;
|
||||
property OnChangingProperty: TJvPropertyChangeEvent read FOnChangingProperty write FOnChangingProperty;
|
||||
end;
|
||||
|
||||
@ -351,8 +356,8 @@ const
|
||||
CenturyOffset: Byte = 60;
|
||||
NullDate: TDateTime = 0; {-693594}
|
||||
|
||||
(*********** NOT CONVERTED
|
||||
type
|
||||
(*********** NOT CONVERTED
|
||||
// JvDriveCtrls / JvLookOut
|
||||
TJvImageSize = (isSmall, isLarge);
|
||||
TJvImageAlign = (iaLeft, iaCentered);
|
||||
@ -361,8 +366,7 @@ type
|
||||
TJvDriveTypes = set of TJvDriveType;
|
||||
********************)
|
||||
|
||||
type
|
||||
// Defines how a property (like a HotTrackFont) follows changes in the component's normal Font
|
||||
// Defines how a property (like a HotTrackFont) follows changes in the component's normal Font
|
||||
TJvTrackFontOption = (
|
||||
hoFollowFont, // makes HotTrackFont follow changes to the normal Font
|
||||
hoPreserveCharSet, // don't change HotTrackFont.Charset
|
||||
@ -370,11 +374,16 @@ type
|
||||
hoPreserveHeight, // don't change HotTrackFont.Height (affects Size as well)
|
||||
hoPreserveName, // don't change HotTrackFont.Name
|
||||
hoPreservePitch, // don't change HotTrackFont.Pitch
|
||||
hoPreserveStyle); // don't change HotTrackFont.Style
|
||||
hoPreserveStyle, // don't change HotTrackFont.Style
|
||||
hoPreserveOrientation, // don't change HotTrackFont.Orientation
|
||||
hoPreserveQuality // don't change HotTrackFont.Quality
|
||||
);
|
||||
TJvTrackFontOptions = set of TJvTrackFontOption;
|
||||
|
||||
const
|
||||
DefaultTrackFontOptions = [hoFollowFont, hoPreserveColor, hoPreserveStyle];
|
||||
DefaultHotTrackColor = $00D2BDB6;
|
||||
DefaultHotTrackFrameColor = $006A240A;
|
||||
|
||||
(********************
|
||||
type
|
||||
@ -685,14 +694,52 @@ type
|
||||
|
||||
implementation
|
||||
|
||||
constructor TJvPersistent.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
{ TJvPersistent }
|
||||
|
||||
constructor TJvPersistent.Create(AOwner: TPersistent);
|
||||
begin
|
||||
if AOwner is TComponent then
|
||||
inherited Create(AOwner as TComponent)
|
||||
else
|
||||
inherited Create(nil);
|
||||
SetSubComponent(True);
|
||||
Name := 'SubComponent';
|
||||
|
||||
FOwner := AOwner;
|
||||
end;
|
||||
|
||||
type
|
||||
TPersistentAccessProtected = class(TPersistent);
|
||||
|
||||
function TJvPersistent.GetNamePath: string;
|
||||
var
|
||||
S: string;
|
||||
lOwner: TPersistent;
|
||||
begin
|
||||
Result := inherited GetNamePath;
|
||||
lOwner := GetOwner; //Resturn Nested NamePath
|
||||
if (lOwner <> nil)
|
||||
and ( (csSubComponent in TComponent(lOwner).ComponentStyle)
|
||||
or (TPersistentAccessProtected(lOwner).GetOwner <> nil)
|
||||
)
|
||||
then
|
||||
begin
|
||||
S := lOwner.GetNamePath;
|
||||
if S <> '' then
|
||||
Result := S + '.' + Result;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TJvPersistent.GetOwner: TPersistent;
|
||||
begin
|
||||
Result := FOwner;
|
||||
end;
|
||||
|
||||
function TJvPersistent._GetOwner: TPersistent;
|
||||
begin
|
||||
Result := GetOwner;
|
||||
end;
|
||||
|
||||
|
||||
{ TJvPersistentProperty }
|
||||
|
||||
procedure TJvPersistentProperty.BeginUpdate;
|
||||
@ -704,14 +751,14 @@ end;
|
||||
|
||||
procedure TJvPersistentProperty.Changed;
|
||||
begin
|
||||
if (FUpdateCount = 0) and Assigned(FOnChange) then
|
||||
FOnChange(Self);
|
||||
if (FUpdateCount = 0) and Assigned(FOnChanged) then
|
||||
FOnChanged(Self);
|
||||
end;
|
||||
|
||||
procedure TJvPersistentProperty.ChangedProperty(const PropName: string);
|
||||
begin
|
||||
if Assigned(FOnChangeProperty) then
|
||||
FOnChangeProperty(Self, PropName);
|
||||
if Assigned(FOnChangedProperty) then
|
||||
FOnChangedProperty(Self, PropName);
|
||||
end;
|
||||
|
||||
procedure TJvPersistentProperty.Changing;
|
||||
|
||||
335
components/jvcllaz/run/JvStdCtrls/jvhottrackpersistent.pas
Normal file
335
components/jvcllaz/run/JvStdCtrls/jvhottrackpersistent.pas
Normal file
@ -0,0 +1,335 @@
|
||||
{-----------------------------------------------------------------------------
|
||||
The contents of this file are subject to the Mozilla Public License
|
||||
Version 1.1 (the "License"); you may not use this file except in compliance
|
||||
with the License. You may obtain a copy of the License at
|
||||
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||
|
||||
Software distributed under the License is distributed on an "AS IS" basis,
|
||||
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||
the specific language governing rights and limitations under the License.
|
||||
|
||||
The Original Code is: JvButtonPersistent.PAS, released on 2007-11-20.
|
||||
|
||||
The Initial Developer of the Original Code is dejoy den [dejoybbs att gmail dott com]
|
||||
All Rights Reserved.
|
||||
|
||||
Contributor(s): dejoy.
|
||||
|
||||
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||
located at http://jvcl.delphi-jedi.org
|
||||
|
||||
Known Issues:
|
||||
-----------------------------------------------------------------------------}
|
||||
// $Id$
|
||||
|
||||
unit JvHotTrackPersistent;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Graphics,
|
||||
JvTypes;
|
||||
|
||||
type
|
||||
TJvHotTrackOptionsClass = class of TJvHotTrackOptions;
|
||||
|
||||
TJvHotTrackOptions = class(TJvPersistentProperty)
|
||||
private
|
||||
FEnabled: Boolean;
|
||||
FFrameVisible: Boolean;
|
||||
FColor: TColor;
|
||||
FFrameColor: TColor;
|
||||
procedure SetColor(Value: TColor);
|
||||
procedure SetEnabled(Value: Boolean);
|
||||
procedure SetFrameColor(Value: TColor);
|
||||
procedure SetFrameVisible(Value: Boolean);
|
||||
public
|
||||
constructor Create(AOwner: TPersistent); override;
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
published
|
||||
property Enabled: Boolean read FEnabled write SetEnabled default False;
|
||||
property Color: TColor read FColor write SetColor default DefaultHotTrackColor;
|
||||
property FrameVisible: Boolean read FFrameVisible write SetFrameVisible default False;
|
||||
property FrameColor: TColor read FFrameColor write SetFrameColor default DefaultHotTrackFrameColor;
|
||||
end;
|
||||
|
||||
{ IJvHotTrack specifies whether Controls are highlighted when the mouse passes over them }
|
||||
IJvHotTrack = interface
|
||||
['{8F1B40FB-D8E3-46FE-A7A3-21CE4B199A8F}']
|
||||
|
||||
function GetHotTrack: Boolean;
|
||||
function GetHotTrackFont: TFont;
|
||||
function GetHotTrackFontOptions: TJvTrackFontOptions;
|
||||
function GetHotTrackOptions: TJvHotTrackOptions;
|
||||
|
||||
procedure SetHotTrack(Value: Boolean);
|
||||
procedure SetHotTrackFont(Value: TFont);
|
||||
procedure SetHotTrackFontOptions(Value: TJvTrackFontOptions);
|
||||
procedure SetHotTrackOptions(Value: TJvHotTrackOptions);
|
||||
procedure Assign(Source: IJvHotTrack);
|
||||
|
||||
property HotTrack: Boolean read GetHotTrack write SetHotTrack;
|
||||
property HotTrackFont: TFont read GetHotTrackFont write SetHotTrackFont;
|
||||
property HotTrackFontOptions: TJvTrackFontOptions read GetHotTrackFontOptions write SetHotTrackFontOptions;
|
||||
property HotTrackOptions: TJvHotTrackOptions read GetHotTrackOptions write SetHotTrackOptions;
|
||||
end;
|
||||
|
||||
TJvCustomHotTrackPersistent = class(TJvPersistentProperty, IJvHotTrack)
|
||||
private
|
||||
FHotTrack: Boolean;
|
||||
FHotTrackFont: TFont;
|
||||
FHotTrackFontOptions: TJvTrackFontOptions;
|
||||
FHotTrackOptions:TJvHotTrackOptions;
|
||||
|
||||
{IJvHotTrack}
|
||||
function GetHotTrack: Boolean;
|
||||
function GetHotTrackFont: TFont;
|
||||
function GetHotTrackFontOptions: TJvTrackFontOptions;
|
||||
function GetHotTrackOptions: TJvHotTrackOptions;
|
||||
procedure SetHotTrack(Value: Boolean);
|
||||
procedure SetHotTrackFont(Value: TFont);
|
||||
procedure SetHotTrackFontOptions(Value: TJvTrackFontOptions);
|
||||
procedure SetHotTrackOptions(Value: TJvHotTrackOptions);
|
||||
|
||||
procedure IJvHotTrack_Assign(Source: IJvHotTrack);
|
||||
procedure IJvHotTrack.Assign = IJvHotTrack_Assign;
|
||||
protected
|
||||
class function GetHotTrackOptionsClass: TJvHotTrackOptionsClass; virtual;
|
||||
procedure AssignTo(Dest: TPersistent); override;
|
||||
public
|
||||
constructor Create(AOwner: TPersistent); override;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
|
||||
property HotTrack: Boolean read GetHotTrack write SetHotTrack default False;
|
||||
property HotTrackFont: TFont read GetHotTrackFont write SetHotTrackFont;
|
||||
property HotTrackFontOptions: TJvTrackFontOptions read GetHotTrackFontOptions write SetHotTrackFontOptions
|
||||
default DefaultTrackFontOptions;
|
||||
property HotTrackOptions: TJvHotTrackOptions read GetHotTrackOptions write SetHotTrackOptions;
|
||||
end;
|
||||
|
||||
TJvHotTrackPersistent = class(TJvCustomHotTrackPersistent)
|
||||
published
|
||||
property HotTrack;
|
||||
property HotTrackFont;
|
||||
property HotTrackFontOptions;
|
||||
property HotTrackOptions;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
|
||||
{ TJvHotTrackOptions }
|
||||
|
||||
constructor TJvHotTrackOptions.Create(AOwner: TPersistent);
|
||||
begin
|
||||
inherited ;
|
||||
FEnabled := False;
|
||||
FFrameVisible := False;
|
||||
FColor := DefaultHotTrackColor;
|
||||
FFrameColor := DefaultHotTrackFrameColor;
|
||||
end;
|
||||
|
||||
procedure TJvHotTrackOptions.Assign(Source: TPersistent);
|
||||
begin
|
||||
if Source is TJvHotTrackOptions then
|
||||
begin
|
||||
BeginUpdate;
|
||||
try
|
||||
Enabled := TJvHotTrackOptions(Source).Enabled;
|
||||
Color := TJvHotTrackOptions(Source).Color;
|
||||
FrameVisible := TJvHotTrackOptions(Source).FrameVisible;
|
||||
FrameColor := TJvHotTrackOptions(Source).FrameColor;
|
||||
finally
|
||||
EndUpdate;
|
||||
end;
|
||||
end
|
||||
else
|
||||
inherited Assign(Source);
|
||||
end;
|
||||
|
||||
procedure TJvHotTrackOptions.SetColor(Value: TColor);
|
||||
begin
|
||||
if FColor <> Value then
|
||||
begin
|
||||
Changing;
|
||||
ChangingProperty('Color');
|
||||
FColor := Value;
|
||||
ChangedProperty('Color');
|
||||
Changed;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvHotTrackOptions.SetEnabled(Value: Boolean);
|
||||
begin
|
||||
if FEnabled <> Value then
|
||||
begin
|
||||
Changing;
|
||||
ChangingProperty('Enabled');
|
||||
FEnabled := Value;
|
||||
ChangedProperty('Enabled');
|
||||
Changed;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvHotTrackOptions.SetFrameVisible(Value: Boolean);
|
||||
begin
|
||||
if FFrameVisible <> Value then
|
||||
begin
|
||||
Changing;
|
||||
ChangingProperty('FrameVisible');
|
||||
FFrameVisible := Value;
|
||||
ChangedProperty('FrameVisible');
|
||||
Changed;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvHotTrackOptions.SetFrameColor(Value: TColor);
|
||||
begin
|
||||
if FFrameColor <> Value then
|
||||
begin
|
||||
Changing;
|
||||
ChangingProperty('FrameColor');
|
||||
FFrameColor := Value;
|
||||
ChangedProperty('FrameColor');
|
||||
Changed;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TJvCustomHotTrackPersistent }
|
||||
|
||||
constructor TJvCustomHotTrackPersistent.Create(AOwner: TPersistent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
|
||||
FHotTrack := False;
|
||||
FHotTrackFont := TFont.Create;
|
||||
FHotTrackFontOptions := DefaultTrackFontOptions;
|
||||
FHotTrackOptions :=GetHotTrackOptionsClass.Create(Self);
|
||||
end;
|
||||
|
||||
destructor TJvCustomHotTrackPersistent.Destroy;
|
||||
begin
|
||||
FHotTrackFont.Free;
|
||||
FHotTrackOptions.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
class function TJvCustomHotTrackPersistent.GetHotTrackOptionsClass: TJvHotTrackOptionsClass;
|
||||
begin
|
||||
Result := TJvHotTrackOptions;
|
||||
end;
|
||||
|
||||
procedure TJvCustomHotTrackPersistent.Assign(Source: TPersistent);
|
||||
var
|
||||
Intf: IJvHotTrack;
|
||||
begin
|
||||
if Supports(Source, IJvHotTrack, Intf) then
|
||||
IJvHotTrack(Self).Assign(Intf)
|
||||
else
|
||||
inherited Assign(Source);
|
||||
end;
|
||||
|
||||
procedure TJvCustomHotTrackPersistent.AssignTo(Dest: TPersistent);
|
||||
var
|
||||
Intf: IJvHotTrack;
|
||||
begin
|
||||
if Supports(Dest, IJvHotTrack, Intf) then
|
||||
Intf.Assign(Self)
|
||||
else
|
||||
inherited AssignTo(Dest);
|
||||
end;
|
||||
|
||||
procedure TJvCustomHotTrackPersistent.SetHotTrackFont(Value: TFont);
|
||||
begin
|
||||
if (FHotTrackFont<>Value) and (Value <> nil) then
|
||||
begin
|
||||
Changing;
|
||||
ChangingProperty('HotTrackFont');
|
||||
FHotTrackFont.Assign(Value);
|
||||
ChangedProperty('HotTrackFont');
|
||||
Changed;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvCustomHotTrackPersistent.SetHotTrack(Value: Boolean);
|
||||
begin
|
||||
if FHotTrack <> Value then
|
||||
begin
|
||||
Changing;
|
||||
ChangingProperty('HotTrack');
|
||||
FHotTrack := Value;
|
||||
ChangedProperty('HotTrack');
|
||||
Changed;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvCustomHotTrackPersistent.SetHotTrackFontOptions(Value: TJvTrackFontOptions);
|
||||
begin
|
||||
if FHotTrackFontOptions <> Value then
|
||||
begin
|
||||
Changing;
|
||||
ChangingProperty('HotTrackFontOptions');
|
||||
FHotTrackFontOptions := Value;
|
||||
ChangedProperty('HotTrackFontOptions');
|
||||
Changed;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TJvCustomHotTrackPersistent.GetHotTrack: Boolean;
|
||||
begin
|
||||
Result := FHotTrack;
|
||||
end;
|
||||
|
||||
function TJvCustomHotTrackPersistent.GetHotTrackFont: TFont;
|
||||
begin
|
||||
Result := FHotTrackFont;
|
||||
end;
|
||||
|
||||
function TJvCustomHotTrackPersistent.GetHotTrackFontOptions: TJvTrackFontOptions;
|
||||
begin
|
||||
Result := FHotTrackFontOptions;
|
||||
end;
|
||||
|
||||
function TJvCustomHotTrackPersistent.GetHotTrackOptions: TJvHotTrackOptions;
|
||||
begin
|
||||
Result := FHotTrackOptions;
|
||||
end;
|
||||
|
||||
procedure TJvCustomHotTrackPersistent.SetHotTrackOptions(Value: TJvHotTrackOptions);
|
||||
begin
|
||||
if (FHotTrackOptions <> Value) and (Value <> nil) then
|
||||
begin
|
||||
Changing;
|
||||
ChangingProperty('HotTrackOptions');
|
||||
FHotTrackOptions.Assign(Value);
|
||||
ChangedProperty('HotTrackOptions');
|
||||
Changed;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvCustomHotTrackPersistent.IJvHotTrack_Assign(Source: IJvHotTrack);
|
||||
begin
|
||||
if (Source <> nil) and (IJvHotTrack(Self) <> Source) then
|
||||
begin
|
||||
BeginUpdate;
|
||||
try
|
||||
HotTrack := Source.HotTrack;
|
||||
HotTrackFont := Source.HotTrackFont;
|
||||
HotTrackFontOptions := Source.HotTrackFontOptions;
|
||||
HotTrackOptions := Source.HotTrackOptions;
|
||||
finally
|
||||
EndUpdate;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
1604
components/jvcllaz/run/JvStdCtrls/jvpanel.pas
Normal file
1604
components/jvcllaz/run/JvStdCtrls/jvpanel.pas
Normal file
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user