发信人: daji(妲姬)
整理人: teleme(2001-06-15 17:59:16), 站内信件
|
///////////////////////////////////////////////////////
// Start Button Animation Program
// by I MD.CIPTAYASA (c) 2000
// for Windows 95
// Description : It just animate your start button and stay in Traybar
// so it's just for fun !
//
// Fell free to modify and utilize for personal interest only
// E-Mail : [email protected]
// Alt. : 0620341553490
// ++++++++++++++++++++++++++++++++++++++++++++++++++
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls,ShellAPI;
const
MAX_BUFFER = 6;
type
TForm1 = class(TForm)
Button1: TButton;
Timer1: TTimer;
Button2: TButton;
Image1: TImage;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button3Click(Sender: TObject);
private
HW : HWND;
DC : HDC;
R : TRect;
FNumber : integer;
Buffer : array[1..MAX_BUFFER] of TBitmap;
TrayIcon : TNotifyIconData;
procedure CreateFrames;
procedure DestroyFrames;
procedure BuildFrames;
procedure NotifyIcon(var Msg : TMessage);message WM_USER + 100;
procedure OnMinimizeEvt(Sender : TObject);
end;
var
Form1: TForm1;
implementation
uses Math;
{$R *.DFM}
// Create buffer for sprites
procedure TForm1.CreateFrames;
var
i : integer;
begin
for i:=1 to MAX_BUFFER do
begin
Buffer[i] := TBitmap.Create;
Buffer[i].Height := R.Bottom-R.Top;
Buffer[i].Width := R.Right-R.Left;
Buffer[i].Canvas.Brush.Color := clBtnFace;
Buffer[i].Canvas.Pen.Color := clBtnFace;
Buffer[i].Canvas.Rectangle(0,0,Buffer[i].Width,Buffer[i].Height);
end;
end;
procedure TForm1.DestroyFrames;
var
i : integer;
begin
for i:=1 to MAX_BUFFER do
begin
Buffer[i].Destroy;
end;
end;
// Prepare animation segments/sprites
procedure TForm1.BuildFrames;
var
i,j,k,H,W : integer;
Y : double;
begin
H := R.Bottom-R.Top;
W := R.Right-R.Left;
Image1.Width := W;
Image1.Height:= H;
for i := 1 to MAX_BUFFER-1 do //Buffer[MAX_BUFFER] is used to hold the original bitmap
for j:= 1 to W do
for k:=1 to H do
begin
Y := 2*Sin((j*360/W)*(pi/180)-20*i);
Buffer[i].Canvas.Pixels[j,k-Round(Y)]:= Buffer[6].Canvas.Pixels[j,k];
end;
end;
procedure TForm1.OnMinimizeEvt(Sender : TObject);
begin
ShowWindow(Application.Handle,SW_HIDE);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
HW := FindWindowEx(FindWindow('Shell_TrayWnd',nil),0,'Button',nil);
GetWindowRect(HW,R);
DC := GetWindowDC(HW);
CreateFrames;
FNumber :=1;
TrayIcon.cbSize := SizeOf(TrayIcon);
TrayIcon.Wnd := Form1.Handle;
TrayIcon.uID := 100;
TrayIcon.uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
TrayIcon.uCallbackMessage := WM_USER + 100;
TrayIcon.hIcon := Application.Icon.Handle;
Shell_NotifyIcon(NIM_ADD,@TrayIcon);
Application.OnMinimize := OnMinimizeEvt;
end;
// Notify handler
procedure TForm1.NotifyIcon(var Msg : TMessage);
begin
case Msg.LParam of
WM_LBUTTONDBLCLK :
begin
ShowWindow(Application.Handle,SW_SHOW);
Application.Restore;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
//Get the original button face and will be used later to revert
//the start button when animation is done
BitBlt(Buffer[MAX_BUFFER].Canvas.Handle,0,0,R.Right-R.Left,R.Bottom-R.Top,
DC,0,0,SRCCOPY);
BuildFrames;
Image1.Canvas.Draw(0,0,Buffer[MAX_BUFFER]);
Button2.Enabled := true;
if Edit1.Text <> '' then
Timer1.Interval := StrToInt(Edit1.Text)
else
begin
Timer1.Interval := 100;
Edit1.Text := '100';
end;
end;
// Resource cleaning up
procedure TForm1.FormDestroy(Sender: TObject);
begin
Timer1.Enabled := false;
BitBlt(DC,0,0,R.Right-R.Left,R.Bottom-R.Top,
Buffer[MAX_BUFFER].Canvas.Handle,0,0,SRCCOPY);
ReleaseDC(HW,DC);
DestroyFrames; // don't ever forget to do this !
Shell_NotifyIcon(NIM_DELETE,@TrayIcon);
end;
// Animation stuff goes here
procedure TForm1.Timer1Timer(Sender: TObject);
begin
BitBlt(DC,0,0,R.Right-R.Left,R.Bottom-R.Top,
Buffer[FNumber].Canvas.Handle,0,0,SRCCOPY);
Inc(FNumber);
if (FNumber > MAX_BUFFER-1) then FNumber := 1;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled := not Timer1.Enabled;
if not Timer1.Enabled then
begin
BitBlt(DC,0,0,R.Right-R.Left,R.Bottom-R.Top,
Buffer[MAX_BUFFER].Canvas.Handle,0,0,SRCCOPY);
Button2.Caption := '&Animate';
Button1.Enabled := true;
end
else
begin
Button2.Caption := '&Stop';
Button1.Enabled := false;
end;
end;
// Ensure entering numeric value
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in ['0'..'9']) and (Key <> Chr(VK_BACK)) then
Key := #0;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone;
Application.Minimize;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
PostMessage(Form1.Handle,WM_DESTROY,0,0);
Application.Terminate;
end;
end.
----
^^ `_ ,
^^ | | | Hello, -(_)-
^^ )_) )_) )_) My Friends! , `
姬海涵 )___))___))___)\ ,
)____)____)_____)\\ __)\_
妲姬网苑 _____|____|____|____\\\__ (\_.-' a`-.
---------\ /--------(/~~````(/~^^`--------
^^^^^ ^^^^^^^^^^^^^^^^^^^^^
^^^^ ^^^^ ^^^ ^^ [email protected]
^^^^ ^^^
|
|