精华区 [关闭][返回]

当前位置:网易精华区>>讨论区精华>>编程开发>>● Delphi>>Windows API函数>>[文章]如何给自己的程序制作复活节彩蛋

主题:[文章]如何给自己的程序制作复活节彩蛋
发信人: delphifan()
整理人: windfire(2000-12-05 19:54:18), 站内信件
                    如何给自己的程序制作复活节彩蛋

                          西安      梁  明



     自己的程序完成了,见到大部分程序都有他们的复活节彩蛋,心里好羡慕!
当时也想为自己做点广
     告,于是就有下面的代码(Hello,可别为我做广告噢!)。 
     下面是源代码: 
     //主窗体
     unit Unit1;

     interface

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

     type
     TForm1 = class(TForm)
     Button1: TButton;
     StatusBar1: TStatusBar;
     procedure Button1Click(Sender: TObject);
     private
     { Private declarations }
     public
     { Public declarations }
     end;

     var
     Form1: TForm1;

     implementation

     uses About;

     {$R *.DFM}

     procedure TForm1.Button1Click(Sender: TObject);
     begin
     aboutbox.showmodal;
     end;

     end.
     //About窗体
     {=============通用About程序源代码=============}
     {                                              }
     {    _/\_/\__ Copyright by 梁 明 __/\_/\_     }
     {                           1998-01-02          }
     {                                              }
     {=============================================}
     unit About;

     interface

     uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCt
rls,
     Buttons, ExtCtrls,Dialogs;

     type
     TAboutBox = class(TForm)
     Panel1: TPanel;
     ProgramIcon: TImage;
     ProductName: TLabel;
     Version: TLabel;
     Copyright: TLabel;
     others: TLabel;
     Author: TPaintBox;
     BitBtn1: TBitBtn;
     Bevel1: TBevel;
     lblOs: TLabel;
     lblMemory: TLabel;
     procedure FormCreate(Sender: TObject);
     procedure ProgramIconClick(Sender: TObject);
     procedure OKButtonClick(Sender: TObject);
     procedure FormKeyPress(Sender: TObject; var Key: Char);
     private
     { Private declarations }
     s:string;
     Procedure Delay(x,y:word);//延时程序
     procedure GetOSInfo; //系统信息程序
     Procedure GetMemoryInfo ; //可用资源程序
     public
     { Public declarations }
     end;

     var
     AboutBox: TAboutBox;

     implementation

     {$R *.DFM}
     Procedure TAboutBox.GetMemoryInfo ;//可用资源
     var
     MS: TMemoryStatus;
     begin
         MS.dwLength := SizeOf(TMemoryStatus);
         GlobalMemoryStatus(MS);
     lblMemory.Caption :=lblMemory.Caption +FormatFloat('#,###" KB"', 
MS.dwTotalPhys div
     1024);
     end;

     procedure TAboutBox.GetOSInfo; //获取系统信息
     var
     Platform: string;
     BuildNumber: Integer;
     begin
     case Win32Platform of
     VER_PLATFORM_WIN32_WINDOWS:
     begin
     Platform := 'Windows 95';
     BuildNumber := Win32BuildNumber and $0000FFFF;
     end;
     VER_PLATFORM_WIN32_NT:
     begin
     Platform := 'Windows NT';
     BuildNumber := Win32BuildNumber;
     end;
     else
     begin
     Platform := 'Windows';
     BuildNumber := 0;
     end;
     end;
     if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) or
     (Win32Platform = VER_PLATFORM_WIN32_NT) then
     begin
     if Win32CSDVersion = '' then
     lblOS.Caption := lblOS.Caption+Format('%s %d.%d (Build %d)', [Pla
tform,
     Win32MajorVersion,
     Win32MinorVersion, BuildNumber])
     else
     lblOS.Caption := lblOS.Caption+Format('%s %d.%d (Build %d: %s)', 
[Platform,
     Win32MajorVersion,
     Win32MinorVersion, BuildNumber, Win32CSDVersion]);
     end
     else
     lblOS.Caption := lblOS.Caption+Format('%s %d.%d', [Platform, Win3
2MajorVersion,
     Win32MinorVersion])
     end;

     procedure Taboutbox.Delay(x,y:word);
     var timeout:TDateTime;
     begin
     //该成为WINDOWS APP启动时间这个函数来做!
     timeout:=now+encodeTime(0,x div 60,x mod 60,y);
     While now<timeout do
Application.ProcessMessages;
end;


procedure TAboutBox.FormCreate(Sender: TObject);
begin
{**********************************************}
try
Caption:='关于'+application.Title; //标题
ProgramIcon.Picture.icon:=Application.Icon; //图标
ProductName.Caption:=ProductName.Caption+Application.Title;//产品
名称
version.Caption:=version.Caption+'1.00'; //版本
Copyright.Caption:=Copyright.Caption+'中国 ● 西安 梁明工作室 ';

