unitfrmflash.pas

很不错的非线性回归分析程序

unit UnitfrmFlash;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, jpeg, ExtCtrls, RunExe_Hss, FileVision_hss;

type
  TfrmFlash = class(TForm)
    ImageTop: TImage;
    LabelAppNameB: TLabel;
    LabelAppName: TLabel;
    PanelFlash: TPanel;
    BevelLine0: TBevel;
    BevelLine2: TBevel;
    BevelLine1: TBevel;
    BevelLine3: TBevel;
    ImageIcon: TImage;
    LabelVertionCaption: TLabel;
    LabelVertion: TLabel;
    LabelBuildcaption: TLabel;
    LabelBuild: TLabel;
    BevelLineTop: TBevel;
    BevelLinebottom: TBevel;
    Imagebottom: TImage;
    ImageTopP: TImage;
    ImageLeft: TImage;
    ImageRigth: TImage;
    LabelAuthorCaption: TLabel;
    LabelAuthor: TLabel;
    TimerClose: TTimer;
    Button1: TButton;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ImageTopMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure ImageTopMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImageTopMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure TimerCloseTimer(Sender: TObject);
    procedure PanelFlashDblClick(Sender: TObject);
    procedure Label2Click(Sender: TObject);



  private
     MsMove:boolean;
     MsPos:Tpoint;
     frmL,frmT:integer;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmFlash: TfrmFlash;
  
implementation

{$R *.dfm}

procedure TfrmFlash.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=cafree;  
end;

procedure TfrmFlash.ImageTopMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button=mbLeft then
  begin
    GetCursorPos(MsPos);
    frmL:=self.Left;
    frmT:=self.Top;
    MsMove:=true;
  end;
end;

procedure TfrmFlash.FormCreate(Sender: TObject);
var  
   info:  TFileInfo;
   L   :  integer;
   
   function GetRightDot(const str:string):integer;
   var
     i  :integer;
   begin
     for i:=length(str) downto 1 do
     begin
       if str[i]='.' then
       begin
         result:=i;
         exit;
       end;
     end;
     result:=0;
   end;
begin  
  if  GetFileVersionInfomation(application.ExeName,  info,'WOW  Version')  then
  begin
    L:=GetRightDot(info.FileVersion);
    self.LabelVertion.Caption:=copy(info.FileVersion,1,L-1);
    self.LabelBuild.Caption:=copy(info.FileVersion,L+1,length(info.FileVersion)-L);
  end
  else
  begin
    self.LabelVertion.Caption:='Not Get it!';
    self.LabelBuild.Caption:='Not Get it!';
  end;
  MsMove:=false;
end;

procedure TfrmFlash.ImageTopMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    MsMove:=false;
end;

procedure TfrmFlash.ImageTopMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  MsPosT  :Tpoint;
begin
  if MsMove then
  begin
    GetCursorPos(MsPosT);
    self.Left:=frmL+MsPosT.X-MsPos.X;
    self.Top:=frmT+MsPosT.Y-MsPos.Y;
  end;
end;

procedure TfrmFlash.Button1Click(Sender: TObject);
begin
  self.Close;
end;

procedure TfrmFlash.TimerCloseTimer(Sender: TObject);
begin
  self.Close;
end;

procedure TfrmFlash.PanelFlashDblClick(Sender: TObject);
begin
  self.Close;
end;

procedure TfrmFlash.Label2Click(Sender: TObject);
begin
  ShellExecute(application.handle,'open','mailto:[e-mail]','','', SW_NORMAL)
end;

end.