Menu
▾
▴
[JVCL-Checkins] CVS: dev/JVCL3/examples/JvLinkLabel CategCh.pas,NONE,1.1 InfoStrings.pas,NONE,1.1 JvLinkLabelDemo.dof,NONE,1.1 JvLinkLabelDemo.dpr,NONE,1.1 JvLinkLabelDemo.res,NONE,1.1 JvLinkLabelMainFormU.dfm,NONE,1.1 JvLinkLabelMainFormU.pas,NONE,1.1 Play.dfm,NONE,1.1 Play.pas,NONE,1.1
|
From: Peter T. <pe...@us...> - 2003-08-24 01:08:23
|
Update of /cvsroot/jvcl/dev/JVCL3/examples/JvLinkLabel
In directory sc8-pr-cvs1:/tmp/cvs-serv4702/JVCL3/examples/JvLinkLabel
Added Files:
CategCh.pas InfoStrings.pas JvLinkLabelDemo.dof
JvLinkLabelDemo.dpr JvLinkLabelDemo.res
JvLinkLabelMainFormU.dfm JvLinkLabelMainFormU.pas Play.dfm
Play.pas
Log Message:
- Copied jvcl/devtools and jvcl/examples dev/JVCL3
- Copied JVCLConvert *.dat files to dev/JVCL3/converter
--- NEW FILE: CategCh.pas ---
{-----------------------------------------------------------------------------
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/
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: CategCh.pas, released 2002-01-06.
The Initial Developer of the Original Code is David Polberger <dp...@sw...>
Portions created by David Polberger are Copyright (C) 2002 David Polberger.
All Rights Reserved.
Contributor(s): ______________________________________.
Last Modified: 2002-01-06;
Current Version: 1.00
You may retrieve the latest version of this file at the Project JEDI home page,
located at http://www.delphi-jedi.org
Known Issues:
None.
Description:
TCategoryChooser displays an attractive list of categories that users can
choose from. TJvLinkLabel's demo project makes use of this component, by
creating instances of it at run-time.
It is not intended to be a part of the JEDI VCL, as it does one specific thing
well, but not much else. Having said that, it's licened under the MPL license,
just like TJvLinkLabel, so you're free to use it in your own projects, if you
like. Simply add it to the package of your choice, and install it into the
IDE.
-----------------------------------------------------------------------------}
unit CategCh;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TJvCategoryChooser = class(TGraphicControl)
private
FCatList: TStringList;
FBackgroundColor: TColor;
FActiveColor: TColor;
FCatHeight: Integer;
FActiveCat: Integer;
FSelectedCat: Integer;
FLastOutOfBounds: Boolean;
FCatChange: TNotifyEvent;
procedure SetCatList(const Value: TStringList);
function GetLineColor: TColor;
procedure SetLineColor(const Value: TColor);
function IsCursorWithinBounds: Boolean;
procedure DrawCat(Index: Integer; Color: TColor);
function GetCatAtPos(Y: Integer) : Integer;
procedure MouseLeave;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure SetBackgroundColor(const Value: TColor);
procedure SetActiveColor(const Value: TColor);
procedure SetCatHeight(const Value: Integer);
procedure SetSelectedCat(const Value: Integer);
function GetFont: TFont;
procedure SetFont(const Value: TFont);
protected
procedure Paint; override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure DoCatChange; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property ActiveCat: Integer read FActiveCat;
published
property CatList: TStringList read FCatList write SetCatList;
property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor;
property ActiveColor: TColor read FActiveColor write SetActiveColor;
property LineColor: TColor read GetLineColor write SetLineColor;
property Font: TFont read GetFont write SetFont;
property CatHeight: Integer read FCatHeight write SetCatHeight;
property SelectedCat: Integer read FSelectedCat write SetSelectedCat;
property OnCatChange: TNotifyEvent read FCatChange write FCatChange;
end;
implementation
{ TJvCategoryChooser }
procedure TJvCategoryChooser.CMMouseLeave(var Message: TMessage);
begin
inherited;
MouseLeave;
end;
constructor TJvCategoryChooser.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCatList := TStringList.Create;
// Set default values
FBackgroundColor := $00F0CAA6;
FActiveColor := clWhite;
FCatHeight := 24;
FSelectedCat := 0;
FLastOutOfBounds := False;
Canvas.Font.Name := 'Arial';
Canvas.Font.Style := [fsBold];
Canvas.Font.Size := 8;
Canvas.Font.Color := clWindowText;
Width := 100;
Height := 200;
end;
function TJvCategoryChooser.IsCursorWithinBounds: Boolean;
var
P: TPoint;
begin
P := ScreenToClient(Mouse.CursorPos);
Result :=
(P.X >= 0) and (P.X <= Width) and
(P.Y >= 0) and (P.Y <= FCatList.Count * FCatHeight - 1);
end;
destructor TJvCategoryChooser.Destroy;
begin
inherited Destroy;
FCatList.Free;
end;
procedure TJvCategoryChooser.DoCatChange;
begin
if Assigned(FCatChange) then
FCatChange(Self);
end;
procedure TJvCategoryChooser.DrawCat(Index: Integer; Color: TColor);
function ValueToAddToTop: Integer;
begin
{ The first category does not have a line drawn at the top; thus we fill
the entire rectangle in this case. }
if Index = 0 then
Result := 0
else
Result := 1;
end;
begin
if (Index >= 0) and (Index < FCatList.Count) then
with Canvas do
begin
Brush.Color := Color;
FillRect(Rect(0, Index * FCatHeight + ValueToAddToTop, Width,
(Index + 1) * FCatHeight));
TextOut(8, (FCatHeight div 2 - (Abs(Font.Height) div 2)) +
Index * FCatHeight - 2, FCatList[Index]);
MoveTo(0, (Index + 1) * FCatHeight);
LineTo(Width + 1, (Index + 1) * FCatHeight);
end;
end;
function TJvCategoryChooser.GetCatAtPos(Y: Integer): Integer;
begin
Result := Y div FCatHeight;
if Result >= FCatList.Count then
Result := -1;
end;
function TJvCategoryChooser.GetFont: TFont;
begin
Result := Canvas.Font;
end;
function TJvCategoryChooser.GetLineColor: TColor;
begin
Result := Canvas.Pen.Color;
end;
procedure TJvCategoryChooser.MouseLeave;
begin
DrawCat(FActiveCat, FBackgroundColor);
FActiveCat := FSelectedCat;
DrawCat(FActiveCat, FActiveColor);
end;
procedure TJvCategoryChooser.MouseMove(Shift: TShiftState; X, Y: Integer);
var
CatIndex: Integer;
begin
inherited MouseMove(Shift, X, Y);
if IsCursorWithinBounds then
Cursor := crHandPoint
else
Cursor := crDefault;
CatIndex := GetCatAtPos(Y);
if CatIndex <> FActiveCat then
if IsCursorWithinBounds then
begin
// Let's remove the highlight from the last active category
DrawCat(FActiveCat, FBackgroundColor);
FActiveCat := CatIndex;
DrawCat(FActiveCat, FActiveColor);
end else
if not FLastOutOfBounds then MouseLeave;
FLastOutOfBounds := not IsCursorWithinBounds;
end;
procedure TJvCategoryChooser.MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
OldSelectedCat: Integer;
begin
inherited MouseUp(Button, Shift, X, Y);
if GetCatAtPos(Y) <> -1 then
begin
OldSelectedCat := FSelectedCat;
FSelectedCat := GetCatAtPos(Y);
if OldSelectedCat <> FSelectedCat then
DoCatChange;
end;
end;
procedure TJvCategoryChooser.Paint;
var
I: Integer;
function GetColor: TColor;
begin
if I = FActiveCat then
Result := FActiveColor
else
Result := FBackgroundColor;
end;
begin
inherited Paint;
with Canvas do
begin
Brush.Color := FBackgroundColor;
FillRect(Rect(0, 0, Width, Height));
for I := 0 to FCatList.Count - 1 do
DrawCat(I, GetColor);
end;
end;
procedure TJvCategoryChooser.SetActiveColor(const Value: TColor);
begin
FActiveColor := Value;
Paint;
end;
procedure TJvCategoryChooser.SetBackgroundColor(const Value: TColor);
begin
FBackgroundColor := Value;
Paint;
end;
procedure TJvCategoryChooser.SetCatHeight(const Value: Integer);
begin
FCatHeight := Value;
Paint;
end;
procedure TJvCategoryChooser.SetCatList(const Value: TStringList);
begin
FCatList.Assign(Value);
Paint;
end;
procedure TJvCategoryChooser.SetFont(const Value: TFont);
begin
Canvas.Font.Assign(Value);
end;
procedure TJvCategoryChooser.SetLineColor(const Value: TColor);
begin
Canvas.Pen.Color := Value;
end;
procedure TJvCategoryChooser.SetSelectedCat(const Value: Integer);
begin
FSelectedCat := Value;
FActiveCat := Value;
DoCatChange;
Paint;
end;
end.
--- NEW FILE: InfoStrings.pas ---
{-----------------------------------------------------------------------------
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/
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: InfoStrings.pas, released 2002-01-05.
The Initial Developer of the Original Code is David Polberger <dp...@sw...>
Portions created by David Polberger are Copyright (C) 2002 David Polberger.
All Rights Reserved.
Contributor(s): ______________________________________.
Last Modified: 2002-01-05;
Current Version: 1.00
You may retrieve the latest version of this file at the Project JEDI home page,
located at http://www.delphi-jedi.org
Known Issues:
Please see the accompanying documentation.
-----------------------------------------------------------------------------}
unit InfoStrings;
interface
const
NmrOfScreens = 8;
Headings: array[0..NmrOfScreens - 1] of string =
('Introduction',
'Formatting text',
'Supported tags',
'Handling links',
'Dynamic tags',
'Play!',
'Source code',
'Read more');
Info: array[0..NmrOfScreens - 1] of string =
(// Introduction
'Welcome to <b>TJvLinkLabel!</b> Have you ever wanted to include ' +
'formatted text and links that flow with the rest of the text in your ' +
'applications? TJvLinkLabel is a fast, light-weight replacement for ' +
'Delphi''s TLabel, that handles all this. In fact, the text you''re ' +
'reading right now, is displayed by the TJvLinkLabel.' +
'<p>' +
'TJvLinkLabel is licensed under the <link>MPL</link> license, which ' +
'basically means that if you alter the component and distribute an ' +
'application incorporating it, you must make your changes to the ' +
'component public. Note, though, that this doesn''t affect your ' +
'application. Thus, you can safely use TJvLinkLabel in applications ' +
'whose source code you want to remain private.' +
'<p>' +
'Have you seen the source code of a HTML document? This component uses ' +
'the same technique to format text. <link>Read on</link> to find out ' +
'more!',
// Formatting text
'We''ll start off with an example:' +
'<p>' +
'This text is <b><b></b>bold, and <b><i></b>italic' +
'<b></i></b>, and includes<b></b></b> a <b><link></b>' +
'link<b></link></b>!' +
'<p>' +
'Simply enter this text in the Caption property of the TJvLinkLabel, ' +
'just as you usually do with the TLabel component. The result looks ' +
'something like this:' +
'<p>' +
'This text is <b>bold, and <i>italic</i>, and includes</b> a ' +
'<link>link</link>!' +
'<p>' +
'For example, to start a section to be displayed as <b>bold text</b>, ' +
'you''ll need to insert a "tag", in this case <b><b></b>. End the ' +
'bold section with <b></b></b>.' +
'<p>' +
'For a full listing of supported tags, <link>go on to the next ' +
'page!</link>',
// Supported tags
'<b>Basic text formatting</b><br>' +
'<b><b></b> - <b>Bold text</b><br>' +
'<b><i></b> - <i>Italic text</i><br>' +
'<b><u></b> - <u>Underlined text</u><br>' +
'<b><color=[TCOLOR]></b> - <color=clBlue>Font Color</color>' +
'<p>' +
'<b>Line and paragraph breaks</b><br>' +
'<b><br></b> - Line break (no end tag)<br>' +
'<b><p></b> - Paragraph break (no end tag)' +
'<p>' +
'<b>Special features</b><br>' +
'<b><link></b> - <link>Hypertext links</link><br>' +
'<b><dynamic></b> - Text whose contents change ' +
'<link>dynamically</link> (no end tag)',
// Handling links
'What happens when a user clicks a link? The <i>OnLinkClick</i> event ' +
'handler fires, making it easy for you to perform any action you want. ' +
'You may, for instance, open the user''s web browser, displaying a web ' +
'page, or you can bring up a dialog window in your application, or ' +
'something entirely different.' +
'<p>' +
'The <i>LinkNumber</i> parameter tells you which link the user ' +
'clicked, while the <i>LinkText</i> tells you the contents of the ' +
'link (with any tags removed).',
// Dynamic tags
'<i>Dynamic content</i> is used for content which may not be known when ' +
'you design the form, or content that changes during the course of ' +
'time, such as a label reporting memory usage. While you could simply ' +
'assign a new string to the <i>Caption</i> property, you''d have to ' +
'store the information both in the form file, and in the code itself ' +
'(or only the latter). To add insult to injury, the entire string would ' +
'have to be reparsed, negatively impacting performance. Also, this ' +
'solution is awkward at best, and hard to maintain.' +
'<p>' +
'Enter dynamic tags. Specify which content changes dynamically by ' +
'replacing the text itself with <b><dynamic></b>. You''ll need to ' +
'handle the <i>OnDynamicTagInit</i> event, to give these tags default ' +
'values. At run-time, simply call <i>FMyLinkLabel.UpdateDynamicTag</i> ' +
'to update the contents of the dynamic tag at will!',
// Play!
'<link>Click here</link> to open a separate window, where you can test ' +
'the TJvLinkLabel interactively! Feel free to edit the text in the edit ' +
'box (or replace it completely), to see how TJvLinkLabel renders your ' +
'input. On the right, you''ll see a tree representation of the contents ' +
'of the edit box.' +
'<p>' +
'<b>Note:</b> I believe that the text in the separate window is used in ' +
'various desktop publishing products as placeholder text - this copy ' +
'was found on the Internet. As I don''t speak Latin, I have no idea ' +
'what it means, if anything.',
// Source code
'I believe that TJvLinkLabel''s source code is clearly written and easy ' +
'to follow. Feel free to contribute!' +
'<p>' +
'TJvLinkLabel consists primarily of the component itself, a parser ' +
'which tries to make sense of the contents of the <i>Caption</i> ' +
'property and returns a tree representation of this data, and a ' +
'renderer, which renders the output to your screen. Thanks to ' +
'interfaces, you can easily replace either of these two components, ' +
'provided that your class implements the same interfaces that the ' +
'default parser and renderer are required to. The renderer should also ' +
'be quite easy to extend, with your own tags.' +
'<p>' +
'Please read the <link>full documentation</link> for pointers on ' +
'features I''d like to see implemented in the future, and any bugs ' +
'which I would love to see squashed. You''ll also find comments ' +
'pertaining to areas where performance could be improved, and areas of ' +
'the code that could be more modular. In short, if you''d like to hack ' +
'the code, see this document for useful tips!',
// Read more
'At this time, the documentation is maintained as a standard text file, ' +
'although we plan to provide it either as XHTML/CSS or as a help file ' +
'in the future. Look for it in the TJvLinkLabel directory!' +
'<p>' +
'Thanks for using TJvLinkLabel!' +
'<p>' +
'<i>David Polberger<br>' +
'Author</i>');
Lorem =
'<b>Lorem ipsum dolor <i>sit</i> amet,</b> consectetuer adipiscing elit, ' +
'sed diam nonummy nibh euismod <link>t<b>i<i>n</i>c</b>i<i>d</i>u<b>n</b>' +
't <b>ut</b> laoreet</link> dolore magna aliquam erat volutpat. Ut wisi ' +
'enim ad minim veniam,quis nostrud exerci tation ullamcorper suscipit ' +
'lobortis nisl ut aliquip ex ea commodo consequat. Duis autem vel eum ' +
'<b>iriure</b> dolor in hendrerit in vulputate velit esse molestie ' +
'consequat, vel illum dolore eu feugiat nulla facilisis at vero eros et ' +
'<link>accumsan et iusto odio <i>dignissim qui <u>blandit praesent ' +
'luptatum</u> zzril delenit augue duis dolore te feugait nulla facilisi. ' +
'Lorem ipsum dolor</i> sit</link> amet, consectetuer adipiscing elit, ' +
'sed diam nonummy nibh euismod tincidunt ut laoreet dolore magna aliquam ' +
'erat volutpat. <color=clTeal>Ut wisi enim ad <i>minim veniam, quis nostrud exerci ' +
'tation ullamcorper suscipit lobortis nisl </i>ut aliquip ex ea commodo ' +
'consequat.</color>' +
'<p>' +
'Duis autem vel eum iriure dolor in hendrerit in vulputate velit esse ' +
'molestie consequat, vel <i>illum</i> dolore eu feugiat nulla facilisis ' +
'at vero eros et accumsan et iusto odio dignissim qui blandit praesent ' +
'luptatum zzril delenit <b>augue duis</b> dolore te feugait nulla ' +
'facilisi. Nam liber tempor cum soluta nobis eleifend option congue ' +
'nihil imperdiet doming <link>id quod mazim</link> placerat facer possim ' +
'assum.'{ +
'<p>' +
'Lorem ipsum <i>dolor sit</i> amet, consectetuer adipiscing elit, sed diam ' +
'nonummy nibh euismod tincidunt ut laoreet dolore magna aliquam erat ' +
'volutpat. Ut wisi enim <b>ad</b> minim veniam, quis nostrud exerci tation ' +
'ullamcorper suscipit lobortis nisl ut aliquip ex ea commodo consequat. ' +
'Duis autem vel eum iriure dolor in hendrerit in vulputate velit esse ' +
'molestie consequat, vel <link>illum dolore <u>eu</u> feugiat nulla ' +
'facilisis at vero eros et </link>accumsan et iusto odio dignissim qui ' +
'blandit praesent luptatum zzril delenit augue duis <b>dolore te ' +
'feugait</b> nulla facilisi. Lorem ipsum dolor sit amet, consectetuer ' +
'adipiscing elit, sed diam nonummy nibh euismod tincidunt ut <link>' +
'laoreet dolore</link> magna aliquam erat volutpat.' +
'<p>' +
'<b>Ut wisi enim</b> ad minim veniam, quis nostrud exerci <link>tation ' +
'ullamcorper suscipit</link> lobortis nisl ut aliquip ex ea commodo ' +
'consequat. Duis autem vel eum iriure dolor in hendrerit in vulputate ' +
'velit esse molestie consequat, vel <b>illum <i>dolore eu <u>feugiat ' +
'nulla </u>facilisis at vero eros et accumsan et iusto</i> odio ' +
'dignissim</b> qui blandit praesent luptatum zzril delenit augue duis ' +
'dolore te feugait nulla facilisi. Lorem ipsum dolor sit amet, ' +
'consectetuer adipiscing elit, <link>sed diam <i>nonummy </i></link>' +
'nibh euismod tincidunt ut laoreet dolore magna aliquam erat volutpat.' +
'<p>' +
'Ut wisi enim ad minim veniam, quis nostrud exerci tation ullamcorper ' +
'suscipit lobortis nisl ut aliquip ex ea commodo consequat. Duis autem ' +
'vel eum iriure <b>dolor in</b> hendrerit <link>in vulputate <i>velit' +
'</i></link> esse molestie consequat, vel illum dolore eu feugiat nulla ' +
'facilisis at vero eros et accumsan et iusto odio dignissim <b>qui ' +
'blandit</b> praesent luptatum zzril delenit augue duis dolore te ' +
'feugait nulla facilisi. ' +
'<p>' +
'Lorem ipsum dolor sit amet, consectetuer adipiscing elit, sed diam ' +
'nonummy nibh euismod <u>tincidunt</u> ut laoreet dolore magna aliquam ' +
'erat volutpat. Ut wisi enim ad minim veniam, quis nostrud exerci tation ' +
'ullamcorper <link>suscipit lobortis</link> nisl ut aliquip ex ea ' +
'commodo consequat. Duis autem vel eum iriure dolor in hendrerit in ' +
'vulputate velit esse molestie consequat, vel illum <i>dolore eu <b>' +
'feugiat</b></i> nulla facilisis at.' +
'<p>' +
'Vero eros et accumsan <link>et iusto</link> odio dignissim qui blandit ' +
'praesent luptatum zzril delenit augue duis dolore te feugait nulla ' +
'facilisi. Lorem ipsum dolor sit <b>amet</b>, consectetuer adipiscing ' +
'elit, sed diam nonummy nibh euismod tincidunt ut laoreet dolore magna ' +
'aliquam erat volutpat. Ut wisi enim ad <i>minim veniam</i>, quis ' +
'nostrud exerci tation ullamcorper suscipit lobortis nisl ut aliquip ex ' +
'ea commodo consequat.' +
'<p>' +
'<b>Autem vel</b> eum iriure dolor in hendrerit in vulputate velit esse ' +
'molestie consequat, <link>vel illum</link> dolore eu feugiat nulla ' +
'facilisis at vero eros et accumsan et <i>iusto odio dignissim</i> qui ' +
'blandit praesent luptatum zzril delenit augue <b>duis dolore</b> te ' +
'feugait nulla facilisi.'};
implementation
end.
--- NEW FILE: JvLinkLabelDemo.dof ---
[Directories]
OutputDir=..\..\Bin
UnitOutputDir=..\..\Dcu
SearchPath=..\..\Source;..\..\Common
--- NEW FILE: JvLinkLabelDemo.dpr ---
program JvLinkLabelDemo;
uses
Forms,
InfoStrings in 'InfoStrings.pas',
Play in 'Play.pas' {frmPlay},
JvLinkLabelMainFormU in 'JvLinkLabelMainFormU.pas' {JvLinkLabelMainForm};
{$R *.RES}
begin
Application.Initialize;
Application.Title := 'TJvLinkLabel Demo';
Application.CreateForm(TJvLinkLabelMainForm, JvLinkLabelMainForm);
Application.CreateForm(TJvLinkLabelMainForm, JvLinkLabelMainForm);
Application.Run;
end.
--- NEW FILE: JvLinkLabelDemo.res ---
(This appears to be a binary file; contents omitted.)
--- NEW FILE: JvLinkLabelMainFormU.dfm ---
object JvLinkLabelMainForm: TJvLinkLabelMainForm
Left = 71
Top = 67
HorzScrollBar.Visible = False
VertScrollBar.Visible = False
BorderStyle = bsNone
Caption = 'Welcome to TJvLinkLabel!'
ClientHeight = 434
ClientWidth = 531
Color = clWhite
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnKeyPress = FormKeyPress
[...965 lines suppressed...]
end
object lblClose: TLabel
Left = 502
Top = 8
Width = 18
Height = 16
Cursor = crHandPoint
Anchors = [akTop, akRight]
Caption = 'r'
Color = clGray
Font.Charset = DEFAULT_CHARSET
Font.Color = clWhite
Font.Height = -16
Font.Name = 'Marlett'
Font.Style = [fsBold, fsUnderline]
ParentColor = False
ParentFont = False
OnClick = lblCloseClick
end
end
--- NEW FILE: JvLinkLabelMainFormU.pas ---
{-----------------------------------------------------------------------------
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/
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: Main.pas, released 2002-01-05.
The Initial Developer of the Original Code is David Polberger <dp...@sw...>
Portions created by David Polberger are Copyright (C) 2002 David Polberger.
All Rights Reserved.
Contributor(s): ______________________________________.
Last Modified: 2002-01-05;
Current Version: 1.00
You may retrieve the latest version of this file at the Project JEDI home page,
located at http://www.delphi-jedi.org
Known Issues:
Please see the accompanying documentation.
Description:
This is a small demo application, showing off some of the features of the
TJvLinkLabel. It's not as well-written as I would've liked, and could've been
written in a more object-oriented fashion. If you improve it, please send it
to me, and I'll try to include it in the next release.
-----------------------------------------------------------------------------}
unit JvLinkLabelMainFormU;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
CategCh, StdCtrls, ExtCtrls, JvLinkLabel;
type
TJvLinkLabelMainForm = class(TForm)
imgLogo: TImage;
lblHeading: TLabel;
LinkLabel: TJvLinkLabel;
lblClose: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure lblCloseClick(Sender: TObject);
procedure LinkLabelLinkClick(Sender: TObject; LinkNumber: Integer; LinkText: String);
private
FChooser: TJvCategoryChooser;
procedure ChooserCatChange(Sender: TObject);
function IsWithinBounds(Category: Integer): Boolean;
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
public
procedure CreateParams(var Params: TCreateParams); override;
end;
var
JvLinkLabelMainForm: TJvLinkLabelMainForm;
implementation
{$R *.DFM}
uses
InfoStrings, JvLinkLabelTools, Play;
procedure TJvLinkLabelMainForm.ChooserCatChange(Sender: TObject);
begin
with FChooser do
if IsWithinBounds(SelectedCat) then
begin
lblHeading.Caption := Trim(CatList[SelectedCat]);
LinkLabel.Caption := Info[SelectedCat];
end;
end;
procedure TJvLinkLabelMainForm.CreateParams(var Params: TCreateParams);
begin
{ We should really create a new TCustomForm-descendant, called
TMovableBorderForm or something like that, that we'd inherit from, instead
of placing all this nasty Windows-specific code directly in our main form.
However, that would probably cause trouble with the form designer, and we'd
wind up with creating everything dynamically. Visual form inheritance could
probably help us out, but this is just a demo application, and we'd just be
complicating matters unnecessarily. }
inherited;
with Params do
Style := (Style or WS_POPUP or WS_BORDER) and not WS_DLGFRAME;
end;
procedure TJvLinkLabelMainForm.FormCreate(Sender: TObject);
var
I: Integer;
begin
DoubleBuffered := True;
{ We create the TCategoryChooser dynamically, so that the user doesn't need
to install it. }
FChooser := TJvCategoryChooser.Create(Self);
FChooser.SetBounds(0, 109, 145, 324);
FChooser.OnCatChange := ChooserCatChange;
for I := Low(Headings) to High(Headings) do
FChooser.CatList.Add(Headings[I]);
FChooser.Parent := Self;
ChooserCatChange(Self);
end;
function TJvLinkLabelMainForm.IsWithinBounds(Category: Integer): Boolean;
begin
Result := Category in [Low(Info)..High(Info)];
end;
procedure TJvLinkLabelMainForm.WMNCHitTest(var Message: TWMNCHitTest);
begin
inherited;
if (ScreenToClient(Mouse.CursorPos).Y < imgLogo.Top + imgLogo.Height) and
(ScreenToClient(Mouse.CursorPos).X < lblClose.Left) then
Message.Result := HTCAPTION;
end;
procedure TJvLinkLabelMainForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #27 { Esc } then
begin
Close;
Key := #0;
end;
end;
procedure TJvLinkLabelMainForm.lblCloseClick(Sender: TObject);
begin
Close;
end;
procedure TJvLinkLabelMainForm.LinkLabelLinkClick(Sender: TObject; LinkNumber: Integer;
LinkText: String);
var
frmPlay: TfrmPlay;
procedure GoToNextCategory(Number: Integer); overload;
begin
// This really belongs in the TJvCategoryChooser itself
FChooser.SelectedCat := FChooser.SelectedCat + Number;
end;
procedure GoToNextCategory; overload;
begin
GoToNextCategory(1);
end;
procedure DisplayLink;
begin
ShowMessage('This link is identified by the number ' +
IntToStr(LinkNumber) + ', and contains the following text: "' +
LinkText + '".');
end;
begin
case FChooser.SelectedCat of
0:
case LinkNumber of
0: TWebTools.OpenWebPage('http://www.mozilla.org/MPL/MPL-1.1.html');
1: GoToNextCategory;
end;
1:
case LinkNumber of
0: DisplayLink;
1: GoToNextCategory;
end;
2:
case LinkNumber of
0: GoToNextCategory;
1: GoToNextCategory(2);
end;
5:
begin
frmPlay := TfrmPlay.Create(nil);
try
frmPlay.ShowModal;
finally
frmPlay.Free;
end;
end;
6:
GoToNextCategory;
end;
end;
end.
--- NEW FILE: Play.dfm ---
(This appears to be a binary file; contents omitted.)
--- NEW FILE: Play.pas ---
{-----------------------------------------------------------------------------
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/
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: Play.pas, released 2002-01-05.
The Initial Developer of the Original Code is David Polberger <dp...@sw...>
Portions created by David Polberger are Copyright (C) 2002 David Polberger.
All Rights Reserved.
Contributor(s): ______________________________________.
Last Modified: 2002-01-05;
Current Version: 1.00
You may retrieve the latest version of this file at the Project JEDI home page,
located at http://www.delphi-jedi.org
Known Issues:
Please see the accompanying documentation.
-----------------------------------------------------------------------------}
unit Play;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ComCtrls, StdCtrls, JvLinkLabel, JvValidateEdit, JvEdit;
type
TfrmPlay = class(TForm)
LinkLabel: TJvLinkLabel;
Splitter1: TSplitter;
Panel1: TPanel;
Panel2: TPanel;
Bevel1: TBevel;
Panel3: TPanel;
btnRefresh: TButton;
TreeView: TTreeView;
Edit: TEdit;
rgTextLayout: TRadioGroup;
gbMargin: TGroupBox;
edMarginW: TJvValidateEdit;
edMarginH: TJvValidateEdit;
updnW: TUpDown;
updbH: TUpDown;
Label1: TLabel;
Label2: TLabel;
gbMousePos: TGroupBox;
Label4: TLabel;
LnkLblMousePos: TLabel;
procedure FormCreate(Sender: TObject);
procedure btnRefreshClick(Sender: TObject);
procedure Panel2Resize(Sender: TObject);
procedure EditChange(Sender: TObject);
procedure rgTextLayoutClick(Sender: TObject);
procedure edMarginWChange(Sender: TObject);
procedure edMarginHChange(Sender: TObject);
procedure LinkLabelLinkClick(Sender: TObject; LinkNumber: Integer;
LinkText: String);
procedure LinkLabelMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
end;
implementation
{$R *.DFM}
uses
InfoStrings, JvLinkLabelDebug;
procedure TfrmPlay.FormCreate(Sender: TObject);
begin
DoubleBuffered := True;
LinkLabel.Caption := Lorem;
Edit.Text := Lorem;
LnkLblMousePos.Caption := '? x ?';
rgTextLayout.ItemIndex := Ord(LinkLabel.Layout);
edMarginW.Value := LinkLabel.MarginWidth;
edMarginH.Value := LinkLabel.MarginHeight;
btnRefreshClick(Self);
end;
procedure TfrmPlay.btnRefreshClick(Sender: TObject);
begin
TreeView.Items.BeginUpdate;
try
TDebugLinkLabelTools.NodeTreeToTreeNodes(LinkLabel, TreeView.Items);
TreeView.FullExpand;
TreeView.Selected := TreeView.Items.GetFirstNode;
finally
TreeView.Items.EndUpdate;
end;
end;
procedure TfrmPlay.Panel2Resize(Sender: TObject);
begin
Edit.Width := (Sender as TControl).Width - 16;
end;
procedure TfrmPlay.EditChange(Sender: TObject);
begin
LinkLabel.Caption := (Sender as TEdit).Text;
end;
procedure TfrmPlay.rgTextLayoutClick(Sender: TObject);
begin
LinkLabel.Layout := TTextLayout(rgTextLayout.ItemIndex);
end;
procedure TfrmPlay.edMarginWChange(Sender: TObject);
begin
LinkLabel.MarginWidth := edMarginW.Value;
end;
procedure TfrmPlay.edMarginHChange(Sender: TObject);
begin
LinkLabel.MarginHeight := edMarginH.Value;
end;
procedure TfrmPlay.LinkLabelLinkClick(Sender: TObject; LinkNumber: Integer;
LinkText: String);
begin
Application.MessageBox( PChar(LinkText + ' clicked !'),
PChar('Link Clicked'),
MB_APPLMODAL + MB_ICONINFORMATION + MB_OK);
end;
procedure TfrmPlay.LinkLabelMouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer);
begin
LnkLblMousePos.Caption := Format('( %d x %d )',[X,Y]);
end;
end.
|