others.Caption:='警 告:未经允许,任何个人、单位不得以任何方式'+#
13#10+
'非法拷贝、盗用!否则,系统在运行过程中出现的任何'+#13#10+
'问题作者将不负任何连带责任!';
////初始化---------------------------
GetMemoryInfo;
GetOsinfo;
{***********************}
//初始化变量s...
s:='';
except
MessageBox(handle,'某些信息不能取得','提示',MB_OK);
end;
end;

procedure TAboutBox.ProgramIconClick(Sender: TObject);
var i,fontheight:Byte;
begin
try
panel1.Hide;
fontheight:=author.Canvas.TextHeight('A');
for i:=0 to 150+fontHeight*8 do
if not panel1.Visible then //在此处添加说明
with author.Canvas do
begin
textout(25,100-i,'感谢您选用"'+Application.Title+'"系统!');
textout(25,100+fontheight-i,'');
textout(25,100+fontheight*2-i,'系统说明——');
textout(25,100+fontheight*3-i,'软件作者:梁 明');
textout(25,100+fontheight*4-i,'开发前端:Borland Delphi 4.0');
textout(25,100+fontheight*5-i,'数据处理:Borland Paradox 7.0');
textout(25,100+fontheight*6-i,'开发周期:99/02/10-99/02/13');
textout(25,100+fontheight*7-i,'');
textout(25,100+fontheight*8-i,'技术支持——');
textout(25,100+fontheight*9-i,'热线支持:(029)7295153 梁先生');
textout(25,100+fontheight*10-i,'方便传呼:126-5030345 梁先生');
textout(25,100+fontheight*11-i,'电子邮件:[email protected]');
textout(25,100+fontheight*12-i,'网上服务:liangming.163.net');
textout(25,100+fontheight*13-i,'');
textout(25,100+fontheight*14-i,' 梁 明 于梁明工作室 ');
textout(25,100+fontheight*15-i,' 1999/02/10');
Delay(0,20);
end;
finally
panel1.Show;
Aboutbox.Refresh;
end;
end;

procedure TAboutBox.OKButtonClick(Sender: TObject);
begin
panel1.Show;
Aboutbox.Refresh;
close;
end;

procedure TAboutBox.FormKeyPress(Sender: TObject; var Key: Char);

begin
s:=s+key; //用户输入"Author"这显示
if StrUpper(Pchar(s))='AUTHOR' then
begin
ProgramIconclick(sender);
s:=''
end;
end;

end.

窗体As text代码
//主窗体
object Form1: TForm1
Left = 195
Top = 103
Width = 324
Height = 186
Caption = '演示-->梁明'
     Color = clBtnFace
     Font.Charset = GB2312_CHARSET
     Font.Color = clWindowText
     Font.Height = -12
     Font.Name = '宋体'
     Font.Style = []
     OldCreateOrder = False
     PixelsPerInch = 96
     TextHeight = 12
     object Button1: TButton
     Left = 192
     Top = 48
     Width = 75
     Height = 25
     Hint = '显示关于对话框'
     Caption = '关于...'
     ParentShowHint = False
     ShowHint = True
     TabOrder = 0
     OnClick = Button1Click
     end
     object StatusBar1: TStatusBar
     Left = 0
     Top = 140
     Width = 316
     Height = 19
     AutoHint = True
     Panels = <
