Apophysis-AV/Forms/About.pas
2022-03-08 20:25:51 +03:00

164 lines
4.7 KiB
ObjectPascal
Raw Permalink Blame History

{
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
Apophysis AV "Phoenix Edition" Copyright (C) 2021 Alice V. Koryagina
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU 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 General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit About;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Global, Translation;
type
TAboutForm = class(TForm)
btnOK: TButton;
Label3: TLabel;
Label4: TLabel;
Label10: TLabel;
Label11: TLabel;
lblFlamecom: TLabel;
Bevel1: TBevel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Bevel3: TBevel;
Label17: TLabel;
Label18: TLabel;
Label16: TLabel;
Label2: TLabel;
Bevel2: TBevel;
Label19: TLabel;
Label20: TLabel;
Image1: TImage;
Label5: TLabel;
Bevel4: TBevel;
Label1: TLabel;
Label15: TLabel;
Bevel5: TBevel;
Label21: TLabel;
lbApoTitle: TLabel;
lbApoVers: TLabel;
Label24: TLabel;
Bevel6: TBevel;
lblAuthor: TLabel;
Label26: TLabel;
Label27: TLabel;
Label28: TLabel;
Bevel7: TBevel;
Bevel8: TBevel;
lblPlugins: TLabel;
Bevel9: TBevel;
lblVersion: TLabel;
procedure btnOKClick(Sender: TObject);
procedure lblPluginsClick(Sender: TObject);
procedure DevelopersClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure SetTitleColor;
end;
var
AboutForm: TAboutForm;
implementation
uses Main, ShellAPI;
{$R *.DFM}
procedure TAboutForm.btnOKClick(Sender: TObject);
begin
ModalResult := mrOK;
end;
procedure TAboutForm.lblPluginsClick(Sender: TObject);
var URL : String;
begin
URL := lblPlugins.Hint;
ShellExecute(ValidParentForm(Self).Handle, 'open', PChar(URL), nil, nil, SW_SHOWNORMAL);
URL := 'https://onedrive.live.com/?authkey=%21AEhvN24LOQKCzBY&cid=828A1C23C17CA4C9&id=828A1C23C17CA4C9%211037&parId=root&action=locate';
ShellExecute(ValidParentForm(Self).Handle, 'open', PChar(URL), nil, nil, SW_SHOWNORMAL);
end;
procedure TAboutForm.SetTitleColor;
var clr: TColor;
begin
if IsDarkTheme or (CurrentStyle = 'Cyan Night') or (CurrentStyle = 'Calypso SLE')
or (CurrentStyle = 'Obsidian') or (CurrentStyle = 'Metropolis UI Green') then
clr := BrightColor
else
clr := clMaroon;
lbApoTitle.Font.Color := clr;
lbApoVers.Font.Color := clr;
end;
procedure TAboutForm.DevelopersClick(Sender: TObject);
begin
ShellExecute(ValidParentForm(Self).Handle, 'open', PChar(TLabel(Sender).Hint),
nil, nil, SW_SHOWNORMAL);
end;
procedure TAboutForm.FormCreate(Sender: TObject);
var s1, s2, s3: string;
AVFont: TResourceStream;
begin
btnOK.Caption := TextByKey('common-close');
if (LanguageFile <> AvailableLanguages.Strings[0]) and (LanguageFile <> '') then
begin
LanguageInfo(LanguageFile, s1, s2);
s3 := LanguageAuthor(LanguageFile);
Label20.Visible := (s2 <> '') and (s3 <> '');
Label20.Caption := s2 + #32 + TextByKey('common-translation') + #32#32 + s3;
end;
lblPlugins.Caption := TextByKey('common-pluginlink');
Label3.Caption := TextByKey('common-thirdparty');
SetTitleColor;
if (pos(LowerCase(s1), 'russian') > 0) or (pos(LowerCase(s1), '<27><><EFBFBD><EFBFBD><EFBFBD>') > 0) then
lblAuthor.Caption := '<27><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>';
if Screen.Fonts.IndexOf('Harlow Solid Italic') = -1 then
begin // shouldn't happen on modern OS
AVFont := TResourceStream.Create(hInstance, 'HARLOWSI', RT_FONT);
try
s3 := GetEnvVarValue('WINDIR') + '\Fonts\Harlow Solid Italic.ttf';
AVFont.SavetoFile(s3);
except
s3 := AppPath + 'Harlow Solid Italic.ttf';
AVFont.SavetoFile(s3);
end;
AddFontResource(PChar(s3));
SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);
AVFont.Free;
end;
end;
end.