jvqrollout.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
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鰎nqvist [peter3 at sourceforge dot net]
Portions created by Peter Th鰎nqvist are Copyright (C) 2002 Peter Th鰎nqvist.
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: JvQRollOut.pas,v 1.27 2005/02/20 23:43:40 asnepvangers Exp $

unit JvQRollOut;

{$I jvcl.inc}

interface

uses
  SysUtils, Classes,
  Qt, QWindows, QMessages, QControls, QGraphics, QImgList, QExtCtrls, QActnList,
  JvQComponent, JvQThemes;

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 DoExit; override;
    procedure DoEnter; 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; 
    property DragMode;
    property Enabled;
    property Font;
    property GroupIndex;
    property ImageOptions; 
    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;

implementation


uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  QForms; 

// (p3) not used
// const
//  cIncrement = 24;
//  cSmooth = False;



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;