Componentes.Terceros.jvcl/official/3.32/run/JvRollOut.pas

1301 lines
35 KiB
ObjectPascal

{-----------------------------------------------------------------------------
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: JvRollOut.PAS, released on 2002-05-26.
The Initial Developer of the Original Code is Peter Thörnqvist [peter3 at sourceforge dot net]
Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist.
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.sourceforge.net
Description:
TJvRollOut is an autoexpanding / collapsing panel.
Known Issues:
Doesn't draw an underline for speed-keys (the '&' character ) if
Placement = plLeft. Something with DrawText ?
Changes 2003-03-23:
* Several properties have changed and been put into nested sub-properties.
To update current usage do the following:
- Color: change to Colors.Color
- ButtonColor: change to Colors.ButtonColor
- ButtonColTop: change to Colors.ButtonTop
- ButtonColBtm: change to Colors.ButtonBottom
- ColHiText: change to Colors.HotTrackText
- FrameColTop: change to Colors.FrameTop
- FrameColBtm: change to Colors.FrameBottom
- ImageExpanded: change to ImageOptions.IndexExpanded
- ImageCollapsed: change to ImageOptions.IndexCollapsed
- ImageList: change to ImageOptions.Images
- ImageOffset: change to ImageOptions.Offset // peter3
-----------------------------------------------------------------------------}
// $Id: JvRollOut.pas 10612 2006-05-19 19:04:09Z jfudickar $
unit JvRollOut;
{$I jvcl.inc}
interface
uses
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
SysUtils, Classes,
Windows, Messages, Controls, Graphics, ImgList, ExtCtrls, ACtnList,
JvExtComponent, JvThemes;
const
CM_EXPANDED = WM_USER + 155;
type
TJvPlacement = (plTop, plLeft);
TJvRollOutColors = class(TPersistent)
private
FFrameBottom: TColor;
FHotTrackText: TColor;
FFrameTop: TColor;
FColor: TColor;
FButtonTop: TColor;
FButtonBottom: TColor;
FOnChange: TNotifyEvent;
FButtonColor: TColor;
procedure SetButtonBottom(const Value: TColor);
procedure SetButtonTop(const Value: TColor);
procedure SetColor(const Value: TColor);
procedure SetFrameBottom(const Value: TColor);
procedure SetFrameTop(const Value: TColor);
procedure SetHotTrackText(const Value: TColor);
procedure SetButtonColor(const Value: TColor);
protected
procedure Change;
public
constructor Create;
published
property ButtonBottom: TColor read FButtonBottom write SetButtonBottom default clBtnShadow;
property ButtonTop: TColor read FButtonTop write SetButtonTop default clBtnHighlight;
property ButtonColor: TColor read FButtonColor write SetButtonColor default clBtnFace;
property HotTrackText: TColor read FHotTrackText write SetHotTrackText default clWindowText;
property Color: TColor read FColor write SetColor default clBtnFace;
property FrameBottom: TColor read FFrameBottom write SetFrameBottom default clBtnHighlight;
property FrameTop: TColor read FFrameTop write SetFrameTop default clBtnShadow;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
TJvRollOutImageOptions = class(TPersistent)
private
FOffset: Integer;
FImages: TCustomImageList;
FIndexCollapsed: TImageIndex;
FIndexExpanded: TImageIndex;
FOnChange: TNotifyEvent;
FChangeLink: TChangeLink;
FOwner: TComponent;
procedure SetImages(const Value: TCustomImageList);
procedure SetIndexCollapsed(const Value: TImageIndex);
procedure SetIndexExpanded(const Value: TImageIndex);
procedure SetOffset(const Value: Integer);
protected
procedure Change;
procedure DoChangeLink(Sender: TObject);
public
constructor Create;
destructor Destroy; override;
published
property IndexCollapsed: TImageIndex read FIndexCollapsed write SetIndexCollapsed default 1;
property IndexExpanded: TImageIndex read FIndexExpanded write SetIndexExpanded default 0;
property Images: TCustomImageList read FImages write SetImages;
property Offset: Integer read FOffset write SetOffset default 5;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
TJvCustomRollOut = class(TJvCustomPanel)
private
FGroupIndex: Integer;
FButtonRect: TRect;
FPlacement: TJvPlacement;
FCollapsed: Boolean;
FMouseDown: Boolean;
FInsideButton: Boolean;
FCWidth: Integer;
FCHeight: Integer;
FAWidth: Integer;
FAHeight: Integer;
FButtonHeight: Integer;
FChildOffset: Integer;
FOnExpand: TNotifyEvent;
FOnCollapse: TNotifyEvent;
FColors: TJvRollOutColors;
FImageOptions: TJvRollOutImageOptions;
FToggleAnywhere: Boolean;
FShowFocus: Boolean;
FTabStops: TStringList;
procedure SetGroupIndex(Value: Integer);
procedure SetPlacement(Value: TJvPlacement);
procedure WriteAWidth(Writer: TWriter);
procedure WriteAHeight(Writer: TWriter);
procedure WriteCWidth(Writer: TWriter);
procedure WriteCHeight(Writer: TWriter);
procedure ReadAWidth(Reader: TReader);
procedure ReadAHeight(Reader: TReader);
procedure ReadCWidth(Reader: TReader);
procedure ReadCHeight(Reader: TReader);
procedure SetCollapsed(Value: Boolean);
procedure SetButtonHeight(Value: Integer);
procedure SetChildOffset(Value: Integer);
procedure RedrawControl(DrawAll: Boolean);
procedure DrawButtonFrame;
procedure UpdateGroup;
procedure CMExpanded(var Msg: TMessage); message CM_EXPANDED;
procedure ChangeHeight(NewHeight: Integer);
procedure ChangeWidth(NewWidth: Integer);
procedure SetShowFocus(const Value: Boolean);
protected
// Sets or gets the TabStop value of child controls depending on the value of Collapsed.
// When Collapsed is True, calls GetChildTabStops.
// When Collapsed is False, calls SetChildTabStops.
procedure CheckChildTabStops;
// Checks the TabStop value of all child controls and adds the control to
// an internal list if TabStop is True. TabStop is then set to False.
// This is done to disable tabbing into the child control when the rollout
// is collapsed. Normally, you don't need to call this method.
procedure GetChildTabStops;
// Resets the TabStop value of child controls to True if they where added to
// an internal list with a previous call to GetTabStops.
// Does nothing if GetChildTabStops hasn't been called.
// Normally, you don't need to call this method.
procedure SetChildTabStops;
// Clears the internal list with children TabStop values *without* restoring
// the childrens TabStop values first.
// Normally, you don't need to call this method.
procedure ClearChildTabStops;
procedure FocusKilled(NextWnd: THandle); override;
procedure FocusSet(PrevWnd: THandle); override;
function DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean; override;
procedure MouseEnter(Control: TControl); override;
procedure MouseLeave(Control: TControl); override;
function WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean; override;
procedure ParentColorChanged; override;
procedure CreateWnd; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure AlignControls(AControl: TControl; var Rect: TRect); 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 DefineProperties(Filer: TFiler); override;
procedure DoExpand; dynamic;
procedure DoCollapse; dynamic;
procedure Paint; override;
procedure Click; override;
procedure DoImageOptionsChange(Sender: TObject);
procedure DoColorsChange(Sender: TObject);
property ButtonHeight: Integer read FButtonHeight write SetButtonHeight default 20;
property ChildOffset: Integer read FChildOffset write SetChildOffset default 0;
property Collapsed: Boolean read FCollapsed write SetCollapsed default False;
property Colors: TJvRollOutColors read FColors write FColors;
property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
property ImageOptions: TJvRollOutImageOptions read FImageOptions write FImageOptions;
property Placement: TJvPlacement read FPlacement write SetPlacement default plTop;
property ShowFocus: Boolean read FShowFocus write SetShowFocus default True;
property ToggleAnywhere: Boolean read FToggleAnywhere write FToggleAnywhere default True;
property OnCollapse: TNotifyEvent read FOnCollapse write FOnCollapse;
property OnExpand: TNotifyEvent read FOnExpand write FOnExpand;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function MouseIsOnButton: Boolean;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure Collapse; virtual;
procedure Expand; virtual;
end;
TJvRollOutAction = class(TAction)
private
FRollOut: TJvCustomRollOut;
FLinkCheckedToCollapsed: Boolean;
procedure SetRollOut(const Value: TJvCustomRollOut);
procedure SetLinkCheckedToCollapsed(const Value: Boolean);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
procedure ExecuteTarget(Target: TObject); override;
procedure UpdateTarget(Target: TObject); override;
function HandlesTarget(Target: TObject): Boolean; override;
function Execute: Boolean; override;
destructor Destroy; override;
published
property RollOut: TJvCustomRollOut read FRollOut write SetRollOut;
property LinkCheckedToCollapsed: Boolean read FLinkCheckedToCollapsed write SetLinkCheckedToCollapsed;
end;
TJvRollOut = class(TJvCustomRollOut)
published
property Action;
property Align;
property BevelWidth;
property BorderWidth;
property ButtonHeight;
property Caption;
property ChildOffset;
property Placement;
property Collapsed;
property Colors;
{$IFDEF VCL}
property DragCursor;
{$ENDIF VCL}
property DragMode;
property Enabled;
property Font;
property GroupIndex;
property ImageOptions;
{$IFDEF JVCLThemesEnabled}
property ParentBackground default True;
{$ENDIF JVCLThemesEnabled}
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowFocus;
property ShowHint;
property TabOrder;
property TabStop;
property ToggleAnywhere;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
property OnExpand;
property OnCollapse;
end;
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvRollOut.pas $';
Revision: '$Revision: 10612 $';
Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $';
LogPath: 'JVCL\run'
);
{$ENDIF UNITVERSIONING}
implementation
{$IFDEF VCL}
uses
Forms; // for IsAccel()
{$ENDIF VCL}
{$IFDEF VisualCLX}
uses
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
QForms;
{$ENDIF VisualCLX}
// (p3) not used
// const
// cIncrement = 24;
// cSmooth = False;
{$IFDEF VCL}
procedure SetTextAngle(Cnv: TCanvas; Angle: Integer);
var
FntLogRec: TLogFont;
begin
GetObject(Cnv.Font.Handle, SizeOf(FntLogRec), Addr(FntLogRec));
FntLogRec.lfEscapement := Angle * 10;
FntLogRec.lfOutPrecision := OUT_TT_ONLY_PRECIS;
Cnv.Font.Handle := CreateFontIndirect(FntLogRec);
end;
{$ENDIF VCL}
procedure InternalFrame3D(Canvas: TCanvas; var Rect: TRect; TopColor, BottomColor: TColor; Width: Integer);
procedure DoRect;
var
TopRight, BottomLeft: TPoint;
begin
with Canvas, Rect do
begin
TopRight.X := Right;
TopRight.Y := Top;
BottomLeft.X := Left;
BottomLeft.Y := Bottom;
if TopColor <> clNone then
begin
Pen.Color := TopColor;
PolyLine([BottomLeft, TopLeft, TopRight]);
end;
if BottomColor <> clNone then
begin
Pen.Color := BottomColor;
Dec(BottomLeft.X);
PolyLine([TopRight, BottomRight, BottomLeft]);
end;
end;
end;
begin
Canvas.Pen.Width := 1;
Dec(Rect.Bottom);
Dec(Rect.Right);
while Width > 0 do
begin
Dec(Width);
DoRect;
InflateRect(Rect, -1, -1);
end;
Inc(Rect.Bottom);
Inc(Rect.Right);
end;
//=== { TJvRollOutImageOptions } =============================================
constructor TJvRollOutImageOptions.Create;
begin
inherited Create;
FChangeLink := TChangeLink.Create;
FChangeLink.OnChange := DoChangeLink;
FIndexCollapsed := 1;
FIndexExpanded := 0;
FOffset := 5;
end;
destructor TJvRollOutImageOptions.Destroy;
begin
FChangeLink.Free;
inherited Destroy;
end;
procedure TJvRollOutImageOptions.Change;
begin
if Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TJvRollOutImageOptions.DoChangeLink(Sender: TObject);
begin
Change;
end;
procedure TJvRollOutImageOptions.SetImages(const Value: TCustomImageList);
begin
if FImages <> nil then
begin
FImages.UnRegisterChanges(FChangeLink);
if FOwner <> nil then
FImages.RemoveFreeNotification(FOwner);
end;
FImages := Value;
if FImages <> nil then
begin
FImages.RegisterChanges(FChangeLink);
if FOwner <> nil then
FImages.FreeNotification(FOwner);
end;
Change;
end;
procedure TJvRollOutImageOptions.SetIndexCollapsed(const Value: TImageIndex);
begin
if FIndexCollapsed <> Value then
begin
FIndexCollapsed := Value;
Change;
end;
end;
procedure TJvRollOutImageOptions.SetIndexExpanded(const Value: TImageIndex);
begin
if FIndexExpanded <> Value then
begin
FIndexExpanded := Value;
Change;
end;
end;
procedure TJvRollOutImageOptions.SetOffset(const Value: Integer);
begin
if FOffset <> Value then
begin
FOffset := Value;
Change;
end;
end;
//=== { TJvRollOutColors } ===================================================
constructor TJvRollOutColors.Create;
begin
inherited Create;
FButtonBottom := clBtnShadow;
FButtonTop := clBtnHighlight;
FButtonColor := clBtnFace;
FHotTrackText := clWindowText;
FColor := clBtnFace;
FFrameBottom := clBtnHighlight;
FFrameTop := clBtnShadow;
end;
procedure TJvRollOutColors.Change;
begin
if Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TJvRollOutColors.SetButtonBottom(const Value: TColor);
begin
if FButtonBottom <> Value then
begin
FButtonBottom := Value;
Change;
end;
end;
procedure TJvRollOutColors.SetButtonColor(const Value: TColor);
begin
if FButtonColor <> Value then
begin
FButtonColor := Value;
Change;
end;
end;
procedure TJvRollOutColors.SetButtonTop(const Value: TColor);
begin
if FButtonTop <> Value then
begin
FButtonTop := Value;
Change;
end;
end;
procedure TJvRollOutColors.SetColor(const Value: TColor);
begin
if FColor <> Value then
begin
FColor := Value;
Change;
end;
end;
procedure TJvRollOutColors.SetFrameBottom(const Value: TColor);
begin
if FFrameBottom <> Value then
begin
FFrameBottom := Value;
Change;
end;
end;
procedure TJvRollOutColors.SetFrameTop(const Value: TColor);
begin
if FFrameTop <> Value then
begin
FFrameTop := Value;
Change;
end;
end;
procedure TJvRollOutColors.SetHotTrackText(const Value: TColor);
begin
if FHotTrackText <> Value then
begin
FHotTrackText := Value;
Change;
end;
end;
//=== { TJvCustomRollOut } ===================================================
constructor TJvCustomRollOut.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
IncludeThemeStyle(Self, [csNeedsBorderPaint, csParentBackground]);
FImageOptions := TJvRollOutImageOptions.Create;
FImageOptions.FOwner := Self;
FImageOptions.OnChange := DoImageOptionsChange;
FColors := TJvRollOutColors.Create;
FColors.OnChange := DoColorsChange;
FToggleAnywhere := True;
FGroupIndex := 0;
FCollapsed := False;
FMouseDown := False;
FInsideButton := False;
FChildOffset := 0;
FButtonHeight := 20;
FPlacement := plTop;
SetBounds(0, 0, 145, 170);
FAWidth := 145;
FAHeight := 170;
FCWidth := 22;
FCHeight := 22;
FShowFocus := True;
end;
destructor TJvCustomRollOut.Destroy;
begin
FreeAndNil(FImageOptions);
FreeAndNil(FTabStops);
FreeAndNil(FColors);
inherited Destroy;
end;
procedure TJvCustomRollOut.Click;
begin
if (Action = nil) and (MouseIsOnButton or ToggleAnywhere) then
Collapsed := not FCollapsed;
inherited Click;
RedrawControl(False);
end;
procedure TJvCustomRollOut.CreateWnd;
begin
inherited CreateWnd;
if not Collapsed then
UpdateGroup;
end;
procedure TJvCustomRollOut.AlignControls(AControl: TControl; var Rect: TRect);
begin
Rect.Left := Rect.Left + ChildOffset;
if FPlacement = plTop then
Rect.Top := Rect.Top + FButtonHeight
else
Rect.Left := Rect.Left + FButtonHeight;
inherited AlignControls(AControl, Rect);
end;
procedure TJvCustomRollOut.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
if not FMouseDown then
begin
FMouseDown := True;
RedrawControl(False);
if CanFocus {and not (csDesigning in ComponentState)} then
SetFocus;
end;
end;
procedure TJvCustomRollOut.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if FMouseDown then
begin
FMouseDown := False;
RedrawControl(False);
end;
end;
procedure TJvCustomRollOut.MouseMove(Shift: TShiftState; X, Y: Integer);
var
B: Boolean;
begin
B := FInsideButton;
inherited MouseMove(Shift, X, Y);
FInsideButton := PtInRect(FButtonRect, Point(X, Y));
if FInsideButton <> B then
RedrawControl(False);
end;
procedure TJvCustomRollOut.RedrawControl(DrawAll: Boolean);
begin
if DrawAll then
begin
{$IFDEF VisualCLX}
Canvas.Brush.Style := bsSolid;
{$ENDIF VisualCLX}
Invalidate;
end
else
begin
{$IFDEF VisualCLX}
Canvas.Brush.Style := bsClear;
{$ENDIF VisualCLX}
DrawButtonFrame;
end;
end;
procedure TJvCustomRollOut.SetGroupIndex(Value: Integer);
begin
if FGroupIndex <> Value then
begin
FGroupIndex := Value;
if not Collapsed then
UpdateGroup;
end;
end;
procedure TJvCustomRollOut.SetPlacement(Value: TJvPlacement);
begin
if FPlacement <> Value then
begin
FPlacement := Value;
if Collapsed then
begin
if FPlacement = plTop then
Height := FCHeight
else
Width := FCWidth;
end
else
begin
if FPlacement = plTop then
Height := FAHeight
else
Width := FAWidth;
end;
if FPlacement = plTop then
FButtonRect := Rect(1, 1, Width - 1, FButtonHeight - 1)
else
FButtonRect := Rect(1, 1, FButtonHeight - 1, Height - 1);
Realign;
RedrawControl(True);
end;
end;
procedure TJvCustomRollOut.SetCollapsed(Value: Boolean);
begin
if FCollapsed <> Value then
begin
FCollapsed := Value;
if Value then
begin
if Placement = plTop then
ChangeHeight(FCHeight)
else
ChangeWidth(FCWidth);
DoCollapse;
end
else
begin
if Placement = plTop then
ChangeHeight(FAHeight)
else
ChangeWidth(FAWidth);
DoExpand;
UpdateGroup;
end;
CheckChildTabStops;
end;
end;
procedure TJvCustomRollOut.ChangeHeight(NewHeight: Integer);
var
OldHeight: Integer;
begin
OldHeight := Height;
Parent.DisableAlign;
DisableAlign;
try
Height := NewHeight;
if Align = alBottom then
Top := Top + (OldHeight - NewHeight);
finally
EnableAlign;
Parent.EnableAlign;
end;
end;
procedure TJvCustomRollOut.ChangeWidth(NewWidth: Integer);
var
OldWidth: Integer;
begin
Parent.DisableAlign;
DisableAlign;
try
OldWidth := Width;
Width := NewWidth;
if Align = alRight then
Left := Left + (OldWidth - NewWidth);
finally
EnableAlign;
Parent.EnableAlign;
end;
end;
procedure TJvCustomRollOut.DoExpand;
begin
if Assigned(FOnExpand) then
FOnExpand(Self);
end;
procedure TJvCustomRollOut.DoCollapse;
begin
if Assigned(FOnCollapse) then
FOnCollapse(Self);
end;
procedure TJvCustomRollOut.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
if FCollapsed then
begin
if Placement = plTop then
FCHeight := AHeight
else
FCWidth := AWidth;
end
else
begin
if Placement = plTop then
FAHeight := AHeight
else
FAWidth := AWidth;
end;
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
if not Collapsed then
UpdateGroup;
end;
procedure TJvCustomRollOut.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineProperty('FAWidth', ReadAWidth, WriteAWidth, True);
Filer.DefineProperty('FAHeight', ReadAHeight, WriteAHeight, True);
Filer.DefineProperty('FCWidth', ReadCWidth, WriteCWidth, True);
Filer.DefineProperty('FCHeight', ReadCHeight, WriteCHeight, True);
end;
procedure TJvCustomRollOut.WriteAWidth(Writer: TWriter);
begin
Writer.WriteInteger(FAWidth);
end;
procedure TJvCustomRollOut.WriteAHeight(Writer: TWriter);
begin
Writer.WriteInteger(FAHeight);
end;
procedure TJvCustomRollOut.WriteCWidth(Writer: TWriter);
begin
Writer.WriteInteger(FCWidth);
end;
procedure TJvCustomRollOut.WriteCHeight(Writer: TWriter);
begin
Writer.WriteInteger(FCHeight);
end;
procedure TJvCustomRollOut.ReadAWidth(Reader: TReader);
begin
FAWidth := Reader.ReadInteger;
if not Collapsed and (Placement = plLeft) then
SetBounds(Left, Top, FAWidth, Height);
end;
procedure TJvCustomRollOut.ReadAHeight(Reader: TReader);
begin
FAHeight := Reader.ReadInteger;
if not Collapsed and (Placement = plTop) then
SetBounds(Left, Top, Width, FAHeight);
end;
procedure TJvCustomRollOut.ReadCWidth(Reader: TReader);
begin
FCWidth := Reader.ReadInteger;
if Collapsed and (Placement = plLeft) then
SetBounds(Left, Top, FCWidth, Height);
end;
procedure TJvCustomRollOut.ReadCHeight(Reader: TReader);
begin
FCHeight := Reader.ReadInteger;
if Collapsed and (Placement = plTop) then
SetBounds(Left, Top, Width, FCHeight);
end;
procedure TJvCustomRollOut.SetButtonHeight(Value: Integer);
begin
if FButtonHeight <> Value then
begin
FButtonHeight := Value;
FCHeight := Value + 2;
if FPlacement = plTop then
FButtonRect := Rect(BevelWidth, BevelWidth, Width - BevelWidth, FButtonHeight + BevelWidth)
else
FButtonRect := Rect(BevelWidth, BevelWidth, FButtonHeight + BevelWidth, Height - BevelWidth);
Realign;
RedrawControl(True);
end;
end;
procedure TJvCustomRollOut.SetChildOffset(Value: Integer);
begin
if FChildOffset <> Value then
begin
FChildOffset := Value;
Realign;
// R := ClientRect;
// AlignControls(nil,R);
end;
end;
procedure TJvCustomRollOut.MouseEnter(Control: TControl);
begin
inherited MouseEnter(Control);
if csDesigning in ComponentState then
Exit;
RedrawControl(False);
end;
procedure TJvCustomRollOut.MouseLeave(Control: TControl);
begin
inherited MouseLeave(Control);
if csDesigning in ComponentState then
Exit;
if FInsideButton then
begin
FInsideButton := False;
FMouseDown := False;
end;
RedrawControl(False);
end;
function TJvCustomRollOut.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
begin
// inherited DoEraseBackground(Canvas, Param);
Result := False;
end;
procedure TJvCustomRollOut.DrawButtonFrame;
var
R: TRect;
TopC, BottomC: TColor;
FIndex: Integer;
{$IFDEF VisualCLX}
WS: WideString;
{$ENDIF VisualCLX}
begin
if FPlacement = plTop then
FButtonRect := Rect(BevelWidth, BevelWidth, Width - BevelWidth, FButtonHeight + BevelWidth)
else
FButtonRect := Rect(BevelWidth, BevelWidth, FButtonHeight + BevelWidth, Height - BevelWidth);
R := FButtonRect;
Canvas.Brush.Color := Colors.ButtonColor;
if Canvas.Brush.Color <> clNone then
Canvas.FillRect(R);
if FMouseDown and FInsideButton then
begin
TopC := Colors.ButtonBottom;
BottomC := Colors.ButtonTop;
end
else
if FInsideButton then
begin
TopC := Colors.ButtonTop;
BottomC := Colors.ButtonBottom;
end
{ else
if Focused then
begin
TopC := clHighlight;
BottomC := clHighlight;
end}
else
begin
TopC := Colors.Color;
BottomC := Colors.Color;
end;
// if not (csDesigning in ComponentState) then
InternalFrame3D(Canvas, R, TopC, BottomC, 1);
if Collapsed then
FIndex := ImageOptions.IndexCollapsed
else
FIndex := ImageOptions.IndexExpanded;
R := FButtonRect;
if FPlacement = plTop then
begin
if Assigned(ImageOptions.Images) then
begin
ImageOptions.Images.Draw(Canvas, ImageOptions.Offset + BevelWidth,
BevelWidth + (FButtonHeight - ImageOptions.Images.Height) div 2, FIndex);
R.Left := ImageOptions.Images.Width + ImageOptions.Offset * 2 + BevelWidth;
end
else
R.Left := ImageOptions.Offset * 2 + BevelWidth;
R.Top := R.Top - (Canvas.TextHeight(Caption) - (FButtonRect.Bottom - FButtonRect.Top)) div 2 + BevelWidth div 2;
end
else
begin
if Assigned(ImageOptions.Images) then
begin
ImageOptions.Images.Draw(Canvas, BevelWidth + (FButtonHeight - ImageOptions.Images.Width) div 2,
ImageOptions.Offset + BevelWidth, FIndex);
R.Top := ImageOptions.Images.Height + ImageOptions.Offset * 2 + BevelWidth;
end
else
R.Top := ImageOptions.Offset * 2 + BevelWidth;
R.Left := R.Left + (Canvas.TextHeight(Caption) + (FButtonRect.Right - FButtonRect.Left)) div 2 + BevelWidth div 2;
end;
Canvas.Font := Font;
if FInsideButton then
Canvas.Font.Color := Colors.HotTrackText;
if Length(Caption) > 0 then
begin
SetBkMode(Canvas.Handle, Transparent);
if FMouseDown and FInsideButton then
OffsetRect(R, 1, 1);
{$IFDEF VCL}
if Placement = plLeft then
SetTextAngle(Canvas, 270);
DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_NOCLIP);
if Placement = plLeft then
SetTextAngle(Canvas, 0);
{$ENDIF VCL}
{$IFDEF VisualCLX}
WS := Caption;
SetPenColor(Canvas.Handle, Font.Color);
if Placement = plLeft then
DrawText(Canvas.Handle, WS, -1, R, DT_VCENTER, 270)
else
DrawText(Canvas.Handle, WS, -1, R, DT_VCENTER, 0)
{$ENDIF VisualCLX}
end;
if ShowFocus and Focused then
begin
R := FButtonRect;
InflateRect(R, -2, -2);
Canvas.DrawFocusRect(R);
end;
end;
procedure TJvCustomRollOut.Paint;
var
R: TRect;
begin
R := ClientRect;
if Colors.Color <> clNone then
begin
Canvas.Brush.Color := Colors.Color;
DrawThemedBackground(Self, Canvas, R);
end;
InternalFrame3D(Canvas, R, Colors.FrameTop, Colors.FrameBottom, BevelWidth);
if Colors.FrameTop = clNone then
begin
Dec(R.Left);
Dec(R.Top);
end;
if Colors.FrameBottom = clNone then
begin
Inc(R.Right);
Inc(R.Bottom);
end;
DrawButtonFrame;
end;
procedure TJvCustomRollOut.Collapse;
begin
SetCollapsed(True);
end;
procedure TJvCustomRollOut.Expand;
begin
SetCollapsed(False);
end;
procedure TJvCustomRollOut.UpdateGroup;
var
Msg: TMessage;
begin
if (FGroupIndex <> 0) and (Parent <> nil) then
begin
Msg.Msg := CM_EXPANDED;
Msg.WParam := FGroupIndex;
Msg.LParam := Longint(Self);
Msg.Result := 0;
Parent.Broadcast(Msg);
end;
end;
procedure TJvCustomRollOut.CMExpanded(var Msg: TMessage);
var
Sender: TJvCustomRollOut;
begin
if Msg.WParam = FGroupIndex then
begin
Sender := TJvCustomRollOut(Msg.LParam);
if (Sender <> Self) then
begin
SetCollapsed(True);
CheckChildTabStops;
Invalidate;
end;
end;
end;
(*
function IsAccel(VK: Word; const Str: string): Boolean;
var
P: Integer;
begin
P := Pos('&', Str);
Result := (P <> 0) and (P < Length(Str)) and
(AnsiCompareText(Str[P + 1], Char(VK)) = 0);
end;
*)
function TJvCustomRollOut.WantKey(Key: Integer; Shift: TShiftState;
const KeyText: WideString): Boolean;
begin
Result := Enabled and (IsAccel(Key, Caption) and (ssAlt in Shift)) or ((Key = VK_SPACE) and Focused);
if Result then
begin
SetCollapsed(not FCollapsed);
if CanFocus then
SetFocus;
end
else
Result := inherited WantKey(Key, Shift, KeyText);
end;
procedure TJvCustomRollOut.DoColorsChange(Sender: TObject);
begin
RedrawControl(True);
end;
procedure TJvCustomRollOut.DoImageOptionsChange(Sender: TObject);
begin
RedrawControl(True);
end;
procedure TJvCustomRollOut.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (ImageOptions <> nil) and (AComponent = ImageOptions.Images) then
ImageOptions.Images := nil;
end;
procedure TJvCustomRollOut.ParentColorChanged;
begin
inherited ParentColorChanged;
if ParentColor then
Colors.Color := Color;
end;
function TJvCustomRollOut.MouseIsOnButton: Boolean;
var
P: TPoint;
R: TRect;
begin
GetCursorPos(P);
P := ScreenToClient(P);
R := FButtonRect;
// (p3) include edges in hit test
InflateRect(R, 1, 1);
Result := PtInRect(R, P);
end;
procedure TJvCustomRollOut.FocusKilled(NextWnd: THandle);
begin
CheckChildTabStops;
inherited FocusKilled(NextWnd);
Invalidate;
end;
procedure TJvCustomRollOut.FocusSet(PrevWnd: THandle);
begin
CheckChildTabStops;
inherited FocusSet(PrevWnd);
Invalidate;
end;
procedure TJvCustomRollOut.SetShowFocus(const Value: Boolean);
begin
if FShowFocus <> Value then
begin
FShowFocus := Value;
if Focused then
Invalidate;
end;
end;
procedure TJvCustomRollOut.CheckChildTabStops;
begin
if csDesigning in ComponentState then
Exit;
if Collapsed then
GetChildTabStops
else
SetChildTabStops;
end;
procedure TJvCustomRollOut.GetChildTabStops;
var
I: Integer;
begin
if FTabStops = nil then
begin
FTabStops := TStringList.Create;
FTabStops.Sorted := True;
end;
for I := 0 to ControlCount - 1 do
if (Controls[I] is TWinControl) and (TWinControl(Controls[I]).TabStop) then
begin
FTabStops.AddObject(Controls[I].Name, Controls[I]);
TWinControl(Controls[I]).TabStop := False;
end;
end;
procedure TJvCustomRollOut.SetChildTabStops;
var
I: Integer;
begin
if FTabStops <> nil then
begin
for I := 0 to FTabStops.Count - 1 do
if FindChildControl(FTabStops[I]) <> nil then
TWinControl(FTabStops.Objects[I]).TabStop := True;
FreeAndNil(FTabStops);
end;
end;
procedure TJvCustomRollOut.ClearChildTabStops;
begin
FreeAndNil(FTabStops);
end;
//=== { TJvRollOutAction } ===================================================
destructor TJvRollOutAction.Destroy;
begin
if RollOut <> nil then
RollOut.RemoveFreeNotification(Self);
inherited Destroy;
end;
function TJvRollOutAction.Execute: Boolean;
begin
Result := inherited Execute;
if Result then
begin
{$IFDEF COMPILER6_UP}
if ActionComponent is TJvCustomRollOut then
begin
if LinkCheckedToCollapsed then
TJvCustomRollOut(ActionComponent).Collapsed := not Checked
else
TJvCustomRollOut(ActionComponent).Collapsed := not TJvCustomRollOut(ActionComponent).Collapsed;
end
else
{$ENDIF COMPILER6_UP}
if RollOut <> nil then
begin
if LinkCheckedToCollapsed then
RollOut.Collapsed := not Checked
else
RollOut.Collapsed := not RollOut.Collapsed;
end;
end;
end;
procedure TJvRollOutAction.ExecuteTarget(Target: TObject);
begin
inherited ExecuteTarget(Target);
if Target is TJvCustomRollOut then
begin
if LinkCheckedToCollapsed then
TJvCustomRollOut(Target).Collapsed := not Checked
else
TJvCustomRollOut(Target).Collapsed := not TJvCustomRollOut(Target).Collapsed;
end
else
if RollOut <> nil then
begin
if LinkCheckedToCollapsed then
RollOut.Collapsed := not Checked
else
RollOut.Collapsed := not RollOut.Collapsed;
end;
end;
function TJvRollOutAction.HandlesTarget(Target: TObject): Boolean;
begin
Result := ((RollOut <> nil) and (Target = RollOut) or
(RollOut = nil) and (Target is TJvCustomRollOut)) and TJvCustomRollOut(Target).Enabled;
end;
procedure TJvRollOutAction.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if AComponent = RollOut then
RollOut := nil;
end;
procedure TJvRollOutAction.SetLinkCheckedToCollapsed(const Value: Boolean);
begin
if FLinkCheckedToCollapsed <> Value then
begin
FLinkCheckedToCollapsed := Value;
if FLinkCheckedToCollapsed then
begin
if RollOut <> nil then
RollOut.Collapsed := not Checked
else
{$IFDEF COMPILER6_UP}
if ActionComponent is TJvCustomRollOut then
TJvCustomRollOut(ActionComponent).Collapsed := not Checked;
{$ENDIF COMPILER6_UP}
end;
end;
end;
procedure TJvRollOutAction.SetRollOut(const Value: TJvCustomRollOut);
begin
if FRollOut <> Value then
begin
if FRollOut <> nil then
FRollOut.RemoveFreeNotification(Self);
FRollOut := Value;
if FRollOut <> nil then
FRollOut.FreeNotification(Self);
end;
end;
procedure TJvRollOutAction.UpdateTarget(Target: TObject);
begin
if LinkCheckedToCollapsed then
Checked := not (Target as TJvCustomRollOut).Collapsed;
end;
{$IFDEF UNITVERSIONING}
initialization
RegisterUnitVersion(HInstance, UnitVersioning);
finalization
UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
end.