item
Width = 50
end>
     SimplePanel = False
     end
     end 

     //About窗体
     object AboutBox: TAboutBox
     Left = 410
     Top = 92
     BorderStyle = bsDialog
     ClientHeight = 213
     ClientWidth = 362
     Color = clBtnFace
     Font.Charset = GB2312_CHARSET
     Font.Color = clWindowText
     Font.Height = -12
     Font.Name = '宋体'
     Font.Style = []
     Icon.Data = {
     0000010001002020100000000000E80200001600000028000000200000004000

     0000010004000000000080020000000000000000000000000000000000000000

     000000008000008000000080800080000000800080008080000080808000C0C0

     C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF000000

     0000000000000000000000000000000000000000000000000000000000000000

     0000000000000000000000000000000000000000000000000000000000000000

     0000000000000330000000000000000000000033303303303300000000000000

     0003303330333003003300000000000000033003330330002333000000000000

     0030000033003033333000000000000033333330000003330003330000000803

     33333333333333300233330000000F033333333333333302333BB03000004F83

     33333333333333333BB003BB00004FF3333333333333B33BB0033BBB00004FF3

     33333333B3BB3BB0033BBBB000004FF83B333B3B3B3BBBB03BBBBB0300F04FFF

     33B3B3B3BBBBBBBBBBBB00330FF04FFF8B3B3333BBBBBBBBBB0033330FF044FF

     F8BBB03033BBBBB330333330FFF444FFF8BB0BB3003B330003333330FF44444F

     F88B3BBB300000033333B33FFF44444FFF3BB0BBB3000333B33BB38FF4444444

     FF003B0BB333333BBBBBB3FFF44444444FF00030BBBBBBBBBBBBBBFF44444444

     0000000303BBB3300000BFF444444400000000000000000000000FF444440000

     0000000000000000000000444444000000000000000000000000000044440000

     0000000000000000000000000444000000000000000000000000000000040000

     000000000000000000000000000000000000000000000000000000000000FFFF

     FFFFFFFFFFFFFFFF1FFFFF8003FFFC0000FFF800007FF800007FE000003F0000

     001F0000001F0000000F00000007000000070000000000000000000000000000

     00000000000000000000000000000000000000000000000000000000000000C0

     00000FE01F003FFFFF80FFFFFFC0FFFFFFF0FFFFFFF8FFFFFFFEFFFFFFFF}
     KeyPreview = True
     OldCreateOrder = True
     Position = poScreenCenter
     OnCreate = FormCreate
     OnKeyPress = FormKeyPress
     PixelsPerInch = 96
     TextHeight = 12
     object Author: TPaintBox
     Left = 0
     Top = 8
     Width = 364
     Height = 159
     Font.Charset = GB2312_CHARSET
     Font.Color = clBlue
     Font.Height = -12
     Font.Name = '宋体'
     Font.Style = []
     ParentFont = False
     end
     object Panel1: TPanel
     Left = 8
     Top = 7
     Width = 347
     Height = 170
     BevelOuter = bvNone
     ParentColor = True
     TabOrder = 0
     object ProgramIcon: TImage
     Left = 13
     Top = 7
     Width = 32
     Height = 32
     AutoSize = True
     OnClick = ProgramIconClick
     IsControl = True
     end
     object ProductName: TLabel
     Left = 60
     Top = 9
     Width = 60
     Height = 12
     Caption = '系统名称:'
     Font.Charset = GB2312_CHARSET
     Font.Color = clWindowText
     Font.Height = -12
     Font.Name = '宋体'
     Font.Style = []
     ParentFont = False
     IsControl = True
     end
     object Version: TLabel
     Left = 60
     Top = 25
     Width = 60
     Height = 12
     Caption = '版 本:'
     Font.Charset = GB2312_CHARSET
     Font.Color = clWindowText
     Font.Height = -12
     Font.Name = '宋体'
     Font.Style = []
     ParentFont = False
     IsControl = True
     end
     object Copyright: TLabel
     Left = 60
     Top = 41
     Width = 60
     Height = 12
     Caption = '版权所有:'
     IsControl = True
     end
     object others: TLabel
     Left = 13
     Top = 124
     Width = 6
     Height = 12
     end
     object Bevel1: TBevel
     Left = -8
     Top = 109
     Width = 344
     Height = 7
     Shape = bsBottomLine
     end
     object lblOs: TLabel
     Left = 13
     Top = 80
     Width = 60
     Height = 12
     Caption = '操作系统:'
     IsControl = True
     end
     object lblMemory: TLabel
     Left = 13
     Top = 96
     Width = 60
     Height = 12
     Caption = '可用内存:'
     IsControl = True
     end
     end
     object BitBtn1: TBitBtn
     Left = 145
     Top = 184
     Width = 80
     Height = 25
     Caption = '确定'
     Default = True
     ModalResult = 2
     TabOrder = 1
     OnClick = OKButtonClick
     Glyph.Data = {
     DE010000424DDE01000000000000760000002800000024000000120000000100

     0400000000006801000000000000000000001000000010000000000000000000

     80000080000000808000800000008000800080800000C0C0C000808080000000

     FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333

     3333333333333333333333330000333333333333333333333333F33333333333

     00003333344333333333333333388F3333333333000033334224333333333333

     338338F3333333330000333422224333333333333833338F3333333300003342

     222224333333333383333338F3333333000034222A22224333333338F338F333

     8F33333300003222A3A2224333333338F3838F338F33333300003A2A333A2224

     33333338F83338F338F33333000033A33333A222433333338333338F338F3333

     0000333333333A222433333333333338F338F33300003333333333A222433333

     333333338F338F33000033333333333A222433333333333338F338F300003333

     33333333A222433333333333338F338F00003333333333333A22433333333333

     3338F38F000033333333333333A223333333333333338F830000333333333333

     333A333333333333333338330000333333333333333333333333333333333333

     0000}
     NumGlyphs = 2
     end
     end

       
       
     版主:梁明
     日期:1999-03-09-19:30
     E-mail:[email protected] 


--
+===========请与我联系(Please remember me)===========+
+                                                    +
+                [email protected]                   +
+                                                    + 
+         http://www4.netease.com/~delphifan         +

※ 来源:.月光软件站 http://www.moon-soft.com.[FROM: 202.100.29.199]

[关闭][返回]