📄 about.pas
字号:
unit About;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ToolWin,ExtCtrls,buttons, ADODB, ImgList,shellapi;
type
TAboutForm = class(TForm)
Panel1: TPanel;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Image2: TImage;
StaticText1: TStaticText;
procedure CreateParams(var Params: TCreateParams); override;
procedure FormCreate(Sender: TObject);
procedure Label3Click(Sender: TObject);
procedure Label3MouseEnter(Sender: TObject);
procedure Label3MouseLeave(Sender: TObject);
procedure StaticText1Click(Sender: TObject);
procedure StaticText1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StaticText1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
procedure WMPAINT1(var msg:TMESSAGE);message WM_PAINT;
procedure WMNCPAINT1(var msg:TWMNCPAINT);message WM_NCPAINT;
procedure Active(var msg:Tmessage);message WM_ACTIVATE;
procedure WMNCLBUTTONDBLCLK1(var msg:Tmessage);message WM_NCLBUTTONDBLCLK;
{ Private declarations }
public
titleBmp:Tbitmap;
{ Public declarations }
end;
implementation
uses MainForm,DataModule;
{$R *.dfm}
procedure TAboutForm.WMNCLBUTTONDBLCLK1(var msg:Tmessage);
begin
//
end;
procedure TAboutForm.Active(var msg:Tmessage);
begin
self.WMPAINT1(msg);
end;
procedure TAboutForm.CreateParams(var Params: TCreateParams);
begin
inherited;
params.Style:=params.Style-WS_SYSMENU;
end;
procedure TAboutForm.WMPAINT1(var msg:TMESSAGE);
begin
sendmessage(self.Handle,WM_NCPAINT,0,0);
inherited;
end;
procedure TAboutForm.WMNCPAINT1(var msg:TWMNCPAINT);
var
dc1:HDC;
y,frame:integer;
oldbrush:HBrush;
oldpen,pen:HPEN;
canvas:Tcanvas;
begin
canvas:=Tcanvas.Create;
dc1:=getwindowdc(Handle);
y:=GetSystemMetrics(SM_CYSIZE);
frame:=GetSystemMetrics(SM_CYSIZEFRAME);
oldbrush:=selectobject(dc1,getstockobject(null_brush));
pen:=createpen(PS_SOLID,1,rgb(155,155,155));
oldpen:=selectobject(dc1,pen);
RoundRect(dc1,0,0,Width,Height,12,12);
pen:=createpen(PS_SOLID,frame*2-5,rgb(255,255,255));
selectobject(dc1,pen);
RoundRect(dc1,2,2,Width-2,Height-2,8,10);
StretchBlt(dc1,frame,frame,Width-2*frame,y+frame div 2,titlebmp.Canvas.Handle,0,0,titlebmp.Width,titlebmp.Height,srccopy);
canvas.Handle:=dc1;
canvas.Brush.Style:=bsclear;
canvas.TextOut(frame*3,(y-frame)div 2,self.Caption);
selectobject(dc1,oldbrush);
selectobject(dc1,oldpen);
deleteObject(pen);
canvas.Handle:=0;
canvas.Free;
releasedc(Handle,dc1);
end;
procedure TAboutForm.FormCreate(Sender: TObject);
begin
titlebmp:=Tbitmap.Create;
titlebmp.LoadFromResourceName(main.resource,'TItle');
end;
procedure TAboutForm.Label3Click(Sender: TObject);
begin
shellexecute(self.Handle,nil,'http://www.mingrisoft.com',nil,nil,sw_shownormal);
end;
procedure TAboutForm.Label3MouseEnter(Sender: TObject);
begin
label3.Font.Color:=clred;
end;
procedure TAboutForm.Label3MouseLeave(Sender: TObject);
begin
label3.Font.Color:=clBlack;
end;
procedure TAboutForm.StaticText1Click(Sender: TObject);
begin
close;
end;
procedure TAboutForm.StaticText1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
statictext1.BevelKind:=bkSoft;
end;
procedure TAboutForm.StaticText1MouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
statictext1.BevelKind:=bkTile;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -