⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 about.pas

📁 扫描空文件
💻 PAS
字号:
unit About;

interface

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

type
  TForm_About = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label5: TLabel;
    Label_web: TLabel;
    Label_email: TLabel;
    exitabout: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure Label_emailClick(Sender: TObject);
    procedure Label_webClick(Sender: TObject);
    procedure Label_emailMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Label_webMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure exitaboutClick(Sender: TObject);
  private
    { Private declarations }
    formmove:boolean;
  public
    { Public declarations }
  end;

procedure FDown(MForm:TForm;Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
procedure FMove(MForm:TForm;Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
procedure FUp(MForm:TForm;Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);

var
  Form_About: TForm_About;
  c:TCanvas;
  Origin:TPoint;
  OriginOld:TPoint;


implementation
{$R *.DFM}

procedure FDown(MForm:TForm;Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
       //初始化画布与画笔的参数
        c:=TCanvas.Create;
        c.pen.Style :=psdot;
        c.brush.Style :=bsClear;
        c.pen.Width :=5;
        c.Pen.Mode :=pmNotXor;
        c.Handle :=GetDC(0);

        Origin.x :=X;
        Origin.y :=Y;
        OriginOld.x :=MForm.Left;
        OriginOld.y :=MForm.Top;
        c.Rectangle(MForm.left,MForm.top,MForm.Left+MForm.width,MForm.top+MForm.height);
end;

procedure FMove(MForm:TForm;Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
          c.Rectangle(OriginOld.x,OriginOld.y,OriginOld.x+MForm.Width,OriginOld.y+MForm.Height);
        OriginOld.x :=MForm.Left +X-Origin.x;
        OriginOld.y :=MForm.Top +Y-Origin.y;
        c.Rectangle(OriginOld.x,OriginOld.y,OriginOld.x+MForm.Width,OriginOld.y+MForm.Height);
end;

procedure FUp(MForm:TForm;Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
        c.Rectangle(OriginOld.x,OriginOld.y,OriginOld.x+MForm.Width,OriginOld.y+MForm.Height);
        MForm.Left :=OriginOld.x;
        MForm.Top :=OriginOld.y;
        c.Free;
end;

procedure TForm_About.FormCreate(Sender: TObject);
begin
        formmove:=false;
end;

procedure TForm_About.Label_emailClick(Sender: TObject);
begin
        shellExecute(handle,nil,pchar(Label_email.Hint),
                nil,nil,sw_shownormal);
end;

procedure TForm_About.Label_webClick(Sender: TObject);
begin
        shellExecute(handle,nil,pchar(Label_web.Hint),nil,nil,sw_shownormal);
end;

procedure TForm_About.Label_emailMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
        Label_email.Font.Color :=clGreen;
end;

procedure TForm_About.Label_webMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
        Label_web.Font.Color :=clGreen;
end;

procedure TForm_About.Image1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
     if ssDouble in Shift then exit;
     if button=mbleft then
     begin
        formmove:=true;
        FDown(Form_About,Sender,Button,Shift,X,Y);
     end;
end;

procedure TForm_About.Image1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
        Label_email.Font.Color :=clAqua;
        Label_web.Font.Color :=clAqua;
        if not Formmove then exit;
       FMove(Form_About,Sender,Shift,X,Y);
end;

procedure TForm_About.Image1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
        if not formmove then exit;
        formmove:=false;
        FUP(Form_About,Sender,Button,Shift,X,Y);
end;

procedure TForm_About.exitaboutClick(Sender: TObject);
begin
        self.close;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -