jvgtreeview.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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: JvgTreeView.PAS, released on 2003-01-15.

The Initial Developer of the Original Code is Andrey V. Chudin,  [chudin att yandex dott ru]
Portions created by Andrey V. Chudin are Copyright (C) 2003 Andrey V. Chudin.
All Rights Reserved.

Contributor(s):
Michael Beck [mbeck att bigfoot dott com].

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvgTreeView.pas,v 1.34 2005/02/17 10:21:21 marquardt Exp $

unit JvgTreeView;

{$I jvcl.inc}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, ComCtrls, CommCtrl, ImgList, FlatSB,
  {$IFDEF USEJVCL}
  JvComponent,
  {$ENDIF USEJVCL}
  JvgTypes, JvgCommClasses;

const
  ITEM_ENABLED = Ord(True);
  ITEM_DISABLED = Ord(False);
  ncsUndefined = -1;
  ncsUnChecked = 1;
  ncsChecked = 2;
  ncsPartChecked = 3;

  TVS_NOTOOLTIPS = $0080;
  {$EXTERNALSYM TVS_NOTOOLTIPS}
  TVS_CHECKBOXES = $0100;
  {$EXTERNALSYM TVS_CHECKBOXES}
  TVS_TRACKSELECT = $0200;
  {$EXTERNALSYM TVS_TRACKSELECT}

