jvqscrollpanel.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: JvScrollPanel.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:
  A scrolling TToolWindow like the ones in IE 4.0 with popup scrollbuttons
   either on top/bottom or left/right edge.

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQScrollPanel.pas,v 1.22 2004/12/01 22:53:20 asnepvangers Exp $

unit JvQScrollPanel;

{$I jvcl.inc}

interface

uses
  SysUtils, Classes,
  QWindows, QMessages, QGraphics, QControls, QToolWin, QExtCtrls,
  JvQComponent, JvQExForms;

type
  TJvCustomScrollPanel = class;
  TJvDivideKind = (dkDivider, dkSeparator);
  TJvScrollKind = (sbUp, sbDown, sbLeft, sbRight);
  /// (DFCS_SCROLLUP, DFCS_SCROLLDOWN, DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT);
  TJvScrollDirection = (sdHorizontal, sdVertical);
  TJvScrollingEvent = procedure(Sender: TObject; var AllowChange: Boolean; Kind: TJvScrollKind) of object;
  TJvScrolledEvent = procedure(Sender: TObject; Kind: TJvScrollKind) of object;

  TJvDivider = class(TJvGraphicControl)
  private
    FKind: TJvDivideKind;
    FVertical: Boolean;
    procedure SetKind(Value: TJvDivideKind);
    procedure SetVertical(Value: Boolean);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Align;
    property Vertical: Boolean read FVertical write SetVertical default True;
    property Kind: TJvDivideKind read FKind write SetKind default dkDivider;
  end;

  TJvScrollButton = class(TJvCustomControl)
  private
    FDown: Boolean;
    FRepeat: Boolean;
    FFlat: Boolean;
    FAutoRepeat: Boolean;
    FScrollAmount: Word;
    FTimer: TTimer;
    FKind: TJvScrollKind;
    procedure SetKind(Value: TJvScrollKind);
    procedure SetFlat(Value: Boolean);
    procedure OnTime(Sender: TObject);
  protected
    procedure SetPosition; virtual;
    procedure Paint; override;
    procedure Click; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseEnter(Control: TControl); override;
    procedure MouseLeave(Control: TControl); override;
    procedure EnabledChanged; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property AutoRepeat: Boolean read FAutoRepeat write FAutoRepeat;
    property Flat: Boolean read FFlat write SetFlat;
    property Kind: TJvScrollKind read FKind write SetKind;
    property Increment: Word read FScrollAmount write FScrollAmount;
    property Width default 16;
    property Height default 16;
  end;

  TJvCustomScrollPanel = class(TJvExToolWindow)
  private
    FScrollDirection: TJvScrollDirection;
    FScrollAmount: Word;
    FAutoHide: Boolean;
    FAutoRepeat: Boolean;
    FAutoArrange: Boolean;
    FUpLeft: TJvScrollButton;
    FDownRight: TJvScrollButton;
    FOnScrolling: TJvScrollingEvent;
    FOnScrolled: TJvScrolledEvent;
    FFlat: Boolean;
    procedure SetAutoArrange(Value: Boolean);
    procedure SetAutoHide(Value: Boolean);
    procedure SetScrollDirection(Value: TJvScrollDirection);
    procedure SetFlat(Value: Boolean);
    procedure AlignArrows;
    procedure UpdateVisible;
    procedure ArrangeChildren;
    procedure SetupArrows;
  protected
    procedure VisibleChanged; override;
    procedure EnabledChanged; override;
    procedure SetParent( const  AParent: TWinControl); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    property Align default alTop;
    property Height default 35;
    property AutoHide: Boolean read FAutoHide write SetAutoHide;
    property AutoRepeat: Boolean read FAutoRepeat write FAutoRepeat;
    property AutoArrange: Boolean read FAutoArrange write SetAutoArrange default False;
    property Flat: Boolean read FFlat write SetFlat;
    property ScrollDirection: TJvScrollDirection read FScrollDirection write SetScrollDirection;
    property ScrollAmount: Word read FScrollAmount write FScrollAmount default 16;
    property OnScrolling: TJvScrollingEvent read FOnScrolling write FOnScrolling;
    property OnScrolled: TJvScrolledEvent read FOnScrolled write FOnScrolled;
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  end;

  TJvScrollingWindow = class(TJvCustomScrollPanel)
  public
    constructor Create(AComponent: TComponent); override;
  published
    property AutoArrange;
    property AutoHide default True;
    property AutoRepeat default False;
    property Flat;
    property ScrollDirection default sdHorizontal;
    property ScrollAmount;
    { inherited ones: }
    property Align;
    property BorderWidth;
    property EdgeInner;
    property EdgeOuter;
    property EdgeBorders;
