home *** CD-ROM | disk | FTP | other *** search
- unit Unit1;
-
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs, Unit2, WPLabel, ExtCtrls;
-
- type
- TLabelForm = class(TForm)
- Image1: TImage;
- WPRichTextLabel1: TWPRichTextLabel;
- procedure WPRichTextLabel1HyperLinkEvent(Sender: TObject; text,
- stamp: String; LineNumber: Longint);
- procedure FormPaint(Sender: TObject);
- private
- { Private-Deklarationen }
- public
- { Public-Deklarationen }
- end;
-
- var
- LabelForm: TLabelForm;
-
- implementation
-
- {$R *.DFM}
-
- procedure TLabelForm.WPRichTextLabel1HyperLinkEvent(Sender: TObject; text,
- stamp: String; LineNumber: Longint);
- begin
- if CompareText(text,'exit')=0 then close
- else if CompareText(text,'edit')=0 then
- begin
- try
- EditForm := TEditForm.Create(Self);
- EditForm.WPRichText1.RtfText.Assign(WPRichTextLabel1.RtfText);
- if EditForm.ShowModal=IDOK then
- begin
- WPRichTextLabel1.Visible := FALSE;
- WPRichTextLabel1.RtfText.Assign(
- EditForm.WPRichText1.RtfText);
- WPRichTextLabel1.Visible := TRUE;
- end;
- finally
- EditForm.Free;
- end;
- end;
- end;
-
- procedure TLabelForm.FormPaint(Sender: TObject);
- var i,a,b : Integer;
- begin
- i := 0;
- a := 0;
- if Height>500 then b:=3
- else if Height >250 then b:= 2
- else b:= 1;
- while i<Height do
- begin
- if a>254 then a:=0;
- Canvas.Pen.Color :=
- TColor(RGB(255-a,125-a div 2, a));
- Canvas.MoveTo(0,i);
- Canvas.LineTo(Width,i);
- if (i mod b) = 0 then inc(a);
- inc(i);
- end;
-
- end;
-
- end.
-