pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

jvcllaz: Add new component TJvWizard. Issue #35624, patch by Michal Gawrycki.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6934 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-05-24 21:57:05 +00:00
parent c67022ccfa
commit 61128acacc
23 changed files with 9817 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
components/jvcllaz/run/JvCore/JvJVCLUtils.pas
View File

@ -688,6 +688,8 @@ function JvMessageBox(const Text: string; Flags: DWORD): Integer; overload;
********************)
procedure UpdateTrackFont(TrackFont, Font: TFont; TrackOptions: TJvTrackFontOptions);
function IsHotTrackFontDfmStored(TrackFont, Font: TFont; TrackOptions: TJvTrackFontOptions): Boolean;
(********************
// Returns the size of the image
// used for checkboxes and radiobuttons.
@ -6449,6 +6451,30 @@ begin
end;
end;
function IsHotTrackFontDfmStored(TrackFont, Font: TFont; TrackOptions: TJvTrackFontOptions): Boolean;
var
DefFont: TFont;
begin
if hoFollowFont in TrackOptions then
DefFont := nil
else
begin
DefFont := TFont.Create;
Font := DefFont;
TrackOptions := []; // compare all
end;
try
Result := ((hoPreserveCharSet in TrackOptions) and (TrackFont.Charset <> Font.Charset)) or
((hoPreserveColor in TrackOptions) and (TrackFont.Color <> Font.Color)) or
((hoPreserveHeight in TrackOptions) and (TrackFont.Height <> Font.Height)) or
((hoPreservePitch in TrackOptions) and (TrackFont.Pitch <> Font.Pitch)) or
((hoPreserveStyle in TrackOptions) and (TrackFont.Style <> Font.Style)) or
((hoPreserveName in TrackOptions) and (TrackFont.Name <> Font.Name));
finally
DefFont.Free;
end;
end;
(********************
{ end JvCtrlUtils }

3177
components/jvcllaz/run/JvWizard/jvwizard.pas Normal file
View File

File diff suppressed because it is too large Load Diff

270
components/jvcllaz/run/JvWizard/jvwizardcommon.pas Normal file
View File

@ -0,0 +1,270 @@
{-----------------------------------------------------------------------------
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: JvWizardCommom.PAS, released on 2001-12-23.
The Initial Developer of the Original Code is William Yu Wei.
Portions created by William Yu Wei are Copyright (C) 2001 William Yu Wei.
All Rights Reserved.
Contributor(s):
Peter Th�rnqvist - converted to JVCL naming conventions on 2003-07-11
Micha� Gawrycki - Lazarus port (2019)
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org
Purpose:
All common functions and procedures which used by all components
History:
12/23/2001 First Create, introduce TKSide, TKSides, TJvWizardFrameStyle,
beAllSides, TKDeleteItemEvent
function KDrawSides, KDrawBevel, KDrawFrame
12/25/2001 introduced TKMessageLevel
01/04/2001 Add function KDrawBorderSides
Known Issues:
-----------------------------------------------------------------------------}
// $Id$
unit JvWizardCommon;
{$mode objfpc}
{$H+}
interface
uses
Controls, Graphics, Types, Classes, SysUtils, LCLIntf, LCLType,
JvResources;
type
TBevelEdge = (beLeft, beTop, beRight, beBottom);
TBevelEdges = set of TBevelEdge;
const
beAllEdges = [beLeft, beTop, beRight, beBottom];
type
TJvWizardFrameStyle =
(fsWindows, fsNone, fsFlat, fsGroove, fsBump, fsLowered, fsRaised);
TJvWizardImageAlignment = (iaLeft, iaRight, iaCenter, iaStretch);
TJvWizardImageLeftRight = iaLeft..iaRight;
TJvWizardImageLayout = (ilTop, ilBottom, ilCenter, ilStretch, ilTile);
EJvWizardError = class(Exception);
function JvWizardDrawEdges(ACanvas: TCanvas; ABounds: TRect;
ULColor, LRColor: TColor; AEdges: TBevelEdges): TRect;
function JvWizardDrawBorderEdges(ACanvas: TCanvas; ABounds: TRect;
AStyle: TJvWizardFrameStyle; AEdges: TBevelEdges): TRect;
procedure JvWizardDrawImage(ACanvas: TCanvas; AGraphic: TGraphic; ARect: TRect;
Align: TJvWizardImageAlignment; ALayout: TJvWizardImageLayout);
implementation
const
{ Frame Style Color constant arrays }
KULFrameColor: array [TJvWizardFrameStyle] of TColor = (clNone, clWindow,
clWindowFrame, clBtnShadow, clBtnHighlight, clBtnShadow, clBlack);
KLRFrameColor: array [TJvWizardFrameStyle] of TColor = (clNone, clBtnFace,
clWindowFrame, clBtnHighlight, clBtnShadow, clBtnHighlight, clBtnFace);
{-----------------------------------------------------------------------------
Procedure: JvWizardDrawEdges
Author: yuwei
Date: December 23, 2001
Time: 17:22:42
Purpose: Draw a frame with specified the borders on the specified bounds
of the canvas.
Arguments:
ACanvas: TCanvas;
the canvas where it draws the sides.
ABounds: TRect;
the bounds of the canvas for drawing.
ULColor: TColor;
the left and top side color.
LRColor: TColor;
the right and bottom side color.
ASides: TBevelEdges;
which sides it can draw on the canvas.
Result:
TRect:
The bounds within the sides after drawing.
See also:
History:
---------------------------------------------------------------------------
Date(mm/dd/yy) Comments
---------------------------------------------------------------------------
12/23/2001 First Release
-----------------------------------------------------------------------------}
function JvWizardDrawEdges(ACanvas: TCanvas; ABounds: TRect;
ULColor, LRColor: TColor; AEdges: TBevelEdges): TRect;
begin
with ACanvas do
begin
Pen.Style := psSolid;
Pen.Mode := pmCopy;
Pen.Color := ULColor;
if beLeft in AEdges then
begin
MoveTo(ABounds.Left, ABounds.Top);
LineTo(ABounds.Left, ABounds.Bottom);
end;
if beTop in AEdges then
begin
MoveTo(ABounds.Left, ABounds.Top);
LineTo(ABounds.Right, ABounds.Top);
end;
Pen.Color := LRColor;
if beRight in AEdges then
begin
MoveTo(ABounds.Right - 1, ABounds.Top);
LineTo(ABounds.Right - 1, ABounds.Bottom);
end;
if beBottom in AEdges then
begin
MoveTo(ABounds.Left, ABounds.Bottom - 1);
LineTo(ABounds.Right, ABounds.Bottom - 1);
end;
end;
if beLeft in AEdges then
Inc(ABounds.Left);
if beTop in AEdges then
Inc(ABounds.Top);
if beRight in AEdges then
Dec(ABounds.Right);
if beBottom in AEdges then
Dec(ABounds.Bottom);
Result := ABounds;
end;
function JvWizardDrawBorderEdges(ACanvas: TCanvas; ABounds: TRect;
AStyle: TJvWizardFrameStyle; AEdges: TBevelEdges): TRect;
var
ULColor, LRColor: TColor;
R: TRect;
begin
{ Draw the Frame }
if not (AStyle in [fsNone, fsWindows]) then
begin
ULColor := KULFrameColor[AStyle];
LRColor := KLRFrameColor[AStyle];
if AStyle in [fsFlat] then
ABounds := JvWizardDrawEdges(ACanvas, ABounds, ULColor, LRColor, AEdges)
else
begin
R := ABounds;
Inc(R.Left);
Inc(R.Top);
JvWizardDrawEdges(ACanvas, R, LRColor, LRColor, AEdges);
OffsetRect(R, -1, -1);
JvWizardDrawEdges(ACanvas, R, ULColor, ULColor, AEdges);
if beLeft in AEdges then
Inc(ABounds.Left, 2);
if beTop in AEdges then
Inc(ABounds.Top, 2);
if beRight in AEdges then
Dec(ABounds.Right, 2);
if beBottom in AEdges then
Dec(ABounds.Bottom, 2);
end;
end;
Result := ABounds;
end;
procedure JvWizardDrawTiled(ACanvas: TCanvas; AGraphic: TGraphic; ARect: TRect);
var
AWidth, AHeight: Integer;
Bmp: Graphics.TBitmap;
begin
if not Assigned(AGraphic) or (AGraphic.Width = 0) or (AGraphic.Height = 0) then
raise EJvWizardError.CreateRes(@RsETilingError);
// Create a temporary bitmap to draw into. This is both to speed things up a bit
// and also to clip the image to the ARect param (using Draw doesn't clip the image,
// but it does support auto-detecting transparency)
Bmp := {Graphics.}TBitmap.Create;
try
Bmp.Width := ARect.Right - ARect.Left;
Bmp.Height := ARect.Bottom - ARect.Top;
Bmp.Canvas.Brush.Color := ACanvas.Brush.Color;
Bmp.Canvas.FillRect(Bmp.Canvas.ClipRect);
AWidth := 0;
while AWidth <= Bmp.Width do
begin
AHeight := 0;
while AHeight <= Bmp.Height do
begin
Bmp.Canvas.Draw(AWidth, AHeight, AGraphic);
Inc(AHeight, AGraphic.Height);
end;
Inc(AWidth, AGraphic.Width);
end;
BitBlt(ACanvas.Handle, ARect.Left, ARect.Top, Bmp.Width, Bmp.Height,
Bmp.Canvas.Handle, 0, 0, SRCCOPY);
finally
Bmp.Free;
end;
end;
procedure JvWizardDrawImage(ACanvas: TCanvas; AGraphic: TGraphic; ARect: TRect;
Align: TJvWizardImageAlignment; ALayout: TJvWizardImageLayout);
var
Offset: TPoint;
AWidth, AHeight: Integer;
begin
if Assigned(AGraphic) then
begin
if ALayout = ilTile then
begin
JvWizardDrawTiled(ACanvas, AGraphic, ARect);
Exit;
end;
Offset := Point(0, 0);
AWidth := ARect.Right - ARect.Left;
AHeight := ARect.Bottom - ARect.Top;
if (Align in [iaCenter, iaRight]) and (AWidth > AGraphic.Width) then
begin
Offset.X := AWidth - AGraphic.Width;
if Align = iaCenter then
begin
Offset.X := Offset.X div 2;
ARect.Right := ARect.Right - Offset.X;
end;
end;
if (ALayout in [ilCenter, ilBottom]) and (AHeight > AGraphic.Height) then
begin
Offset.Y := AHeight - AGraphic.Height;
if ALayout = ilCenter then
begin
Offset.Y := Offset.Y div 2;
ARect.Bottom := ARect.Bottom - Offset.Y;
end;
end;
if (ALayout = ilTop) and (AHeight > AGraphic.Height) then
ARect.Bottom := ARect.Top + AGraphic.Height;
if (Align = iaLeft) and (AWidth > AGraphic.Width) then
ARect.Right := ARect.Left + AGraphic.Width;
ARect.Left := ARect.Left + Offset.X;
ARect.Top := ARect.Top + Offset.Y;
if (Align = iaStretch) or (ALayout = ilStretch) then
ACanvas.StretchDraw(ARect, AGraphic)
else
ACanvas.Draw(ARect.Left, ARect.Top, AGraphic);
end;
end;
end.

564
components/jvcllaz/run/JvWizard/jvwizardroutemaplist.pas Normal file
View File

@ -0,0 +1,564 @@
{-----------------------------------------------------------------------------
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):
Michał Gawrycki - Lazarus port (2019)
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org
Purpose:
Route map that displays pages as a list
History:
Known Issues:
-----------------------------------------------------------------------------}
// $Id$
unit JvWizardRouteMapList;
{$mode objfpc}
{$H+}
interface
uses
Types, SysUtils, Classes, Graphics, Controls, Forms, LMessages, LCLIntf, LCLType,
JvTypes, JvJVCLUtils, JvWizard;
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;
FHotTrackFontOptions: TJvTrackFontOptions;
FActiveFontOptions: TJvTrackFontOptions;
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);
procedure SetActiveFontOptions(const Value: TJvTrackFontOptions);
procedure SetHotTrackFontOptions(const Value: TJvTrackFontOptions);
function IsHotTrackFontStored: Boolean;
protected
procedure DrawPageItem(ACanvas: TCanvas; ARect: TRect; MousePos: TPoint; APageIndex: Integer); virtual;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
function PageAtPos(Pt: TPoint): TJvWizardCustomPage; override;
procedure Paint; override;
procedure Loaded; override;
procedure CMCursorChanged(var Msg: TLMessage); message CM_CURSORCHANGED;
procedure CMFontChanged(var Msg: TLMessage); message CM_FONTCHANGED;
procedure CursorChanged;
procedure FontChanged;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property ActiveFont: TFont read FActiveFont write SetActiveFont;
property ActiveFontOptions: TJvTrackFontOptions read FActiveFontOptions write SetActiveFontOptions default
DefaultTrackFontOptions;
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 stored IsHotTrackFontStored;
property HotTrackFontOptions: TJvTrackFontOptions read FHotTrackFontOptions write SetHotTrackFontOptions default
DefaultTrackFontOptions;
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;
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;
FActiveFontOptions := DefaultTrackFontOptions;
FHotTrackFontOptions := DefaultTrackFontOptions;
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; APageIndex: 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;
ACanvas.Font := Font;
if Assigned(Wizard) and (Pages[APageIndex] = Wizard.ActivePage) then
ACanvas.Font := ActiveFont
else
if PtInRect(ARect, MousePos) and Pages[APageIndex].Enabled and HotTrack and Clickable then
ACanvas.Font := HotTrackFont
else
if not Pages[APageIndex].Enabled then
ACanvas.Font.Color := clGrayText;
ACanvas.Brush.Color := ItemColor;
ACanvas.Pen.Color := Color;
DefaultDraw := True;
if Assigned(FOnDrawItem) then
FOnDrawItem(Self, ACanvas, ARect, MousePos, APageIndex, DefaultDraw);
if DefaultDraw then
begin
case ItemText of
itCaption:
S := Pages[APageIndex].Caption;
itTitle:
S := Pages[APageIndex].Title.Text;
itSubtitle:
S := Pages[APageIndex].Subtitle.Text;
end;
if not TextOnly then
begin
if ItemColor = clNone then
ACanvas.Brush.Style := bsClear;
if Rounded then
ACanvas.RoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, Curvature, Curvature)
else
ACanvas.Rectangle(ARect);
if ShowImages and Assigned(Wizard) and Assigned(Wizard.HeaderImages) then
begin
ATop := ((ARect.Bottom - ARect.Top) - Wizard.HeaderImages.Height) div 2;
BkColor := ACanvas.Brush.Color;
case Alignment of
taLeftJustify:
begin
Wizard.HeaderImages.Draw(ACanvas, ARect.Left + 4, ARect.Top + ATop, Pages[APageIndex].Header.ImageIndex, Pages[APageIndex].Enabled);
Inc(ARect.Left, Wizard.HeaderImages.Width + 4);
end;
taRightJustify:
begin
Wizard.HeaderImages.Draw(ACanvas, ARect.Right - Wizard.HeaderImages.Width - 4, ARect.Top + ATop,
Pages[APageIndex].Header.ImageIndex, Pages[APageIndex].Enabled);
Dec(ARect.Right, Wizard.HeaderImages.Width + 4);
end;
taCenter:
begin
ALeft := ((ARect.Right - ARect.Left) - Wizard.HeaderImages.Width) div 2;
Inc(ARect.Top, 4);
Wizard.HeaderImages.Draw(ACanvas, ARect.Left + ALeft, ARect.Top + 8,
Pages[APageIndex].Header.ImageIndex, Pages[APageIndex].Enabled);
Inc(ARect.Top, Wizard.HeaderImages.Height);
// if ItemText = itSubtitle then
// Inc(ARect.Top, 16);
end;
end;
if not Pages[APageIndex].Enabled then
begin
// (p3) TImageList changes the canvas colors when drawing disabled images, so we reset them explicitly
SetBkColor(ACanvas.Handle, BkColor);
SetTextColor(ACanvas.Handle, ColorToRGB(clGrayText));
end;
end;
end
else
ACanvas.Brush.Style := bsClear;
case Alignment of
taLeftJustify:
Inc(ARect.Left, TextOffset);
taRightJustify:
Dec(ARect.Right, TextOffset);
taCenter:
InflateRect(ARect, -TextOffset div 2, -TextOffset div 2);
end;
if ItemText = itSubtitle then
begin
Inc(ARect.Top, TextOffset);
InflateRect(ARect, -TextOffset, 0);
end;
if (ItemText <> itNone) and ((ARect.Bottom - ARect.Top) > abs(ACanvas.Font.Height)) then
DrawText(ACanvas.Handle, PChar(S), Length(S), ARect,
cAlignment[Alignment] or cWordWrap[ItemText = itSubtitle] or DT_VCENTER or DT_EDITCONTROL or {DT_EXTERNALLEADING or} DT_END_ELLIPSIS);
if not TextOnly and HotTrack and (HotTrackBorder > 0) and PtInRect(AOrigRect, MousePos) then
begin
ACanvas.Brush.Style := bsClear;
ACanvas.Pen.Color := HotTrackFont.Color;
ACanvas.Pen.Width := HotTrackBorder;
if Rounded then
ACanvas.RoundRect(AOrigRect.Left, AOrigRect.Top, AOrigRect.Right, AOrigRect.Bottom, Curvature, Curvature)
else
ACanvas.Rectangle(AOrigRect);
ACanvas.Brush.Style := bsSolid;
ACanvas.Pen.Width := 1;
end;
end;
finally
ACanvas.Unlock;
end;
end;
procedure TJvWizardRouteMapList.SetHorzOffset(const Value: Integer);
begin
if FHorzOffset <> Value then
begin
FHorzOffset := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapList.SetItemHeight(const Value: Integer);
begin
if FItemHeight <> Value then
begin
FItemHeight := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapList.SetVertOffset(const Value: Integer);
begin
if FVertOffset <> Value then
begin
FVertOffset := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapList.SetIncludeDisabled(const Value: Boolean);
begin
if FIncludeDisabled <> Value then
begin
FIncludeDisabled := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapList.SetActiveFont(const Value: TFont);
begin
FActiveFont.Assign(Value);
end;
procedure TJvWizardRouteMapList.SetHotTrackFont(const Value: TFont);
begin
FHotTrackFont.Assign(Value);
end;
procedure TJvWizardRouteMapList.DoFontChange(Sender: TObject);
begin
Invalidate;
end;
procedure TJvWizardRouteMapList.CMCursorChanged(var Msg: TLMessage);
begin
inherited;
CursorChanged;
end;
procedure TJvWizardRouteMapList.CMFontChanged(var Msg: TLMessage);
begin
inherited;
FontChanged;
end;
procedure TJvWizardRouteMapList.SetAlignment(const Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapList.SetTextOffset(const Value: Integer);
begin
if FTextOffset <> Value then
begin
FTextOffset := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapList.SetShowImages(const Value: Boolean);
begin
if FShowImages <> Value then
begin
FShowImages := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapList.SetItemColor(const Value: TColor);
begin
if FItemColor <> Value then
begin
FItemColor := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapList.SetRounded(const Value: Boolean);
begin
if FRounded <> Value then
begin
FRounded := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapList.SetItemText(const Value: TRouteMapListItemText);
begin
if FItemText <> Value then
begin
FItemText := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapList.SetCurvature(const Value: Integer);
begin
if FCurvature <> Value then
begin
FCurvature := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapList.SetActiveFontOptions(const Value: TJvTrackFontOptions);
begin
if FActiveFontOptions <> Value then
begin
FActiveFontOptions := Value;
UpdateTrackFont(ActiveFont, Font, FActiveFontOptions);
end;
end;
procedure TJvWizardRouteMapList.SetHotTrackFontOptions(const Value: TJvTrackFontOptions);
begin
if FHotTrackFontOptions <> Value then
begin
FHotTrackFontOptions := Value;
UpdateTrackFont(HotTrackFont, Font, FHotTrackFontOptions);
end;
end;
procedure TJvWizardRouteMapList.SetBorderColor(Value: TColor);
begin
if Value <> FBorderColor then
begin
FBorderColor := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapList.SetTextOnly(const Value: Boolean);
begin
if Value <> FTextOnly then
begin
FTextOnly := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapList.CursorChanged;
begin
if (Cursor <> FHotTrackCursor) and (Cursor <> FOldCursor) then
FOldCursor := Cursor;
end;
procedure TJvWizardRouteMapList.FontChanged;
begin
UpdateTrackFont(HotTrackFont, Font, FHotTrackFontOptions);
UpdateTrackFont(ActiveFont, Font, FActiveFontOptions);
end;
function TJvWizardRouteMapList.IsHotTrackFontStored: Boolean;
begin
Result := IsHotTrackFontDfmStored(HotTrackFont, Font, HotTrackFontOptions);
end;
end.

397
components/jvcllaz/run/JvWizard/jvwizardroutemapnodes.pas Normal file
View File

@ -0,0 +1,397 @@
{-----------------------------------------------------------------------------
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: JvWizardRouteMapNodes.PAS, released on 2002-02-05.
The Initial Developer of the Original Code is Steve Forbes.
Portions created by Steve Forbes are Copyright (C) 2002 Steve Forbes.
All Rights Reserved.
Contributor(s):
Peter Th�rnqvist - converted to JVCL naming conventions on 2003-07-11
S Steed. - added AllowClickableNodes property
Micha� Gawrycki - Lazarus port (2019)
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org
Description:
Nodes style route map for TJvWizardRouteMap
History:
10/14/2003
Added option to allow user to turn off the clicking of the nodes
during runtime. S Steed.
05/02/2002
Initial create
Known Issues:
-----------------------------------------------------------------------------}
// $Id$
unit JvWizardRouteMapNodes;
{$mode objfpc}
{$H+}
interface
uses
Graphics, Classes, LCLIntf, LCLType,
JvWizard;
type
TJvWizardRouteMapNodes = class;
TJvWizardRouteMapNodeColors = class(TPersistent)
private
FSelected: TColor;
FUnselected: TColor;
FDisabled: TColor;
FLine: TColor;
FRouteMap: TJvWizardRouteMapNodes;
protected
procedure SetLine(Value: TColor);
procedure SetSelected(Value: TColor);
procedure SetUnselected(Value: TColor);
procedure SetDisabled(Value: TColor);
procedure Changed;
public
constructor Create(ARouteMap: TJvWizardRouteMapNodes);
published
property Selected: TColor read FSelected write SetSelected default clLime;
property Unselected: TColor read FUnselected write SetUnselected default clWhite;
property Line: TColor read FLine write SetLine default clBtnShadow;
property Disabled: TColor read FDisabled write SetDisabled default clBtnFace;
end;
TJvWizardRouteMapNodes = class(TJvWizardRouteMapControl)
private
FItemHeight: Integer;
FUsePageTitle: Boolean;
FNodeColors: TJvWizardRouteMapNodeColors;
FIndent: Integer;
FAllowClickableNodes: Boolean;
procedure SetItemHeight(Value: Integer);
procedure SetUsePageTitle(Value: Boolean);
procedure SetIndent(Value: Integer);
procedure SetAllowClickableNodes(const Value: Boolean);
protected
function PageAtPos(Pt: TPoint): TJvWizardCustomPage; override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property ItemHeight: Integer read FItemHeight write SetItemHeight default 20;
property AllowClickableNodes: Boolean read FAllowClickableNodes write SetAllowClickableNodes default True; // ss 10/14/2003
property Align;
property Color default clBackground;
property Font;
property Image;
property Indent: Integer read FIndent write SetIndent default 8;
property NodeColors: TJvWizardRouteMapNodeColors read FNodeColors write FNodeColors;
property UsePageTitle: Boolean read FUsePageTitle write SetUsePageTitle default True;
property OnDisplaying;
end;
implementation
//=== { TJvWizardRouteMapNodeColors } ========================================
constructor TJvWizardRouteMapNodeColors.Create(ARouteMap: TJvWizardRouteMapNodes);
begin
inherited Create;
FRouteMap := ARouteMap;
FSelected := clLime;
FUnselected := clWhite;
FLine := clBtnShadow;
FDisabled := clBtnFace;
end;
procedure TJvWizardRouteMapNodeColors.Changed;
begin
if Assigned(FRouteMap) then
FRouteMap.Invalidate;
end;
procedure TJvWizardRouteMapNodeColors.SetDisabled(Value: TColor);
begin
if FDisabled <> Value then
begin
FDisabled := Value;
Changed;
end;
end;
procedure TJvWizardRouteMapNodeColors.SetLine(Value: TColor);
begin
if FLine <> Value then
begin
FLine := Value;
Changed;
end;
end;
procedure TJvWizardRouteMapNodeColors.SetSelected(Value: TColor);
begin
if FSelected <> Value then
begin
FSelected := Value;
Changed;
end;
end;
procedure TJvWizardRouteMapNodeColors.SetUnselected(Value: TColor);
begin
if FUnselected <> Value then
begin
FUnselected := Value;
Changed;
end;
end;
//=== { TJvWizardRouteMapNodes } =============================================
constructor TJvWizardRouteMapNodes.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FItemHeight := 20;
Color := clBackground;
Font.Color := clWhite;
FUsePageTitle := True;
FIndent := 8;
FAllowClickableNodes := True; // ss 10/14/2003
FNodeColors := TJvWizardRouteMapNodeColors.Create(Self);
end;
destructor TJvWizardRouteMapNodes.Destroy;
begin
FNodeColors.Free;
inherited Destroy;
end;
function TJvWizardRouteMapNodes.PageAtPos(Pt: TPoint): TJvWizardCustomPage;
var
I, Count: Integer;
ARect: TRect;
begin
if AllowClickableNodes then // ss 10/14/2003
begin
ARect := ClientRect;
InflateRect(ARect, -1, -1);
if PtInRect(ARect, Pt) then
begin
Count := PageCount;
ARect := Bounds(ARect.Left, ARect.Top + Trunc((FItemHeight - 12) / 2),
ARect.Right - ARect.Left, FItemHeight);
I := 0;
while I < Count do
begin
if CanDisplay(Pages[I]) then
begin
if PtInRect(ARect, Pt) then
begin
Result := Pages[I];
Exit;
end;
OffsetRect(ARect, 0, FItemHeight);
end;
Inc(I);
end;
end;
end;
Result := nil;
end;
procedure TJvWizardRouteMapNodes.Paint;
var
ARect, ATextRect, NodeRect: TRect;
I: Integer;
AColor: TColor;
AFont: TFont;
IsFirstPage, IsLastPage: Boolean;
begin
ARect := ClientRect;
with Canvas do
begin
Brush.Color := Color;
Brush.Style := bsSolid;
Pen.Color := clBtnShadow;
Pen.Width := 1;
Pen.Style := psSolid;
if not HasPicture then
Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom)
else
Image.PaintTo(Canvas, ARect);
InflateRect(ARect, -1, -1);
AFont := TFont.Create;
try
AFont.Assign(Self.Font);
ARect := Bounds(ARect.Left + FIndent, ARect.Top + FIndent,
ARect.Right - ARect.Left - FIndent, FItemHeight);
for I := 0 to PageCount - 1 do
begin
IsFirstPage := Wizard.IsFirstPage(Pages[I], not (csDesigning in ComponentState));
IsLastPage := Wizard.IsLastPage(Pages[I], not (csDesigning in ComponentState));
if CanDisplay(Pages[I]) then
begin
AColor := Color;
if I = PageIndex then
begin
AFont.Color := Self.Font.Color;
AFont.Style := AFont.Style + [fsBold]
end
else
if not Pages[I].Enabled then
begin
AFont.Color := clBtnShadow;
AFont.Style := AFont.Style - [fsBold];
end
else
if not Pages[I].EnableJumpToPage then // Nonn...
begin
AFont.Color := NodeColors.Disabled;
AFont.Style := AFont.Style - [fsBold]; // ... Nonn
end
else
begin
AFont.Color := Self.Font.Color;
AFont.Style := AFont.Style - [fsBold]
end;
ATextRect := ARect;
if not (IsFirstPage or IsLastPage) then
ATextRect.Left := ATextRect.Left + 18;
NodeRect := ATextRect;
NodeRect.Right := NodeRect.Left + 12;
NodeRect.Top := NodeRect.Top + Trunc((FItemHeight - 12) / 2);
NodeRect.Bottom := NodeRect.Top + 12;
if not (IsFirstPage or IsLastPage) then
ATextRect.Left := ATextRect.Left + 20
else
ATextRect.Left := ATextRect.Left + 18 + 20;
try
Pen.Color := FNodeColors.Line;
if I = PageIndex then
Brush.Color := FNodeColors.Selected
else
if not Pages[I].EnableJumpToPage then // Nonn
Brush.Color := FNodeColors.Disabled // Nonn
else
if Pages[I].Enabled then
Brush.Color := FNodeColors.Unselected
else
Brush.Color := FNodeColors.Disabled;
Rectangle(NodeRect.Left, NodeRect.Top, NodeRect.Right,
NodeRect.Bottom);
Brush.Color := FNodeColors.Line;
if IsFirstPage or IsLastPage then
begin
MoveTo(NodeRect.Right, NodeRect.Top + 5);
LineTo(NodeRect.Right + 13, NodeRect.Top + 5);
MoveTo(NodeRect.Right, NodeRect.Top + 6);
LineTo(NodeRect.Right + 13, NodeRect.Top + 6);
if IsFirstPage then
begin
MoveTo(NodeRect.Right + 11, NodeRect.Top + 6);
LineTo(NodeRect.Right + 11, ATextRect.Bottom);
MoveTo(NodeRect.Right + 12, NodeRect.Top + 6);
LineTo(NodeRect.Right + 12, ATextRect.Bottom);
end
else
begin
MoveTo(NodeRect.Right + 11, NodeRect.Top + 5);
LineTo(NodeRect.Right + 11, ATextRect.Top);
MoveTo(NodeRect.Right + 12, NodeRect.Top + 5);
LineTo(NodeRect.Right + 12, ATextRect.Top);
end;
end
else
begin
MoveTo(NodeRect.Left + 5, NodeRect.Top);
LineTo(NodeRect.Left + 5, ATextRect.Top - 1);
MoveTo(NodeRect.Left + 6, NodeRect.Top);
LineTo(NodeRect.Left + 6, ATextRect.Top - 1);
MoveTo(NodeRect.Left + 5, NodeRect.Bottom);
LineTo(NodeRect.Left + 5, ATextRect.Bottom + 1);
MoveTo(NodeRect.Left + 6, NodeRect.Bottom);
LineTo(NodeRect.Left + 6, ATextRect.Bottom + 1);
end;
Brush.Color := AColor;
if not HasPicture then
FillRect(ATextRect)
else
SetBkMode(Canvas.Handle, TRANSPARENT);
Brush.Style := bsClear;
Font.Assign(AFont);
if FUsePageTitle then
DrawText(Canvas.Handle,
PChar((Pages[I] as TJvWizardCustomPage).Header.Title.Text), -1,
ATextRect, DT_LEFT or DT_SINGLELINE or DT_VCENTER)
else
DrawText(Canvas.Handle, PChar(Pages[I].Caption), -1, ATextRect,
DT_LEFT or DT_SINGLELINE or DT_VCENTER);
finally
OffsetRect(ARect, 0, FItemHeight);
end;
end;
end;
finally
AFont.Free;
end;
end;
end;
procedure TJvWizardRouteMapNodes.SetItemHeight(Value: Integer);
begin
if FItemHeight <> Value then
begin
FItemHeight := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapNodes.SetUsePageTitle(Value: Boolean);
begin
if FUsePageTitle <> Value then
begin
FUsePageTitle := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapNodes.SetIndent(Value: Integer);
begin
if FIndent <> Value then
begin
FIndent := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapNodes.SetAllowClickableNodes(
const Value: Boolean);
begin
if FAllowClickableNodes <> Value then
begin
FAllowClickableNodes := Value;
Invalidate;
end;
end;
end.

