paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-21 22:59:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

made the URLs in the acknowledgement tab clickable

Browse Source 
lowered the scrolling speed so it is more easy to click an URL
changed the color to clRed when mose hovers over a clickable URL, this beacause gtk2 does not show underline fonts, windows will show both underline and red labels

git-svn-id: trunk@17006 -
This commit is contained in:
darius 2008-10-15 16:26:01 +00:00
parent 42bd585e98
commit 797872077d
3 changed files with 80 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
ide/aboutfrm.lfm
View File

@ -560,6 +560,8 @@ object AboutForm: TAboutForm
ParentFont = True
ParentShowHint = True
Visible = True
OnMouseDown = AcknowledgementsPaintBoxMouseDown
OnMouseMove = AcknowledgementsPaintBoxMouseMove
end
end
object LogoPage: TPage
@ -613,7 +615,7 @@ object AboutForm: TAboutForm
end
end
object Timer: TTimer
Interval = 15
Interval = 30
OnTimer = TimerTimer
left = 17
top = 264

35
ide/aboutfrm.lrs
View File

@ -185,21 +185,22 @@ LazarusResources.Add('TAboutForm','FORMDATA',[
+'erSpacing.CellAlignHorizontal'#7#7'ccaFill'#31'BorderSpacing.CellAlignVerti'
+'cal'#7#7'ccaFill'#10'DragCursor'#7#6'crDrag'#8'DragMode'#7#8'dmManual'#7'En'
+'abled'#9#11'ParentColor'#9#10'ParentFont'#9#14'ParentShowHint'#9#7'Visible'
+#9#0#0#0#5'TPage'#8'LogoPage'#11'HelpContext'#2#0#7'Caption'#6#8'LogoPage'#28
+'ChildSizing.LeftRightSpacing'#2#0#28'ChildSizing.TopBottomSpacing'#2#0#29'C'
+'hildSizing.HorizontalSpacing'#2#0#27'ChildSizing.VerticalSpacing'#2#0#27'Ch'
+'ildSizing.ControlsPerLine'#2#0#11'ClientWidth'#3#129#1#12'ClientHeight'#3#5
+#1#10'ImageIndex'#2#255#10'ParentFont'#9#14'ParentShowHint'#9#0#6'TImage'#9
+'LogoImage'#4'Left'#2#0#6'Height'#3#5#1#3'Top'#2#0#5'Width'#3#129#1#11'HelpC'
+'ontext'#2#0#5'Align'#7#8'alClient'#8'AutoSize'#8#18'BorderSpacing.Left'#2#0
+#17'BorderSpacing.Top'#2#0#19'BorderSpacing.Right'#2#0#20'BorderSpacing.Bott'
,'om'#2#0#20'BorderSpacing.Around'#2#0'!BorderSpacing.CellAlignHorizontal'#7#7
+'ccaFill'#31'BorderSpacing.CellAlignVertical'#7#7'ccaFill'#6'Center'#8#10'Dr'
+'agCursor'#7#6'crDrag'#8'DragMode'#7#8'dmManual'#7'Enabled'#9#14'ParentShowH'
+'int'#9#12'Proportional'#8#7'Stretch'#8#11'Transparent'#8#7'Visible'#9#0#0#0
+#0#10'TPopupMenu'#10'PopupMenu1'#4'left'#2#18#3'top'#3#225#0#0#9'TMenuItem'
+#16'miVerToClipboard'#7'Caption'#6'%Copy version information to clipboard'#12
+'RightJustify'#8#19'ShowAlwaysCheckable'#8#7'OnClick'#7#21'miVerToClipboardC'
+'lick'#0#0#0#6'TTimer'#5'Timer'#8'Interval'#2#15#7'OnTimer'#7#10'TimerTimer'
+#4'left'#2#17#3'top'#3#8#1#0#0#0
+#9#11'OnMouseDown'#7'!AcknowledgementsPaintBoxMouseDown'#11'OnMouseMove'#7'!'
+'AcknowledgementsPaintBoxMouseMove'#0#0#0#5'TPage'#8'LogoPage'#11'HelpContex'
+'t'#2#0#7'Caption'#6#8'LogoPage'#28'ChildSizing.LeftRightSpacing'#2#0#28'Chi'
+'ldSizing.TopBottomSpacing'#2#0#29'ChildSizing.HorizontalSpacing'#2#0#27'Chi'
+'ldSizing.VerticalSpacing'#2#0#27'ChildSizing.ControlsPerLine'#2#0#11'Client'
+'Width'#3#129#1#12'ClientHeight'#3#5#1#10'ImageIndex'#2#255#10'ParentFont'#9
+#14'ParentShowHint'#9#0#6'TImage'#9'LogoImage'#4'Left'#2#0#6'Height'#3#5#1#3
+'Top'#2#0#5'Width'#3#129#1#11'HelpContext'#2#0#5'Align'#7#8'alClient'#8'Auto'
,'Size'#8#18'BorderSpacing.Left'#2#0#17'BorderSpacing.Top'#2#0#19'BorderSpaci'
+'ng.Right'#2#0#20'BorderSpacing.Bottom'#2#0#20'BorderSpacing.Around'#2#0'!Bo'
+'rderSpacing.CellAlignHorizontal'#7#7'ccaFill'#31'BorderSpacing.CellAlignVer'
+'tical'#7#7'ccaFill'#6'Center'#8#10'DragCursor'#7#6'crDrag'#8'DragMode'#7#8
+'dmManual'#7'Enabled'#9#14'ParentShowHint'#9#12'Proportional'#8#7'Stretch'#8
+#11'Transparent'#8#7'Visible'#9#0#0#0#0#10'TPopupMenu'#10'PopupMenu1'#4'left'
+#2#18#3'top'#3#225#0#0#9'TMenuItem'#16'miVerToClipboard'#7'Caption'#6'%Copy '
+'version information to clipboard'#12'RightJustify'#8#19'ShowAlwaysCheckable'
+#8#7'OnClick'#7#21'miVerToClipboardClick'#0#0#0#6'TTimer'#5'Timer'#8'Interva'
+'l'#2#30#7'OnTimer'#7#10'TimerTimer'#4'left'#2#17#3'top'#3#8#1#0#0#0
]);

71
ide/aboutfrm.pas
View File

@ -58,6 +58,10 @@ type
ContributorsPage:TPage;
AcknowledgementsPage:TPage;
procedure AboutFormCreate(Sender:TObject);
procedure AcknowledgementsPaintBoxMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure AcknowledgementsPaintBoxMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
procedure miVerToClipboardClick(Sender: TObject);
procedure URLLabelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
@ -68,15 +72,17 @@ type
FAcknowledgements: TStrings;
FBuffer: TBitmap;
FContributors: TStrings;
FEnd: integer;
FEndLine: integer;
FLineHeight: integer;
FNumLines: integer;
FOffset: integer;
FStart: integer;
FStartLine: integer;
FStepSize: integer;
FActiveLine: integer; //the line over which the mouse hovers
procedure ResetScrollText;
procedure LoadContributors;
procedure LoadAcknowledgements;
function ActiveLineIsURL: boolean;
public
constructor Create(TheOwner: TComponent); override;
end;
@ -163,7 +169,7 @@ begin
FNumLines := FBuffer.Height div FLineHeight;
FOffset := FBuffer.Height;
FStart := 0;
FStartLine := 0;
FStepSize := 1;
Constraints.MinWidth:= 600;
@ -182,6 +188,32 @@ begin
CloseButton.Caption:=lisClose;
end;
procedure TAboutForm.AcknowledgementsPaintBoxMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
err: string;
begin
if ActiveLineIsURL then
if HelpIntfs.ShowHelp(FAcknowledgements[FActiveLine], 'Lazarus', 'text/html', err) <> shrSuccess then
ShowMessage(err);
end;
procedure TAboutForm.AcknowledgementsPaintBoxMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
//calculate what line is clicked from the mouse position
FActiveLine := (Y - FOffset) div FLineHeight;
if FActiveLine < 0 then
FActiveLine := 0;
if FActiveLine >= FAcknowledgements.Count then
FActiveLine := FAcknowledgements.Count -1;
AcknowledgementsPaintbox.Cursor := crDefault;
if ActiveLineIsURL then
AcknowledgementsPaintbox.Cursor := crHandPoint
end;
procedure TAboutForm.miVerToClipboardClick(Sender: TObject);
begin
Clipboard.AsText := 'v' + LazarusVersionStr + ' r' + LazarusRevisionStr +
@ -200,12 +232,14 @@ end;
procedure TAboutForm.URLLabelMouseLeave(Sender: TObject);
begin
TLabel(Sender).Font.Style := [];
TLabel(Sender).Font.Color := clBlue;
TLabel(Sender).Cursor := crDefault;
end;
procedure TAboutForm. URLLabelMouseEnter(Sender: TObject);
begin
TLabel(Sender).Font.Style := [fsUnderLine];
TLabel(Sender).Font.Color := clRed;
TLabel(Sender).Cursor := crHandPoint;
end;
@ -220,17 +254,17 @@ procedure TAboutForm.TimerTimer(Sender: TObject);
Dec(FOffset, FStepSize);
if FOffSet < 0 then
FStart := -FOffset div FLineHeight
FStartLine := -FOffset div FLineHeight
else
FStart := 0;
FStartLine := 0;
FEnd := FStart + FNumLines + 1;
if FEnd > AText.Count - 1 then
FEnd := AText.Count - 1;
FEndLine := FStartLine + FNumLines + 1;
if FEndLine > AText.Count - 1 then
FEndLine := AText.Count - 1;
FBuffer.Canvas.FillRect(Rect(0, 0, FBuffer.Width, FBuffer.Height));
for i := FEnd downto FStart do
for i := FEndLine downto FStartLine do
begin
s := Trim(AText[i]);
@ -250,8 +284,16 @@ procedure TAboutForm.TimerTimer(Sender: TObject);
else
begin
//check for url
if Pos('http://', s) > 0 then
FBuffer.Canvas.Font.Color := clBlue;
if Pos('http://', s) = 1 then
begin
if i = FActiveLine then
begin
FBuffer.Canvas.Font.Style := [fsUnderline];
FBuffer.Canvas.Font.Color := clRed;
end
else
FBuffer.Canvas.Font.Color := clBlue;
end;
end;
w := FBuffer.Canvas.TextWidth(s);
@ -260,7 +302,7 @@ procedure TAboutForm.TimerTimer(Sender: TObject);
end;
//start showing the list from the start
if FStart > AText.Count - 1 then
if FStartLine > AText.Count - 1 then
FOffset := FBuffer.Height;
ACanvas.Draw(0,0,FBuffer);
@ -321,6 +363,11 @@ begin
FAcknowledgements.Text:=lisAboutNoContributors;
end;
function TAboutForm.ActiveLineIsURL: boolean;
begin
Result := Pos('http://', FAcknowledgements[FActiveLine]) = 1;
end;
initialization
{$I aboutfrm.lrs}
{$I lazarus_about_logo.lrs}