(* * CDDL HEADER START * * The contents of this file are subject to the terms of the * Common Development and Distribution License, Version 1.0 only * (the "License"). You may not use this file except in compliance * with the License. * * You can obtain a copy of the license at * http://www.opensource.org/licenses/cddl1.php. * See the License for the specific language governing permissions * and limitations under the License. * * When distributing Covered Code, include this CDDL HEADER in each * file and include the License file at * http://www.opensource.org/licenses/cddl1.php. If applicable, * add the following below this CDDL HEADER, with the fields enclosed * by brackets "[]" replaced with your own identifying * information: * Portions Copyright [yyyy] [name of copyright owner] * * CDDL HEADER END * * * Portions Copyright 2007 Andreas Schneider *) unit UfrmAbout; {$mode objfpc}{$H+} interface uses Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, ShellAPI, MMSystem; type { TfrmAbout } TfrmAbout = class(TForm) btnClose: TButton; imgLogo: TImage; imgBaner: TImage; Label3: TLabel; Label8: TLabel; lblCopyright: TLabel; lblVersion: TLabel; lblWebLink: TLabel; Panel2: TPanel; Panel3: TPanel; Panel4: TPanel; Panel5: TPanel; procedure btnCloseClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormHide(Sender: TObject); procedure FormShow(Sender: TObject); procedure imgBanerClick(Sender: TObject); procedure imgBanerMouseEnter(Sender: TObject); procedure imgBanerMouseLeave(Sender: TObject); procedure lblWebLinkClick(Sender: TObject); procedure lblWebLinkMouseEnter(Sender: TObject); procedure lblWebLinkMouseLeave(Sender: TObject); procedure Panel2Click(Sender: TObject); private { private declarations } pSound: Pointer; public { public declarations } lbVersion: string; lbBuild: string; end; var frmAbout: TfrmAbout; implementation uses vinfo, Language, UResourceManager; {$I version.inc} { TfrmAbout } procedure TfrmAbout.btnCloseClick(Sender: TObject); begin Close; end; procedure TfrmAbout.FormCreate(Sender: TObject); begin pSound:= nil; LanguageTranslate(Self); lblVersion.Caption := Format('%s %s%s %s %d', [lbVersion, VersionInfo.GetFileVersionString, #13#10, lbBuild, VersionInfo.Build]); imgLogo.Picture.Bitmap.LoadFromStream(ResourceManager.GetResource('Overlay/About.bmp')); //lblVersion.Caption := Format('Version %s', [ProductVersion]); //lblCopyright.Caption := Format('Copyright %s', [Copyright]); end; procedure TfrmAbout.FormShow(Sender: TObject); var stream: TStream; begin if (pSound = nil) then begin stream := ResourceManager.GetResource('Sounds/MusicInf.wav'); GetMem(pSound, stream.Size); stream.Read(pSound^, stream.Size); end; sndPlaySound(pSound, SND_MEMORY or SND_ASYNC or SND_LOOP); end; procedure TfrmAbout.FormHide(Sender: TObject); begin if pSound = nil then Exit; sndPlaySound(nil, SND_ASYNC or SND_LOOP); FreeMem(pSound); pSound := nil; end; procedure TfrmAbout.imgBanerClick(Sender: TObject); begin // Открываем сайт в браузере по умолчанию ShellExecute(Handle, 'open', PChar('http://uoquint.ru'), nil, nil, 1 {SW_SHOWNORMAL}); end; procedure TfrmAbout.imgBanerMouseEnter(Sender: TObject); var stream: TMemoryStream; begin stream := TMemoryStream.Create; stream.Write(baner_h[0],SizeOf(baner_h)); stream.Position:=0; imgBaner.Picture.Bitmap.LoadFromStream(stream); stream.Free; end; procedure TfrmAbout.imgBanerMouseLeave(Sender: TObject); var stream: TMemoryStream; begin stream := TMemoryStream.Create; stream.Write(baner_u[0],SizeOf(baner_u)); stream.Position:=0; imgBaner.Picture.Bitmap.LoadFromStream(stream); stream.Free; // sndPlaySound end; procedure TfrmAbout.lblWebLinkClick(Sender: TObject); begin // Открываем сайт в браузере по умолчанию ShellExecute(Handle, 'open', PChar('http://dev.uoquint.ru/projects/centred'), nil, nil, 1 {SW_SHOWNORMAL}); end; procedure TfrmAbout.lblWebLinkMouseEnter(Sender: TObject); begin lblWebLink.Font.Color := TColor($00EAAE86); end; procedure TfrmAbout.lblWebLinkMouseLeave(Sender: TObject); begin lblWebLink.Font.Color := TColor($00E18A51); end; procedure TfrmAbout.Panel2Click(Sender: TObject); begin end; initialization {$I UfrmAbout.lrs} end.