459
components/jvcllaz/run/JvWizard/jvwizardroutemapsteps.pas Normal file
View File

@ -0,0 +1,459 @@
{-----------------------------------------------------------------------------
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: JvWizardRouteMapSteps.PAS, released on 2002-02-11.
The Initial Developer of the Original Code is Max Evans.
Portions created by Max Evans are Copyright (C) 2002 Max Evans
Contributor(s):
Michał Gawrycki - Lazarus port (2019)
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org
Purpose:
Step style route map for TJvWizardRouteMap
History:
Known Issues:
-----------------------------------------------------------------------------}
// $Id$
unit JvWizardRouteMapSteps;
{$mode objfpc}
{$H+}
interface
uses
Types, SysUtils, Classes, Graphics, Controls, Forms, LCLIntf, LCLType,
JvWizard;
type
TJvWizardRouteMapSteps = class(TJvWizardRouteMapControl)
private
FIndent: Integer;
FNextStepText: string;
FActiveStepFormat: string;
FPreviousStepText: string;
FShowDivider: Boolean;
FShowNavigators: Boolean;
FShowNavigation: Boolean;
FMultiline: Boolean;
function GetActiveStepRect: TRect;
function GetPreviousStepRect: TRect;
function GetNextStepRect: TRect;
function GetPreviousArrowRect: TRect;
function GetNextArrowRect: TRect;
procedure SetIndent(const Value: Integer);
procedure SetNextStepText(const Value: string);
procedure SetActiveStepFormat(const Value: string);
procedure SetPreviousStepText(const Value: string);
procedure SetShowDivider(const Value: Boolean);
procedure SetShowNavigators(const Value: Boolean);
function DetectPageCount(var ActivePageIndex: Integer): Integer; // Add by Yu Wei
function DetectPage(const Pt: TPoint): TJvWizardCustomPage; // Add by Yu Wei
function StoreActiveStepFormat: Boolean;
function StoreNextStepText: Boolean;
function StorePreviousStepText: Boolean;
procedure SetShowNavigation(const Value: Boolean);
procedure SetMultiline(const Value: Boolean);
protected
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
function PageAtPos(Pt: TPoint): TJvWizardCustomPage; override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
property Color default clBackground;
property Font;
property Image;
property Indent: Integer read FIndent write SetIndent default 5;
property PreviousStepText: string read FPreviousStepText write SetPreviousStepText stored StorePreviousStepText;
property ActiveStepFormat: string read FActiveStepFormat write SetActiveStepFormat stored StoreActiveStepFormat;
property Multiline: Boolean read FMultiline write SetMultiline default False;
property NextStepText: string read FNextStepText write SetNextStepText stored StoreNextStepText;
property ShowDivider: Boolean read FShowDivider write SetShowDivider default True;
property ShowNavigators: Boolean read FShowNavigators write SetShowNavigators default True;
property ShowNavigation: Boolean read FShowNavigation write SetShowNavigation default True;
end;
implementation
uses
JvResources;
constructor TJvWizardRouteMapSteps.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIndent := 5;
Color := clBackground;
Font.Color := clWhite;
FPreviousStepText := RsBackTo;
FActiveStepFormat := RsActiveStepFormat;
FNextStepText := RsNextStep;
FShowDivider := True;
FShowNavigators := True;
FShowNavigation := True;
end;
function TJvWizardRouteMapSteps.DetectPage(const Pt: TPoint): TJvWizardCustomPage;
begin
if FShowNavigators then
begin
// Ignore all disabled pages at run time.
if PtInRect(GetPreviousArrowRect, Pt) then
begin
if (PageIndex < Wizard.PageCount) and (PageIndex > 0) and
not ((csDesigning in ComponentState) or (bkBack in Wizard.WizardPages[PageIndex].EnabledButtons)) then
Result := nil
else
Result := Wizard.FindNextPage(PageIndex, -1, not (csDesigning in ComponentState));
end
else
if PtInRect(GetNextArrowRect, Pt) then
begin
if (PageIndex < Wizard.PageCount) and (PageIndex > 0) and
not ((csDesigning in ComponentState) or (bkNext in Wizard.WizardPages[PageIndex].EnabledButtons)) then
Result := nil
else
Result := Wizard.FindNextPage(PageIndex, 1, not (csDesigning in ComponentState));
end
else
Result := nil;
end
else
begin
Result := nil;
end;
end;
function TJvWizardRouteMapSteps.GetActiveStepRect: TRect;
begin
Result := Rect(Left + FIndent, (ClientHeight div 2 - Canvas.TextHeight('Wq')),
Width, ClientHeight div 2);
end;
function TJvWizardRouteMapSteps.GetNextArrowRect: TRect;
begin
Result := Rect(Left + FIndent, Height - Indent - 32, Left + FIndent + 16,
(Height - FIndent) - 16);
end;
function TJvWizardRouteMapSteps.GetNextStepRect: TRect;
begin
Result := Rect(Left + FIndent, Height - FIndent - 32, Width,
Height - FIndent - 32 + Canvas.TextHeight('Wq'));
end;
function TJvWizardRouteMapSteps.DetectPageCount(var ActivePageIndex: Integer): Integer;
var
I: Integer;
begin
// Ignore all disabled pages at run time.
ActivePageIndex := 0;
Result := 0;
for I := 0 to PageCount - 1 do
begin
if (csDesigning in ComponentState) or Pages[I].Enabled then
begin
if I <= PageIndex then
Inc(ActivePageIndex);
Inc(Result);
end;
end;
end;
function TJvWizardRouteMapSteps.GetPreviousArrowRect: TRect;
begin
Result := Rect(Left + FIndent, Top + FIndent, Left + FIndent + 16,
Top + FIndent + 16);
end;
function TJvWizardRouteMapSteps.GetPreviousStepRect: TRect;
begin
Result := Rect(Left + FIndent, Top + FIndent, Width,
Top + FIndent + Canvas.TextHeight('Wq'));
end;
procedure TJvWizardRouteMapSteps.MouseMove(Shift: TShiftState; X, Y: Integer);
var
Pt: TPoint;
APage: TJvWizardCustomPage;
begin
inherited MouseMove(Shift, X, Y);
if ShowNavigators and not (csDesigning in ComponentState) then
begin
Pt := Point(X, Y);
if PtInRect(ClientRect, Pt) then
begin
APage := DetectPage(Pt);
if Assigned(APage) then
Screen.Cursor := crHandPoint
else
Screen.Cursor := crDefault;
end
else
if Screen.Cursor = crHandPoint then
Screen.Cursor := crDefault;
end;
end;
function TJvWizardRouteMapSteps.PageAtPos(Pt: TPoint): TJvWizardCustomPage;
begin
Result := DetectPage(Pt);
end;
procedure TJvWizardRouteMapSteps.Paint;
var
LRect, TextRect, ArrowRect, DividerRect: TRect;
ActivePageIndex, TotalPageCount: Integer;
StepHeight: Integer;
APage: TJvWizardCustomPage;
S: string;
LDrawProperties: Cardinal;
begin
LRect := ClientRect;
TotalPageCount := DetectPageCount(ActivePageIndex);
Canvas.Brush.Color := Color;
if HasPicture then
Image.PaintTo(Canvas, LRect);
TextRect := GetActiveStepRect;
LRect := TextRect; //Rect(TextRect.TopLeft, TextRect.BottomRight);
Canvas.Font.Assign(Font);
Canvas.Font.Style := [fsBold];
Canvas.Brush.Style := bsClear;
if Multiline then
begin
S := Pages[PageIndex].Caption;
Canvas.Font.Style := [];
StepHeight := DrawText(Canvas.Handle, PChar(S), Length(S), TextRect,
DT_CALCRECT or DT_LEFT or DT_WORDBREAK);
TextRect.Right := LRect.Right;
OffsetRect(TextRect, 0, Round((-0.5) * StepHeight + Canvas.TextHeight('Wq')));
end;
Canvas.Font.Style := [fsBold];
S := Format(ActiveStepFormat, [ActivePageIndex, TotalPageCount]);
if Multiline then
begin
LDrawProperties := DT_LEFT or DT_WORDBREAK;
end
else
begin
LDrawProperties := DT_LEFT or DT_SINGLELINE or DT_END_ELLIPSIS or DT_VCENTER;
end;
StepHeight := DrawText(Canvas.Handle, PChar(S), Length(S), TextRect,
LDrawProperties);
// Display Active Page Description
Canvas.Font.Style := [];
OffsetRect(TextRect, 0, StepHeight);
S := Pages[PageIndex].Caption;
if Multiline then
begin
LDrawProperties := DT_LEFT or DT_WORDBREAK;
end
else
begin
LDrawProperties := DT_LEFT or DT_SINGLELINE or DT_END_ELLIPSIS or DT_VCENTER;
end;
DrawText(Canvas.Handle, PChar(S), Length(S), TextRect, LDrawProperties);
Canvas.Font.Style := [];
if Self.ShowDivider then
begin
SetRect(DividerRect, Left + Indent, TextRect.Bottom + 5, Width - Indent,
TextRect.Bottom + 6);
DrawEdge(Canvas.Handle, DividerRect, EDGE_RAISED, BF_FLAT or BF_BOTTOM);
end;
{ do the previous step }
// YW - Ignore all disabled pages at run time
APage := Wizard.FindNextPage(PageIndex, -1, not (csDesigning in ComponentState));
if Assigned(APage) and (PageIndex <> -1) and ShowNavigation then
begin
TextRect := GetPreviousStepRect;
ArrowRect := GetPreviousArrowRect;
Canvas.Font.Style := [];
if ShowNavigators then
begin
if TextRect.Left + Indent + ArrowRect.Right - ArrowRect.Left < Width then
OffsetRect(TextRect, ArrowRect.Right, 0);
if (csDesigning in ComponentState) or (bkBack in Wizard.WizardPages[PageIndex].EnabledButtons) then
DrawFrameControl(Canvas.Handle, ArrowRect, DFC_SCROLL,
DFCS_SCROLLLEFT or DFCS_FLAT);
end;
S := PreviousStepText;
StepHeight := DrawText(Canvas.Handle, PChar(S), Length(S), TextRect,
DT_LEFT or DT_WORDBREAK or DT_END_ELLIPSIS);
OffsetRect(TextRect, 0, StepHeight);
S := APage.Caption;
if Multiline then
begin
DrawText(Canvas.Handle, PChar(S), Length(S), TextRect,
DT_CALCRECT or DT_LEFT or DT_WORDBREAK);
TextRect.Right := LRect.Right;
LDrawProperties := DT_LEFT or DT_WORDBREAK;
end
else
begin
LDrawProperties := DT_SINGLELINE or DT_LEFT or DT_END_ELLIPSIS or DT_VCENTER;
end;
DrawText(Canvas.Handle, PChar(S), Length(S), TextRect, LDrawProperties);
end;
{ do the next step }
// YW - Ignore all disabled pages at run time
APage := Wizard.FindNextPage(PageIndex, 1, not (csDesigning in ComponentState));
if Assigned(APage) and (PageIndex <> -1) and ShowNavigation then
begin
TextRect := GetNextStepRect;
ArrowRect := GetNextArrowRect;
Canvas.Font.Style := [];
if ShowNavigators then
begin
OffsetRect(TextRect, ArrowRect.Right, 0);
if (csDesigning in ComponentState) or (bkNext in Wizard.WizardPages[PageIndex].EnabledButtons) then
DrawFrameControl(Canvas.Handle, ArrowRect, DFC_SCROLL,
DFCS_SCROLLRIGHT or DFCS_FLAT);
end;
if Multiline then
begin
S := APage.Caption;
StepHeight := DrawText(Canvas.Handle, PChar(S), Length(S), TextRect,
DT_CALCRECT or DT_LEFT or DT_WORDBREAK);
TextRect.Right := LRect.Right;
OffsetRect(TextRect, 0, (-1) * StepHeight + Canvas.TextHeight('Wq'));
end;
S := NextStepText;
StepHeight := DrawText(Canvas.Handle, PChar(S), Length(S), TextRect,
DT_LEFT or DT_WORDBREAK);
OffsetRect(TextRect, 0, StepHeight);
S := APage.Caption;
if Multiline then
begin
DrawText(Canvas.Handle, PChar(S), Length(S), TextRect,
DT_CALCRECT or DT_LEFT or DT_WORDBREAK);
TextRect.Right := LRect.Right;
LDrawProperties := DT_LEFT or DT_WORDBREAK;
end
else
begin
LDrawProperties := DT_SINGLELINE or DT_LEFT or DT_END_ELLIPSIS or DT_VCENTER;
end;
DrawText(Canvas.Handle, PChar(S), Length(S), TextRect, LDrawProperties);
end;
end;
procedure TJvWizardRouteMapSteps.SetShowDivider(const Value: Boolean);
begin
if FShowDivider <> Value then
begin
FShowDivider := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapSteps.SetIndent(const Value: Integer);
begin
if FIndent <> Value then
begin
FIndent := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapSteps.SetMultiline(const Value: Boolean);
begin
if FMultiline <> Value then
begin
FMultiline := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapSteps.SetNextStepText(const Value: string);
begin
if FNextStepText <> Value then
begin
FNextStepText := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapSteps.SetActiveStepFormat(const Value: string);
begin
if FActiveStepFormat <> Value then
begin
FActiveStepFormat := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapSteps.SetPreviousStepText(const Value: string);
begin
if FPreviousStepText <> Value then
begin
FPreviousStepText := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapSteps.SetShowNavigators(const Value: Boolean);
begin
if FShowNavigators <> Value then
begin
if Screen.Cursor = crHandPoint then
Screen.Cursor := crDefault;
FShowNavigators := Value;
Invalidate;
end;
end;
procedure TJvWizardRouteMapSteps.SetShowNavigation(const Value: Boolean);
begin
if Value <> FShowNavigation then
begin
FShowNavigation := Value;
Invalidate;
end;
end;
function TJvWizardRouteMapSteps.StoreActiveStepFormat: Boolean;
begin
Result := ActiveStepFormat <> RsActiveStepFormat;
end;
function TJvWizardRouteMapSteps.StoreNextStepText: Boolean;
begin
Result := NextStepText <> RsNextStep;
end;
function TJvWizardRouteMapSteps.StorePreviousStepText: Boolean;
begin
Result := PreviousStepText <> RsBackTo;
end;
end.