type
  FOnTNDrawEvent = procedure(Sender: TObject; Msg: TWMPaint) of object;

  {$IFDEF USEJVCL}
  TJvgCustomTreeView = class(TJvCustomTreeView)
  {$ELSE}
  TJvgCustomTreeView = class(TCustomTreeView)
  {$ENDIF USEJVCL}
  private
    FCanvas: TControlCanvas;
    FWallpaper: TBitmap;
    FBoldSelection: Boolean;
    FBevelSelection: TJvgBevelOptions;
    FHotTrack: Boolean;
    FCheckBoxes: Boolean;
    FToolTips: Boolean;
    FMask: TBitmap;
    FGradient: TJvgGradient;
    FOnDraw: FOnTNDrawEvent;
    FOnEndEdit: TNotifyEvent;
    FPaintingNow: Boolean;
    FOptions: TglTreeViewOptions;
    FIsEditing: Boolean;
    function GetCanvas: TCanvas;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure SetWallpaper(Value: TBitmap);
    function GetWallpaper: TBitmap;
    procedure SetBoldSelection(Value: Boolean);
    procedure SetHotTrack(Value: Boolean);
    procedure SetCheckBoxes(Value: Boolean);
    procedure SetToolTips(Value: Boolean);
    procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
    procedure CNNotify(var Msg: TWMNotify); message CN_NOTIFY;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure UpdateFlatScrollBar; virtual;
    property Canvas: TCanvas read GetCanvas;
  public
    FDefaultPainting: Boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure SetNodeBoldState(Node: TTreeNode; ABold: Boolean);
    procedure SetNodeState_(ItemID: HTreeItem; StateMask, State: UINT);
  protected
    property Wallpaper: TBitmap read GetWallpaper write SetWallpaper;
    property Options: TglTreeViewOptions read FOptions write FOptions;
    property BoldSelection: Boolean read FBoldSelection write SetBoldSelection;
    property BevelSelection: TJvgBevelOptions read FBevelSelection write FBevelSelection;
    property HotTrack: Boolean read FHotTrack write SetHotTrack default False;
    property CheckBoxes: Boolean read FCheckBoxes write SetCheckBoxes default False;
    property ToolTips: Boolean read FToolTips write SetToolTips default True;
    property OnDraw: FOnTNDrawEvent read FOnDraw write FOnDraw;
    property OnEndEdit: TNotifyEvent read FOnEndEdit write FOnEndEdit;
  end;

  TJvgTreeView = class(TJvgCustomTreeView)
  published
    property ShowButtons;
    property BorderStyle;
    property DragCursor;
    property ShowLines;
    property ShowRoot;
    property ReadOnly;
    property RightClickSelect;
    property DragMode;
    property HideSelection;
    property Indent;
    property Items;
    property OnEditing;
    property OnEdited;
    property OnExpanding;
    property OnExpanded;
    property OnCollapsing;
    property OnCompare;
    property OnCollapsed;
    property OnChanging;
    property OnChange;
    property OnDeletion;
    property OnGetImageIndex;
    property OnGetSelectedIndex;
    property Align;
    property Enabled;
    property Font;
    property Color;
    property ParentColor default False;
    property SortType;
    property TabOrder;
    property TabStop default True;
    property Visible;
    property OnClick;
    property OnEnter;
    property OnExit;
    property OnDragDrop;
    property OnDragOver;
    property OnStartDrag;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnDblClick;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property PopupMenu;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property Images;
    property StateImages;
    property Wallpaper;
    property Options;
    property BoldSelection;
    property BevelSelection;
    property HotTrack;
    property CheckBoxes;
    property ToolTips;
    property OnDraw;
    property OnEndEdit;
  end;

  TJvgCheckTreeView = class(TJvgCustomTreeView)
  private
    FOnChangeCheck: TTVChangedEvent;
    FGlyphChecked: TBitmap;
    FGlyphUnChecked: TBitmap;
    FGlyphSemiChecked: TBitmap;
    FCheckKind: TglCheckKind;
    FChecksScheme: Integer;
    FCheckStateInheritance: Boolean;
    FCheckImageList: TImageList;
    procedure SetGlyphChecked(Value: TBitmap);
    procedure SetGlyphUnChecked(Value: TBitmap);
    procedure SetGlyphSemiChecked(Value: TBitmap);
    procedure SetChecksScheme(Value: Integer);
    procedure SetChecksBitmap;
    function TestChildCheckState(Node: TTreeNode): Integer;
    procedure TVMInsertItem(var Msg: TMessage); message TVM_INSERTITEM;
    procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
  protected
    procedure Loaded; override;
  public
    procedure Assign(Source: TPersistent); override;
    function CheckedItem: TTreeNode;
    function Checked(Node: TTreeNode): Boolean;
    procedure SetChecked(Node: TTreeNode; Value: Boolean);
    procedure SetStateIndex(Node: TTreeNode; StateIndex: Integer);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property OnChangeCheck: TTVChangedEvent read FOnChangeCheck write
      FOnChangeCheck;
    property GlyphChecked: TBitmap read FGlyphChecked write SetGlyphChecked;
    property GlyphUnChecked: TBitmap read FGlyphUnChecked write SetGlyphUnChecked;
    property GlyphSemiChecked: TBitmap read FGlyphSemiChecked write SetGlyphSemiChecked;
    property CheckKind: TglCheckKind read FCheckKind write FCheckKind default fckCheckBoxes;
    property ChecksScheme: Integer read FChecksScheme write SetChecksScheme;
    property CheckStateInheritance: Boolean read FCheckStateInheritance
      write FCheckStateInheritance default False;
  published
    property ShowButtons;
    property BorderStyle;
    property DragCursor;
    property ShowLines;
    property ShowRoot;
    property ReadOnly;
    property RightClickSelect;
    property DragMode;
    property HideSelection;
    property Indent;
    property Items;
    property OnEditing;
    property OnEdited;
    property OnExpanding;
    property OnExpanded;
    property OnCollapsing;
    property OnCompare;
    property OnCollapsed;
    property OnChanging;
    property OnChange;
    property OnDeletion;
    property OnGetImageIndex;
    property OnGetSelectedIndex;
    property Align;
    property Enabled;
    property Font;
    property Color;
    property ParentColor default False;
    property SortType;
    property TabOrder;
    property TabStop default True;
    property Visible;
    property OnClick;
    property OnEnter;
    property OnExit;
    property OnDragDrop;
    property OnDragOver;
    property OnStartDrag;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnDblClick;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property PopupMenu;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property Images;
    property Wallpaper;
    property Options;
    property BoldSelection;
    property BevelSelection;
    property HotTrack;
    property CheckBoxes;
    property ToolTips;
    property OnDraw;
    property OnEndEdit;
  end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvgTreeView.pas,v $';
    Revision: '$Revision: 1.34 $';
    Date: '$Date: 2005/02/17 10:21:21 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

uses
  Math,
  JvgUtils;

{$IFDEF MSWINDOWS}
{$R ..\Resources\JvgTreeView.res}
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
{$R ../Resources/JvgTreeView.res}
{$ENDIF UNIX}

//=== { TJvgCustomTreeView } =================================================

