lazarus-ccr/components/tvplanit/source/vpabout.pas

{*********************************************************}
{*                  VPABOUT.PAS 1.03                     *}
{*********************************************************}

{* ***** BEGIN LICENSE BLOCK *****                                            *}
{* Version: MPL 1.1                                                           *}
{*                                                                            *}
{* 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 express or implied. See the License   *}
{* for the specific language governing rights and limitations under the       *}
{* License.                                                                   *}
{*                                                                            *}
{* The Original Code is TurboPower Visual PlanIt                              *}
{*                                                                            *}
{* The Initial Developer of the Original Code is TurboPower Software          *}
{*                                                                            *}
{* Portions created by TurboPower Software Inc. are Copyright (C) 2002        *}
{* TurboPower Software Inc. All Rights Reserved.                              *}
{*                                                                            *}
{* Contributor(s):                                                            *}
{*                                                                            *}
{* ***** END LICENSE BLOCK *****                                              *}

{$I vp.inc}

unit VpAbout;

interface

uses
{$IFDEF LCL}
 LCLProc, LCLType, LCLIntf, LCLVersion,
{$ELSE}
 Windows, Messages,
{$ENDIF}
 Forms, Graphics, Controls, Dialogs, StdCtrls, ExtCtrls,
(*
{$IFDEF VERSION6}
 {$IFDEF DELPHI}
 DesignIntf, DesignEditors,
 {$ELSE}
 PropEdits, LazarusPackageIntf,
 {$ENDIF}
{$ELSE}
 DsgnIntf,
{$ENDIF}
*)
 Classes, SysUtils;

{$IF LCL_FullVersion >= 2020000}
  {$DEFINE HAS_ANTIALIASEDSTRETCHDRAW}
{$ENDIF}

type

  { TfrmAbout }
  TfrmAbout = class(TForm)
    Bevel3: TBevel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    lblIcons8: TLabel;
    lblLazForumLink: TLabel;
    lblIcons8Link: TLabel;
    lblLazPortLink: TLabel;
    ImagePanel: TPanel;
    Image1: TImage;
    lblRolandHahnLink: TLabel;
    Panel1: TPanel;
    TextPanel: TPanel;
    SupportPanel: TPanel;
    ButtonPanel: TPanel;
    ProgramName: TLabel;
    GeneralNewsgroupsLabel: TLabel;
    lblTurboLink: TLabel;
    lblHelpLink: TLabel;
    CopyrightLabel: TLabel;
    OKButton: TButton;
    lblGeneralDiscussionLink: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label1: TLabel;
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lblLinkMouseEnter(Sender: TObject);
    procedure lblLinkMouseLeave(Sender: TObject);
    procedure lblLinkClick(Sender: TObject);
  private
    { Private declarations }
    {$IFDEF LCL}
    FLogo: TBitmap;
    {$ENDIF}
    procedure PositionControls;
  public
    { Public declarations }
    IsServer : boolean;
  end;


implementation

{$IFDEF LCL}
 {$R *.lfm}
{$ELSE}
 {$R *.dfm}
{$ENDIF}

uses
{$IFDEF LCL}
  GraphUtil,
{$ELSe}
  ShellAPI,
{$ENDIF}
  VpConst, VpMisc, VpSR;

const
  TURBO_LINK_URL = 'https://sourceforge.net/projects/tpvplanit/';
  HELP_URL = 'https://sourceforge.net/forum/forum.php?forum_id=241880';
//  NEWS_SPECIFIC_URL = 'news://news.turbopower.com/turbopower.public.support.visualplanit';
  GENERAL_DISCUSSION_URL = 'https://sourceforge.net/forum/forum.php?forum_id=241879';
  LAZARUS_PORT_URL = 'https://sourceforge.net/p/lazarus-ccr/svn/HEAD/tree/components/tvplanit';
  LAZARUS_FORUM_URL = 'https://forum.lazarus.freepascal.org';
  ROLAND_HAHN_URL = 'https://www.rhsoft.de';
  ICONS8_URL = 'https://icons8.com';


{ FrmAbout }

procedure TfrmAbout.FormActivate(Sender: TObject);
const
{$IFDEF LCL}
  COPYRIGHT = '©';
{$ELSE}
  COPYRIGHT = #169
{$ENDIF}
var
  Year, Junk: Word;
  bmp: TBitmap;
  w, h: Integer;