///    property BevelInner;
///    property BevelOuter;
///    property BevelKind;
///    property BevelWidth;
    property Enabled;
    property ShowHint;
    property Hint;
    property ParentShowHint;
    property PopupMenu; 
    property Color;
    property ParentColor;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnScrolling;
    property OnScrolled;
    property TabOrder;
    property TabStop;
    property HelpContext;
  end;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Math,
  JvQThemes, JvQExControls;

const
  cInitTime = 360;
  cTimeDelay = 100;

{
procedure TileBitmap(Dest: TControl; Source: TBitmap);
var
  X, Y, W, H: Longint;
  DR,SR: TRect;
  Tmp: TBitmap;
  Canvas: TControlCanvas;
begin
  if not Source.Empty then
  begin
    with Source do
    begin
      W := Width;
      H := Height;
    end;

    Tmp := TBitmap.Create;
    Canvas := TControlCanvas.Create;
    Canvas.Control := Dest;
    Tmp.Width := Dest.Width;
    Tmp.Height := Dest.Height;

    Y := 0;
    SR := Rect(0,0,W,H);
    while y < Dest.Height do
    begin
      X := 0;
      while X < Dest.Width do
      begin
        DR := Rect(X,Y,X+W,Y+H);
        Tmp.Canvas.CopyRect(DR,Source.Canvas,SR);
        Inc(X, W);
      end;
      Inc(Y, H);
    end;
    BitBlt(Canvas.Handle,0,0,Dest.Width,Dest.Height,Tmp.Handle,0,0,SRCCOPY);
//    Canvas.Draw(0,0,Tmp);
    Tmp.Free;
    Canvas.Free;
  end;
end;
}

//=== { TJvDivider } =========================================================

constructor TJvDivider.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetBounds(0, 0, 16, 16);
  FVertical := True;
  FKind := dkDivider;
end;

procedure TJvDivider.SetVertical(Value: Boolean);
begin
  if FVertical <> Value then
  begin
    FVertical := Value;
    Invalidate;
  end;
end;

procedure TJvDivider.SetKind(Value: TJvDivideKind);
begin
  if FKind <> Value then
  begin
    FKind := Value;
    Invalidate;
  end;
end;

procedure TJvDivider.Paint;
var
  R: TRect;
begin
  if not Visible then
    Exit;
  if FKind = dkDivider then
    with Canvas do
    begin
      if FVertical then
      begin
        R := Rect(Width div 2 - 1, 1, Width, Height - 1);
        DrawEdge(Handle, R, EDGE_ETCHED, BF_LEFT);
      end
      else
      begin
        R := Rect(1, Height div 2 - 1, Width, Height - 1);
        DrawEdge(Handle, R, EDGE_ETCHED, BF_TOP);
      end;
    end;
  if csDesigning in ComponentState then
    with Canvas do
    begin
      Pen.Style := psDot;
      Pen.Color := clBtnShadow;
      Brush.Style := bsClear;
      Rectangle(0, 0, ClientWidth, ClientHeight);
    end;
end;

//=== { TJvScrollButton } ====================================================

constructor TJvScrollButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csDoubleClicks, csSetCaption];
  FDown := False;
  FScrollAmount := 16;
  FAutoRepeat := False;
  Width := 16;
  Height := 16;
end;

procedure TJvScrollButton.SetKind(Value: TJvScrollKind);
begin
  if FKind <> Value then
  begin
    FKind := Value;
    Invalidate;
  end;
end;

procedure TJvScrollButton.SetFlat(Value: Boolean);
begin
  if FFlat <> Value then
  begin
    FFlat := Value;
    Invalidate;
  end;
end;

procedure TJvScrollButton.MouseEnter(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  if not MouseOver then
  begin
    inherited MouseEnter(Control);
    if FFlat then
      Invalidate;
  end;
end;

procedure TJvScrollButton.MouseLeave(Control: TControl);
begin
  if MouseOver then
  begin
    FDown := False;
    inherited MouseLeave(Control);
    if FFlat then
      Invalidate;
  end;
end;

procedure TJvScrollButton.Paint;
const
  Kinds: array [TJvScrollKind] of Integer =
    (DFCS_SCROLLUP, DFCS_SCROLLDOWN, DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT);
var
  Flags: Integer;
  R: TRect;
begin
  if not Visible then
    Exit;
  R := GetClientRect;
  Flags := Kinds[FKind];

  if not Enabled then
  begin
    FDown := False;
    MouseOver := False;
    Flags := Flags or DFCS_INACTIVE or DFCS_FLAT;
  end;