constructor TJvgCustomTreeView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TControlCanvas.Create;
  FCanvas.Control := Self; //...i can draw now! :)
  FBevelSelection := TJvgBevelOptions.Create;
  FHotTrack := False;
  FCheckBoxes := False;
  FToolTips := True;
  FMask := TBitmap.Create;
  FGradient := TJvgGradient.Create;
  if csDesigning in ComponentState then
    FWallpaper := TBitmap.Create;
end;

destructor TJvgCustomTreeView.Destroy;
begin
  // (ahuser) moved inherted to top otherwise it raises an AV
  inherited Destroy;
  FCanvas.Free;
  FBevelSelection.Free;
  FWallpaper.Free;
  FMask.Free;
  FGradient.Free;
end;

procedure TJvgCustomTreeView.Assign(Source: TPersistent);
begin
  if Source is TJvgCustomTreeView then
  begin
    Width := TJvgCustomTreeView(Source).Width;
    Height := TJvgCustomTreeView(Source).Height;
    Align := TJvgCustomTreeView(Source).Align;
    Parent := TJvgCustomTreeView(Source).Parent;
    Items.Assign(TJvgCustomTreeView(Source).Items);
  end
  else
    inherited Assign(Source);
end;

procedure TJvgCustomTreeView.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    if FHotTrack then
      Style := Style or TVS_TRACKSELECT;
    if FCheckBoxes then
      Style := Style or TVS_CHECKBOXES;
    if not FToolTips then
      Style := Style or TVS_NOTOOLTIPS;
  end;
end;

function TJvgCustomTreeView.GetCanvas: TCanvas;
begin
  Result := FCanvas;
end;

procedure TJvgCustomTreeView.CMDesignHitTest(var Msg: TCMDesignHitTest);
begin
  //...expanding in Design Time
  Msg.Result := Ord(htOnButton in GetHitTestInfoAt(Msg.XPos, Msg.YPos));
end;

procedure TJvgCustomTreeView.UpdateFlatScrollBar;
var
  MinPos, MaxPos: Integer;
begin
  try
    InitializeFlatSB(Handle);
    FlatSB_SetScrollProp(Handle, WSB_PROP_VSTYLE, FSB_ENCARTA_MODE, False);
    FlatSB_SetScrollProp(Handle, WSB_PROP_HSTYLE, FSB_ENCARTA_MODE, False);

    GetScrollRange(Handle, SB_VERT, MinPos, MaxPos);

    FlatSB_SetScrollRange(Handle, 1, MinPos, MaxPos, False);
  except
  end;
end;

procedure TJvgCustomTreeView.WMPaint(var Msg: TWMPaint);
var
  X, Y, IWidth, IHeight: Integer;
  R: TRect;
  Bmp, Bmp2: TBitmap;
  Mask, OldMask: HBITMAP;
  MaskDC: HDC;
  OldBkColor: COLORREF;

  procedure DrawBevel;
  var
    R: TRect;
  begin
    if Assigned(Selected) then
    begin
      R := Selected.DisplayRect(True);
      Dec(R.Right);
      Dec(R.Bottom);
      DrawBoxEx(FCanvas.Handle, R, FBevelSelection.Sides, FBevelSelection.Inner,
        FBevelSelection.Outer, FBevelSelection.Bold, 0, True);
    end;
  end;

begin
  if csDestroying in ComponentState then
    Exit;
  try
    if not Assigned(FWallpaper) or (FWallpaper.Handle = 0) then
    begin
      inherited;
      if Assigned(FOnDraw) then
        FOnDraw(Self, Msg);
      Exit;
    end;

    FPaintingNow := True;
    R := GetClientRect;
    IWidth := R.Right - R.Left;
    IHeight := R.Bottom - R.Top;
    Bmp := TBitmap.Create;
    Bmp2 := TBitmap.Create;
    Mask := CreateBitmap(IWidth, IHeight, 1, 1, nil);
    MaskDC := CreateCompatibleDC(FCanvas.Handle);
    OldMask := SelectObject(MaskDC, Mask);

    Bmp.Width := IWidth;
    Bmp.Height := IHeight;
    Bmp2.Width := IWidth;
    Bmp2.Height := IHeight;
    X := 0;
    Y := 0;
    while X < R.Right - R.Left do