begin
  ProgramName.Caption := VpProductName + ' ' + VpVersionStr;
  DecodeDate(Now, Year, junk, junk);
  CopyrightLabel.Caption := Format(
    '%s Copyright 2000 - %d, TurboPower Software Company and Lazarus team.' +
    LineEnding + 'All rights reserved.',
    [COPYRIGHT, Year]);

  PositionControls;

  h := ImagePanel.Height;
  w := FLogo.Width * h div FLogo.Height;
  bmp := TBitmap.Create;
  try
    bmp.SetSize(w, h);
    {$IFDEF HAS_ANTIALIASEDSTRETCHDRAW}
    AntiAliasedStretchDrawBitmap(FLogo, bmp, w, h);
    {$ELSE}
    bmp.Canvas.StretchDraw(Rect(0, 0, bmp.Width,bmp.Height), FLogo);
    {$ENDIF}
    Image1.Picture.Bitmap.Assign(bmp);
  finally
    bmp.Free;
  end;
end;

procedure TfrmAbout.FormCreate(Sender: TObject);
begin
  FLogo := TBitmap.Create;
  LoadGlyphFromRCDATA(FLogo, 'LOGO');

  lblTurboLink.Caption := TURBO_LINK_URL;
  lblLazPortLink.Caption := LAZARUS_PORT_URL;
  lblHelpLink.Caption := HELP_URL;
  lblGeneralDiscussionLink.Caption := GENERAL_DISCUSSION_URL;

  lblLazForumLink.Caption := LAZARUS_FORUM_URL;
  lblRolandHahnLink.Caption := ROLAND_HAHN_URL;
  lblIcons8Link.Caption := ICONS8_URL;
end;

procedure TfrmAbout.FormDestroy(Sender: TObject);
begin
  FLogo.Free;
end;

procedure TfrmAbout.lblLinkMouseEnter(Sender: TObject);
begin
  (Sender as TLabel).Font.Style := [fsUnderline];
end;

procedure TfrmAbout.lblLinkMouseLeave(Sender: TObject);
begin
  (Sender as TLabel).Font.Style := [];
end;

procedure TfrmAbout.lblLinkClick(Sender: TObject);
var
  lbl: TLabel;
  url: String;
begin
  lbl := TLabel(Sender);
  url := lbl.Caption;
  (*
  //  if Sender = lblNewsSpecific then url := NEWS_SPECIFIC_URL else
  if Sender = lblHelpLink then
    url := HELP_URL
  else
  if Sender = lblGeneralDiscussionLink then
    url := GENERAL_DISCUSSION_URL
  else
  if Sender = lblTurboLink then
    url := TURBO_LINK_URL
  else
  if Sender = lblLazPortLink then
    url := LAZARUS_PORT_URL
  else
  if Sender = lblLazForumLink then
    url := LAZARUS_FORUM_URL
  else
  if Sender = lblRolandHahnLink then
    url := ROLAND_HAHN_URL
  else
  if Sender = lblIcons8Link then
    url := ICONS8_URL
  else
    exit;
    *)
{$IFDEF LCL}
  if not OpenUrl(url)
{$ELSE}
  if ShellExecute(0, 'open', PChar(url), '', '', SW_SHOWNORMAL) <= 32
{$ENDIF}
  then
    ShowMessage(RSBrowserError);
end;

procedure TfrmAbout.PositionControls;
var
  VDIST: Integer = 8;
begin
  VDIST := ScaleY(VDIST, DesignTimeDPI);

  ProgramName.Font.Size := ScaleY(Programname.Font.Size, DesignTimeDPI);
  ClientWidth := GetLabelWidth(LblLazPortLink) + Panel1.Width + 48; //ScaleX(ClientWidth, DesignTimeDPI);
//  ClientHeight := ScaleY(ClientHeight, DesignTimeDPI);

  //SupportPanel.ClientHeight := BottomOf(lblLazForumLink) + VDIST;
  ButtonPanel.ClientHeight :=  CopyRightLabel.Height + 2 * VDIST;

  OKButton.Height := ScaleY(OKButton.Height, DesignTimeDPI);
//  OKButton.Top := (ButtonPanel.Height - OKButton.Height) div 2;
//  CopyrightLabel.Top := (ButtonPanel.Height - CopyrightLabel.Height) div 2;

  //ClientHeight := Max(BottomOf(ImagePanel), BottomOf(SupportPanel)) + VDIST + ButtonPanel.Height;
end;

end.