📄 about.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 + -