On 3/26/11, Mattias Gaertner <[email protected]> wrote: > Please provide a complete example.
See attached screenshot and unit I was working on. ATM I cannot reproduce the popup after a dot in a text constant, I'll make another screenshot when it happens again (and I rember to do so). Bart
<<attachment: Laz_Codetools_Confusion.png>>
unit ExtAboutForm;
{ ************ ExtAboutForm ***********************************
Copyright (C) 2011 Bart Broersma
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*****************************************************************}
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, LCLType,
Buttons, ComCtrls, StdCtrls, LCLProc, ExtCtrls, LCLIntf;
type
{ TExtAboutDlgForm }
TExtAboutDlgForm = class(TForm)
BitBtn1: TBitBtn;
Image1: TImage;
BuildDateLabel: TLabel;
CopyrightLabel: TLabel;
FpcLabel: TLabel;
WebsiteLabel: TLabel;
LazLabel: TLabel;
ProductLabel: TLabel;
VersionLabel: TLabel;
LicenseUrlLabel: TLabel;
LicenseMemo: TMemo;
NoteBook: TPageControl;
MainPage: TTabSheet;
LicensePage: TTabSheet;
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure LicenseUrlLabelClick(Sender: TObject);
procedure WebsiteLabelClick(Sender: TObject);
procedure WebsiteLabelMouseEnter(Sender: TObject);
procedure WebsiteLabelMouseLeave(Sender: TObject);
private
{ private declarations }
FWebsiteURL: String;
FLicenseUrl: String;
public
{ public declarations }
procedure SetVersionInfo(ProductName,Version, BuildDate, LazVersion, FpcVersion: String);
procedure SetCopyrightInfo(const CopyrightStatement, WebsiteName, WebsiteUrl: String);
procedure SetLicenseInfo(const LicenseText, LicenseWebsiteName, LicenseWebsiteUrl: String);
end;
var
ExtAboutDlgForm: TExtAboutDlgForm;
implementation
{$R *.lfm}
{ TExtAboutDlgForm }
procedure TExtAboutDlgForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_ESCAPE) then
begin
ModalResult := mrCancel;
Close;
end;
end;
procedure TExtAboutDlgForm.FormCreate(Sender: TObject);
begin
//In GTK you can resize/maximize a form with BorderStyle := bsDialog, we don't want that
Constraints.MinHeight := Height;
Constraints.MaxHeight := Height;
Constraints.MinWidth := Width;
Constraints.MaxWidth := Width;;
end;
procedure TExtAboutDlgForm.LicenseUrlLabelClick(Sender: TObject);
begin
if FLicenseUrl <> '' then OpenUrl(FLicenseUrl);
end;
procedure TExtAboutDlgForm.WebsiteLabelClick(Sender: TObject);
begin
if FWebsiteUrl <> '' then OpenUrl(FWebsiteUrl);
end;
procedure TExtAboutDlgForm.WebsiteLabelMouseEnter(Sender: TObject);
begin
(Sender as TLabel).Font.Style := (Sender as TLabel).Font.Style + [fsUnderline];
end;
procedure TExtAboutDlgForm.WebsiteLabelMouseLeave(Sender: TObject);
begin
(Sender as TLabel).Font.Style := (Sender as TLabel).Font.Style - [fsUnderline];
end;
procedure TExtAboutDlgForm.SetVersionInfo(ProductName,Version, BuildDate, LazVersion,
FpcVersion: String);
var
Y,M,D: String;
p: Integer;
begin
if ProductName = '' then ProductName := Application.Title;
if BuildDate = '' then
begin
BuildDate := {$I %DATE%}; // y/m/d format
p := Pos('/',BuildDate);
Y := Copy(BuildDate,1,p-1);
System.Delete(BuildDate,1,p);
p := Pos('/',BuildDate);
M := Copy(BuildDate,1,p-1);
System.Delete(BuildDate,1,p);
D := BuildDate;
BuildDate := 'Build date: ' + D + '-'+ M + '-'+ Y;
end;
if LazVersion = '' then LazVersion := 'Lazarus '+ LCLVersion;
if FpcVersion = '' then FpcVersion := 'FPC ' + {$I %FPCVERSION%};
ProductLabel.Caption := ProductName;
VersionLabel.Caption := Version;
BuildDateLabel.Caption := BuildDate;
LazLabel.Caption := LazVersion;
FpcLabel.Caption := FpcVersion;
end;
procedure TExtAboutDlgForm.SetCopyrightInfo(const CopyrightStatement, WebsiteName, WebsiteUrl: String);
begin
FWebsiteURL := WebsiteURL;
WebsiteLabel.Caption := WebsiteName;
if WebsiteName = '' then WebsiteLabel.Caption := WebsiteUrl;
CopyrightLabel.Caption := CopyrightStatement;
if (WebsiteUrl <> '') and (WebsiteName <> '') and (WebsiteUrl <> WebsiteName) then
begin
WebsiteLabel.ShowHint := True;
WebsiteLabel.Hint := WebsiteUrl;
end
else WebsiteLabel.ShowHint := False;
end;
procedure TExtAboutDlgForm.SetLicenseInfo(const LicenseText,
LicenseWebsiteName, LicenseWebsiteUrl: String);
begin
debugln('LicenseWebsiteName = ',licensewebsitename,' LicenseWebsiteUrl = ',licensewebsiteurl);
LicenseMemo.Text := LicenseText;
FLicenseUrl := LicenseWebsiteUrl;
LicenseUrlLabel.Caption := LicenseWebsiteName;
if LicenseWebsiteName = '' then LicenseUrlLabel.Caption := FLicenseUrl;
if (LicenseWebsiteUrl <> '') and (LicenseWebsiteName <> '') and (LicenseWebsiteURL <> LicenseWebsiteName) then
begin
LicenseUrlLabel.ShowHint := True;
LicenseUrlLabel.Hint := LicenseWebsiteUrl;
end
else LicenseUrlLabel.ShowHint := False;
end;
end.
-- _______________________________________________ Lazarus mailing list [email protected] http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
