jvqscrollmax.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: JvScrollMax.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Andrei Prygounkov <a dott prygounkov att gmx dott de>
Copyright (c) 1999, 2002 Andrei Prygounkov
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

component   : TJvScrollMax
description : scrollable panels

History:
  1.20:
    - first version;
  2.00:
    - new property ScrollbarVisible;
Known Issues:
  Some russian comments were translated to english; these comments are marked
  with [translated]
-----------------------------------------------------------------------------}
// $Id: JvQScrollMax.pas,v 1.21 2005/02/11 10:11:57 asnepvangers Exp $

unit JvQScrollMax;

{$I jvcl.inc}

interface

uses
  SysUtils, Classes,
  QWindows, QMessages, QGraphics, QForms, QExtCtrls, QControls, QButtons,
  JvQButtons, JvQComponent, JvQExControls;

const
  CM_PARENTBEVELEDCHANGED = WM_USER + 1;
  CM_PARENTBUTTONFONTCHANGED = WM_USER + 2;
  CM_PARENTBUTTONVISIBLECHANGED = WM_USER + 3;

type
  TOnCanExpand = procedure(Sender: TObject; var CanExpand: Boolean) of object;
  TOnCanCollapse = procedure(Sender: TObject; var CanCollapse: Boolean) of object;

  TJvScrollMax = class;

  TJvScrollMaxBand = class(TJvCustomControl)
  private
    FData: Pointer;
    FExpandedHeight: Integer;
    FButton: TSpeedButton;
    FExpanded: Boolean;
    FOrder: Integer;
    FBeveled: Boolean;
    FBorderWidth: Integer;
    FParentBeveled: Boolean;
    FParentButtonFont: Boolean;
    FParentButtonVisible: Boolean;
    FOnExpand: TNotifyEvent;
    FOnCollapse: TNotifyEvent;
    FOnCanCollapse: TOnCanCollapse;
    FOnCanExpand: TOnCanExpand;
    procedure ButtonClick(Sender: TObject);
    procedure SetExpanded(const Value: Boolean);
    procedure SetExpandedHeight(const Value: Integer);
    function GetOrder: Integer;
    procedure SetOrder(const Value: Integer);
    procedure SetParentBeveled(const Value: Boolean);
    procedure SetButtonFont(Value: TFont);
    function GetButtonFont: TFont;
    procedure SetBeveled(const Value: Boolean);
    procedure SetBorderWidth(const Value: Integer);
    function IsBeveledStored: Boolean;
    procedure SetParentButtonFont(const Value: Boolean);
    function IsButtonFontStored: Boolean;
    function GetButtonVisible: Boolean;
    procedure SetButtonVisible(const Value: Boolean);
    function IsButtonVisibleStored: Boolean;
    procedure SetParentButtonVisible(const Value: Boolean);
    procedure CMParentBeveledChanged(var Msg: TMessage); message CM_PARENTBEVELEDCHANGED;
    procedure CMParentButtonFontChanged(var Msg: TMessage); message CM_PARENTBUTTONFONTCHANGED;
    procedure CMParentButtonVisibleChanged(var Msg: TMessage); message CM_PARENTBUTTONVISIBLECHANGED;
  protected
    procedure TextChanged; override;
    procedure BoundsChanged; override;
    procedure Loaded; override;
    procedure Paint; override;
    procedure SetParent( const  AParent: TWinControl); 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 SetZOrder(TopMost: Boolean); override;
    function ScrollMax: TJvScrollMax;
    procedure UpdateSize(ATop: Integer);
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
    function CollapsedHeight: Integer;
    procedure ChangeScale(M, D , MH, DH : Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    property Data: Pointer read FData write FData;
  published
    property Expanded: Boolean read FExpanded write SetExpanded default True;
    property Caption;
    property ExpandedHeight: Integer read FExpandedHeight write SetExpandedHeight;
    property Order: Integer read GetOrder write SetOrder stored False;
    property ButtonVisible: Boolean read GetButtonVisible write SetButtonVisible stored IsButtonVisibleStored;
    property ButtonFont: TFont read GetButtonFont write SetButtonFont stored IsButtonFontStored;
    property Beveled: Boolean read FBeveled write SetBeveled default True;
    property BorderWidth: Integer read FBorderWidth write SetBorderWidth default 0;
    property ParentBeveled: Boolean read FParentBeveled write SetParentBeveled stored IsBeveledStored;
    property ParentButtonVisible: Boolean read FParentButtonVisible write SetParentButtonVisible default True;
    property ParentButtonFont: Boolean read FParentButtonFont write SetParentButtonFont default True;
    property OnResize;
    property OnExpand: TNotifyEvent read FOnExpand write FOnExpand;
    property OnCollapse: TNotifyEvent read FOnCollapse write FOnCollapse;
    property OnCanExpand: TOnCanExpand read FOnCanExpand write FOnCanExpand;
    property OnCanCollapse: TOnCanCollapse read FOnCanCollapse write FOnCanCollapse;
    property Left stored False;
    property Top stored False;
    property Width;
    property Height;
    property Color;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property Visible;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnStartDrag; 
  end;

  TJvScrollMaxBands = class(TJvCustomControl)
  private
    FScrolling: Boolean;
  protected
    procedure FocusChanged; override;
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
    procedure ScrollControls(const DeltaY: Integer);
    procedure Paint; override;
  end;

  TJvPanelScrollBar = class(TJvCustomPanel)
  private
    FMin: Integer;
    FMax: Integer;
    FPos: Integer;
    FPage: Integer;
    Scroll: TPanel;
    FDesignInteractive: Boolean;
    FInclusive: Boolean;
    FOnChange: TNotifyEvent;
    FOnScroll: TNotifyEvent;
    procedure SetParam(Index, Value: Integer);
    procedure SetInclusive(Value: Boolean);
  protected
    procedure CreateWnd; override;
    procedure SetTrackBar;
    procedure Loaded; override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetParams(const AMin, AMax, APage, APos: Integer);
    property Pos: Integer index 3 read FPos write SetParam;
    property DesignInteractive: Boolean read FDesignInteractive write FDesignInteractive;
    property Scroller: TPanel read Scroll;
  published
    property Color;
    property Align;
    property Min: Integer index 0 read FMin write SetParam;
    property Max: Integer index 1 read FMax write SetParam;
    property Page: Integer index 2 read FPage write SetParam;
    property Position: Integer index 3 read FPos write SetParam;
    property Inclusive: Boolean read FInclusive write SetInclusive;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnScroll: TNotifyEvent read FOnScroll write FOnScroll;
  end;

  TJvScrollMax = class(TJvCustomPanel)
  private
    FPnlEdit: TJvScrollMaxBands;
    FScrollBar: TJvPanelScrollBar;
    FScrollPos: Integer;
    FY: Integer;
    FButtonFont: TFont;
    FOnScroll: TNotifyEvent;
    FBeveled: Boolean;
    FButtonVisible: Boolean;
    FAutoHeight: Boolean;
    FExpandedHeight: Integer;
    FOneExpanded: Boolean;
    procedure Correct;
    procedure CorrectHeight;
    procedure BandMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure BandMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure BandMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ScrollBarScroll(Sender: TObject);
    procedure SetButtonFont(Value: TFont);
    procedure ButtonFontChanged(Sender: TObject);
    function GetBand(Index: Integer): TJvScrollMaxBand;
    function GetBandCount: Integer;
    procedure SetScrollPos(const Value: Integer);
    procedure SetButtonVisible(const Value: Boolean);
    procedure SetBeveled(const Value: Boolean);
    procedure SetAutoHeight(const Value: Boolean);
    procedure SetExpandedHeight(const Value: Integer);
    function GetScrollBarWidth: Cardinal;
    procedure SetScrollBarWidth(const Value: Cardinal);
    function GetScrollBarVisible: Boolean;
    procedure SetScrollBarVisible(const Value: Boolean);
    procedure SetOneExpanded(const Value: Boolean);
  protected 
    procedure Loaded; override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    function GetChildParent: TComponent; override; 
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ScrollInView(AControl: TControl);
    procedure MouseControls(AControls: array of TControl);
    procedure MouseClasses(AControlClasses: array of TControlClass);
    function AllCollapsed: Boolean;
    function AllExpanded: Boolean;
    procedure AddBand(Band: TJvScrollMaxBand);
    property BandCount: Integer read GetBandCount;
    property Bands[Index: Integer]: TJvScrollMaxBand read GetBand;
  published
    property ScrollPos: Integer read FScrollPos write SetScrollPos default 0;
    property BorderWidth default 3;
    property Beveled: Boolean read FBeveled write SetBeveled default True;
    property ButtonFont: TFont read FButtonFont write SetButtonFont;
    property ButtonVisible: Boolean read FButtonVisible write SetButtonVisible default True;
    property AutoHeight: Boolean read FAutoHeight write SetAutoHeight;
    property ExpandedHeight: Integer read FExpandedHeight write SetExpandedHeight default -1;
    property ScrollBarWidth: Cardinal read GetScrollBarWidth write SetScrollBarWidth default 7;
    property ScrollBarVisible: Boolean read GetScrollBarVisible write SetScrollBarVisible default True;
    property OneExpanded: Boolean read FOneExpanded write SetOneExpanded default False;
    property OnScroll: TNotifyEvent read FOnScroll write FOnScroll;
    property Align;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BorderStyle;
    property Color;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnResize;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnStartDrag;
  public 
  published
    property Anchors;
    //property AutoSize;
    property Constraints; 
  end;

  EJvScrollMaxError = class(Exception);

var
  crRAHand: Integer;
  crRAHandMove: Integer;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  JvQDsgnIntf, JvQJCLUtils, JvQJVCLUtils, JvQConsts, JvQThemes, JvQResources;

{ Cursors resources }
{$IFDEF MSWINDOWS}
{$R ..\Resources\JvScrollMax.res}
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
{$R ../Resources/JvScrollMax.res}
{$ENDIF UNIX}

function PanelBorder(Panel: TCustomPanel): Integer;
begin
  Result := TPanel(Panel).BorderWidth;
  if TPanel(Panel).BevelOuter <> bvNone then
    Inc(Result, TPanel(Panel).BevelWidth);
  if TPanel(Panel).BevelInner <> bvNone then
    Inc(Result, TPanel(Panel).BevelWidth);
end;

{ function DefineCursor was typed from
  book "Secrets of Delphi 2" by Ray Lischner }

{ (rom) deactivated  see end of file
function DefineCursor(Identifier: PChar): TCursor;
var
  Handle: HCURSOR;
begin
  Handle := LoadCursor(HInstance, Identifier);
  if Handle = 0 then
    raise EOutOfResources.CreateRes(@RsECannotLoadCursorResource);
  for Result := 1 to High(TCursor) do
    if Screen.Cursors[Result] = Screen.Cursors[crDefault] then
    begin
      Screen.Cursors[Result] := Handle;
      Exit;
    end;
  raise EOutOfResources.CreateRes(@RsETooManyUserdefinedCursors);
end;
}

//=== { TJvScroller } ========================================================

type
  TJvScroller = class(TPanel)
  private
    FY: Integer; 
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  end;

procedure TJvScroller.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    FY := Y;
end;

procedure TJvScroller.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  Sm, T, OldPos: Integer;
begin
  if Shift = [ssLeft] then
  begin
    Sm := FY - Y;
    T := Top;
    if Sm <> 0 then
    begin
      with Parent as TJvPanelScrollBar do
      begin
        OldPos := Pos;
        Pos := Pos - Round(Sm * (FMax - FMin + 1) / ClientHeight);
        if (Pos <> OldPos) and Assigned(FOnScroll) then
          FOnScroll(Parent);
      end;
    end;
    FY := Y - Top + T;
  end;
end;



//=== { TJvPanelScrollBar } ==================================================

constructor TJvPanelScrollBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  BevelOuter := bvLowered;
  Color := clAppWorkSpace;
  Caption := '';
  ControlStyle := ControlStyle - [csSetCaption, csAcceptsControls];
  Scroll := TJvScroller.Create(Self);
  Scroll.Parent := Self;
  Scroll.Caption := '';
  Scroll.ControlStyle := ControlStyle - [csSetCaption, csAcceptsControls];
  FMax := 100;
  FPage := 10;
  Width := 20;
  Height := 100;
end;

procedure TJvPanelScrollBar.Loaded;
begin
  inherited Loaded;
  Resize;
end;

procedure TJvPanelScrollBar.Resize;
begin
  inherited Resize;
  with Scroll do
  begin
    Top := BevelWidth;
    Left := BevelWidth;
    Width := Self.Width - 2 * BevelWidth;
  end;
  SetTrackBar;
end;

procedure TJvPanelScrollBar.SetTrackBar;
var
  CH, H, T: Integer;
  L, FP, P, P1: Integer;
begin
  { Before change of the code necessarily make a copy! [translated] }
  if FMin > FMax then
    FMin := FMax;
  if FPage > FMax - FMin + 1 then
    FPage := FMax - FMin + 1;
  if FInclusive then
    P := FPage
  else
    P := 0;
  P1 := FPage - P;
  if FPos > FMax - P then
    FPos := FMax - P;
  if FPos < FMin then
    FPos := FMin;
  L := FMax - FMin + 1;
  CH := Height - 2 * BevelWidth;
  H := Trunc(CH * FPage / L) + 1;
  FP := Trunc((FPos - FMin) / L * (L - P1)) + 1;
  T := Round(CH * FP / L);
  if H < 7 then
    H := 7;
  if H > CH then
    H := CH;
  if T < BevelWidth then
    T := BevelWidth;
  if T + H > Height - BevelWidth then
    T := Height - BevelWidth - H;
  if FPos = FMax - P then
    T := Height - BevelWidth - H;

  with Scroll do
    SetBounds(Left, T, Width, H);
end;

procedure TJvPanelScrollBar.SetParam(Index, Value: Integer);
begin
  case Index of
    0:
      FMin := Value;
    1:
      FMax := Value;
    2:
      FPage := Value;
    3:
      FPos := Value;
  end;
  SetParams(FMin, FMax, FPage, FPos);
end;

procedure TJvPanelScrollBar.SetParams(const AMin, AMax, APage, APos: Integer);
begin
  FMin := AMin;
  FMax := AMax;
  FPage := APage;
  FPos := APos;
  if Assigned(FOnChange) then
    FOnChange(Self);
  SetTrackBar;
end;

procedure TJvPanelScrollBar.SetInclusive(Value: Boolean);
begin
  FInclusive := Value;