about.pas

来自「mp3 播放器 delphi 源码」· PAS 代码 · 共 119 行

{###############################################################################
# Dipesh-MP3yk                                               Delphi-Sourcecode #
################################################################################
# by Sebastian Sauer (Dipesh)                                                  #
#   email:   [e-mail]                                                    #
#   url:     www.dipesh.de                                                     #
# (C) 1999 - freeware, see the licenceagreements in readme.txt                 #
################################################################################
# ABOUT.PAS - TAboutForm                                                       #
# infos about this proggie                                                     #
# !!! please don't change anything the form and unit - see licenceagrements !  #
###############################################################################}

UNIT About;

INTERFACE

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
     StdCtrls, ExtCtrls, Buttons;

type
  TAboutForm = class(TForm)
    ButtonOk: TBitBtn;
    Image1: TImage;
    Image2: TImage;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    procedure OnCreate(Sender: TObject);
    procedure OnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure OnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure OnClick(Sender: TObject);
  end;

var AboutForm: TAboutForm;

IMPLEMENTATION

uses Main;

{$R *.DFM}
        
procedure TAboutForm.OnCreate(Sender: TObject);
begin
  Image1.Picture.Icon:=Application.Icon;
  Image2.Picture.Icon:=Application.Icon;
  MainForm.ImageListBtn.GetBitmap(1,ButtonOk.Glyph);
end;      

procedure TAboutForm.OnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin (Sender as TLabel).Font.Color:=clBlue; (Sender as TLabel).Update; end;

procedure TAboutForm.OnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin (Sender as TLabel).Font.Color:=clNavy; end;

procedure TAboutForm.OnClick(Sender: TObject);
var s1: string;

  // the sourcecode of the folling both functions are from the freeware-component GotoWeb 2.1
  // by CRESTO Sylvain ([e-mail], http://www.mygale.org/~cresto/) - thankz CRESTO !
  function FindBrowser: string;
  var c: byte; hkey1,hkey2: hkey; typ,taille: integer; tmp: array[0..1024] of char;
  const nbr_extension=4; extension: array[0..nbr_extension-1] of string=('.HTM','.HTML','.SHTML','.SHTM');
  begin
    c:=0;
    Repeat
      if regopenkeyex(hkey_classes_root,pchar(extension[c]),0,key_all_access,hkey1)=0 then begin
        if regqueryvalueex(hkey1,nil,nil,@typ,nil,@taille)=error_success then begin
          regqueryvalueex(hkey1,nil,nil,nil,@tmp,@taille);
          if tmp<>'' then
            if regopenkeyex(hkey_classes_root,pchar(tmp+'\shell\open\command'),0,key_all_access,hkey2)=error_success then begin
              if regqueryvalueex(hkey2,nil,nil,@typ,nil,@taille)=error_success then begin regqueryvalueex(hkey2,nil,nil,nil,@tmp,@taille);
                if tmp<>'' then begin RegCloseKey(hkey2); FindBrowser:=strpas(tmp); Exit; end; end;
              regclosekey(hkey2);
            end;
          if regopenkeyex(hkey1,'shell\open\command',0,key_all_access,hkey2)=error_success then begin
            if regqueryvalueex(hkey2,nil,nil,@typ,nil,@taille)=error_success then begin regqueryvalueex(hkey2,nil,nil,nil,@tmp,@taille);
              if tmp<>'' then begin RegCloseKey(hkey2); FindBrowser:=strpas(tmp); Exit; end; end;
          end;
        end; regclosekey(hkey1);
      end; inc(c);
    until c=nbr_extension;
    FindBrowser:='';
  end;

  function BrowserPath: string;
  var tmp, para: string; s,c: word;
  begin
    tmp:=findbrowser;
    if tmp<>'' then begin c:=length(tmp)+1;
      repeat dec(c); para:=uppercase(copy(tmp,c-3,4)); until (para='.EXE') or (para='.BAT') or (para='.COM');
      if c<length(tmp) then begin s:=c; para:=trim(copy(tmp,c+1,length(tmp)-(c))); c:=1;
        while (c<=length(para)) do if para[c]='"' then delete(para,c,1) else inc(c);
        if para<>'' then begin c:=1;
          while c<=length(para) do begin
            if para[c]='%' then begin while (c<=length(para)) and (para[c]<>' ') do delete(para,c,1); end else inc(c); end;
        end;
        para:=trim(para); delete(tmp,s+1,length(tmp)-s);
      end else para:='';
      if tmp[1]='"' then delete(tmp,1,1);
    end;
    BrowserPath:=tmp;
  end;

begin
  s1:=BrowserPath;
  If s1='' then If MessageDlg('no web-browser found...'+#13+'Exec the Url nevertheless?',mtConfirmation,[mbYes]+[mbCancel],0)<>idYes then Exit;
  MainForm.ExecuteCom(s1+'|'+(Sender as TLabel).Caption,SW_SHOWNORMAL,true);
end;

END.