jvwizardroutemaplist.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: JvWizardRouteMapList.PAS, released on 2004-02-14.

The Initial Developer of the Original Code is Peter Thornqvist.
Portions created by Peter Thornqvist are Copyright (C) 2004 Peter Thornqvist

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

Purpose:
  Route map that displays pages as a list

History:

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvWizardRouteMapList.pas,v 1.24 2005/03/09 14:57:33 marquardt Exp $

unit JvWizardRouteMapList;

{$I jvcl.inc}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  SysUtils, Classes,
  Windows, Messages, Graphics, Controls, Forms,
  {$IFDEF VisualCLX}
  QImgList,
  {$ENDIF VisualCLX}
  {$IFDEF USEJVCL}
  JvTypes, JvConsts, JvJVCLUtils,
  {$ENDIF USEJVCL}
  JvWizard;

{$IFNDEF USEJVCL}
{$IFDEF COMPILER5}
const
  clCream = TColor($F0FBFF);
{$ENDIF COMPILER5}
{$ENDIF !USEJVCL}

type
  TJvWizardDrawRouteMapListItem = procedure(Sender: TObject; ACanvas: TCanvas;
    ARect: TRect; MousePos: TPoint; PageIndex: Integer; var DefaultDraw: Boolean) of object;
  TRouteMapListItemText = (itNone, itCaption, itTitle, itSubtitle);

  TJvWizardRouteMapList = class(TJvWizardRouteMapControl)
  private
    FItemHeight: Integer;
    FVertOffset: Integer;
    FHorzOffset: Integer;
    FClickable: Boolean;
    FIncludeDisabled: Boolean;
    FHotTrackFont: TFont;
    FActiveFont: TFont;
    FHotTrackCursor, FOldCursor: TCursor;
    FOnDrawItem: TJvWizardDrawRouteMapListItem;
    FAlignment: TAlignment;
    FTextOffset: Integer;
    FShowImages: Boolean;
    FItemColor: TColor;
    FRounded: Boolean;
    FItemText: TRouteMapListItemText;
    FHotTrack: Boolean;
    FCurvature: Integer;
    FHotTrackBorder: Integer;
    FBorderColor: TColor;
    FTextOnly: Boolean;
    {$IFDEF USEJVCL}
    FHotTrackFontOptions: TJvTrackFontOptions;
    FActiveFontOptions: TJvTrackFontOptions;
    {$ENDIF USEJVCL}
    procedure SetItemHeight(const Value: Integer);
    procedure SetHorzOffset(const Value: Integer);
    procedure SetVertOffset(const Value: Integer);
    procedure SetIncludeDisabled(const Value: Boolean);
    procedure SetActiveFont(const Value: TFont);
    procedure SetHotTrackFont(const Value: TFont);
    procedure DoFontChange(Sender: TObject);
    procedure SetAlignment(const Value: TAlignment);
    procedure SetTextOffset(const Value: Integer);
    procedure SetShowImages(const Value: Boolean);
    procedure SetItemColor(const Value: TColor);
    procedure SetRounded(const Value: Boolean);
    procedure SetItemText(const Value: TRouteMapListItemText);
    procedure SetCurvature(const Value: Integer);
    procedure SetTextOnly(const Value: Boolean);
    procedure SetBorderColor(Value: TColor);
    {$IFDEF USEJVCL}
    procedure SetActiveFontOptions(const Value: TJvTrackFontOptions);
    procedure SetHotTrackFontOptions(const Value: TJvTrackFontOptions);
    {$ENDIF USEJVCL}
  protected
    procedure DrawPageItem(ACanvas: TCanvas; ARect: TRect; MousePos: TPoint; PageIndex: Integer); virtual;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    function PageAtPos(Pt: TPoint): TJvWizardCustomPage; override;
    procedure Paint; override;
    procedure Loaded; override;
    {$IFDEF VCL}
    procedure CMCursorChanged(var Msg: TMessage); message CM_CURSORCHANGED;
    procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
    {$ENDIF VCL}
    procedure CursorChanged; {$IFDEF VisualCLX} override; {$ENDIF}
    procedure FontChanged; {$IFDEF VisualCLX} override; {$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ActiveFont: TFont read FActiveFont write SetActiveFont;
    {$IFDEF USEJVCL}
    property ActiveFontOptions: TJvTrackFontOptions read FActiveFontOptions write SetActiveFontOptions default
      DefaultTrackFontOptions;
    {$ENDIF USEJVCL}
    property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
    property Clickable: Boolean read FClickable write FClickable default True;
    property Color default $00C08000;
    property Curvature: Integer read FCurvature write SetCurvature default 9;
    property Font;
    property HorzOffset: Integer read FHorzOffset write SetHorzOffset default 8;
    property HotTrackBorder: Integer read FHotTrackBorder write FHotTrackBorder default 2;
    property HotTrackCursor: TCursor read FHotTrackCursor write FHotTrackCursor default crHandPoint;
    property HotTrack: Boolean read FHotTrack write FHotTrack default True;

    property HotTrackFont: TFont read FHotTrackFont write SetHotTrackFont;
    {$IFDEF USEJVCL}
    property HotTrackFontOptions: TJvTrackFontOptions read FHotTrackFontOptions write SetHotTrackFontOptions default
      DefaultTrackFontOptions;
    {$ENDIF USEJVCL}
    property Image;
    property TextOnly: Boolean read FTextOnly write SetTextOnly default False;
    property IncludeDisabled: Boolean read FIncludeDisabled write SetIncludeDisabled default False;
    property BorderColor: TColor read FBorderColor write SetBorderColor default clNavy;
    property ItemColor: TColor read FItemColor write SetItemColor default clCream;
    property ItemHeight: Integer read FItemHeight write SetItemHeight default 25;
    property ItemText: TRouteMapListItemText read FItemText write SetItemText default itCaption;
    property Rounded: Boolean read FRounded write SetRounded default False;
    property ShowImages: Boolean read FShowImages write SetShowImages default False;
    property TextOffset: Integer read FTextOffset write SetTextOffset default 8;
    property VertOffset: Integer read FVertOffset write SetVertOffset default 8;
    property OnDrawItem: TJvWizardDrawRouteMapListItem read FOnDrawItem write FOnDrawItem;
  end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvWizardRouteMapList.pas,v $';
    Revision: '$Revision: 1.24 $';
    Date: '$Date: 2005/03/09 14:57:33 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

constructor TJvWizardRouteMapList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActiveFont := TFont.Create;
  FActiveFont.Style := [fsBold];
  FActiveFont.OnChange := DoFontChange;
  FHotTrackFont := TFont.Create;
  FHotTrackFont.Color := clNavy;
  FHotTrackFont.Style := [fsUnderline];
  FHotTrackFont.OnChange := DoFontChange;
  {$IFDEF USEJVCL}
  FActiveFontOptions := DefaultTrackFontOptions;
  FHotTrackFontOptions := DefaultTrackFontOptions;
  {$ENDIF USEJVCL}
  Color := $00C08000;
  FHotTrackCursor := crHandPoint;
  FVertOffset := 8;
  FHorzOffset := 8;
  FItemHeight := 25;
  FClickable := True;
  FAlignment := taCenter;
  FTextOffset := 8;
  FBorderColor := clNavy;
  FItemColor := clCream;
  FItemText := itCaption;
  FHotTrack := True;
  FCurvature := 9;
  FHotTrackBorder := 2;
  FTextOnly := False;
end;

destructor TJvWizardRouteMapList.Destroy;
begin
  FHotTrackFont.Free;
  FActiveFont.Free;
  inherited Destroy;
end;

procedure TJvWizardRouteMapList.Loaded;
begin
  inherited Loaded;
  FOldCursor := Cursor;
end;

procedure TJvWizardRouteMapList.MouseMove(Shift: TShiftState;
  X, Y: Integer);
var
  P: TJvWizardCustomPage;
begin
  inherited MouseMove(Shift, X, Y);
  if Clickable and HotTrack then
  begin
    P := PageAtPos(Point(X, Y));
    if (P <> nil) and P.Enabled then
    begin
      if Cursor <> FHotTrackCursor then
        FOldCursor := Cursor;
      Cursor := FHotTrackCursor;
      Refresh;
    end
    else
    if Cursor <> FOldCursor then
    begin
      Cursor := FOldCursor;
      Refresh;
    end;
  end;
end;

function TJvWizardRouteMapList.PageAtPos(Pt: TPoint): TJvWizardCustomPage;
var
  R: TRect;
  I: Integer;
begin
  Result := nil;
  if not Clickable then
    Exit;
  R := ClientRect;
  InflateRect(R, -HorzOffset, -VertOffset);
  R.Bottom := R.Top + ItemHeight;
  for I := 0 to PageCount - 1 do
  begin
    if Pages[I].Enabled or IncludeDisabled then
    begin
      if PtInRect(R, Pt) then
      begin
        Result := Pages[I];
        Exit;
      end;
      OffsetRect(R, 0, ItemHeight);
    end;
  end;
end;

procedure TJvWizardRouteMapList.Paint;
var
  I: Integer;
  R: TRect;
  P: TPoint;
begin
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := Color;
  if BorderColor = clNone then
    Canvas.Pen.Color := Color
  else
    Canvas.Pen.Color := BorderColor;
  GetCursorPos(P);
  P := ScreenToClient(P);
  R := ClientRect;
  if not HasPicture then
    Canvas.Rectangle(R)
  else
    Image.PaintTo(Canvas, R);
  if ItemHeight <= 0 then
    Exit;
  InflateRect(R, -HorzOffset, -VertOffset);
  R.Bottom := R.Top + ItemHeight;
  for I := 0 to PageCount - 1 do
    if Pages[I].Enabled or IncludeDisabled then
    begin
      DrawPageItem(Canvas, R, P, I);
      OffsetRect(R, 0, ItemHeight);
      if R.Bottom >= ClientHeight - 2 then
        Break;
    end;
end;

procedure TJvWizardRouteMapList.DrawPageItem(ACanvas: TCanvas; ARect: TRect; MousePos: TPoint; PageIndex: Integer);
const
  cAlignment: array [TAlignment] of Cardinal = (DT_LEFT, DT_RIGHT, DT_CENTER);
  cWordWrap: array [Boolean] of Cardinal = (DT_SINGLELINE, DT_WORDBREAK);
var
  DefaultDraw: Boolean;
  ATop, ALeft: Integer;
  AOrigRect: TRect;
  BkColor: TColor;
  S: string;
begin
  ACanvas.Lock;
  try
    AOrigRect := ARect;