怎样将一个DLL注入另一个进程（HOOK方式或注册表加载方式不算）？(200分)

而且在加载程序卸去后，注入的DLL继续运行。考虑使用CreateRemoteThread来实现，但
没有成功。各位大侠请指点，帖出有效源代码者，200大洋就是您的啦！

gz

卑鄙的3721：
Rundll32.exe D:/WINNT/DOWNLO~1/CnsMin.dll,Rundll32

我用debugactiveprocess和setcontext做过一个，但效果不很理想，因为debug一个进程的话，我的程序
1退出，被debug的程序(也就是dll注入的程序)也就退出了：（
不过听说有不用debugactiveprocess也可获得threadid（setcontext要用）的方法（9x下）
如果有人知道请帖出来。
要原码的话，mail我：
ｔｔｕｉ＠１６３．ｃｏｍ

呵呵，到PLAYICQ。COM找，有原代码

LoabLibrary試試

[8D]从源码空间抄下来的，正好合适你，不过不能用于win95&98
//DLL 工程文件
{******************************************************************************
* Program Clock
* Description:
* To show a transparent window as a clock on desktop.
* Support time schedule
* CopyRight (C) GanHuaXin 2001-1-8
* Code Tool : Delphi 5.0
* All code is writen by SDK
* All Rignt Reserved!
* Date :
* New Develop : 2001-1-8
* Modify : 2001-1-9
******************************************************************************}

library Clock;

uses
Windows,
Messages,
untTool in 'untTool.pas',
untConst in 'untConst.pas',
untMsgHdl in 'untMsgHdl.pas',
untHint in 'untHint.pas';

{$R Gan_SDK.RES}

{******************************************************************************
* Function InitApplication(hInstance)
* Purpose:
* Initial Appliaction and Register the window class
* Parmeters:
* hInstance : Application Instance Handle
* Return Value:
* it return the RegisterClass()'s return's Value
******************************************************************************}
function InitApplication(hInstance : THANDLE):bool;
var
ParentWndClass : TWndClass;
WndClass : TWndClass;
begin
ParentWndClass.hInstance := hInstance;
With ParentWndClass do begin
style := 0;
lpfnWndProc := @ParentMainProc;
cbClsExtra := 0;
cbWndExtra := 0;
hCursor := LoadCursor(0,IDC_ARROW);
lpszMenuName := nil;
hbrBackground := GetStockObject(BLACK_BRUSH);
hIcon := LoadIcon(hInstance,'ICON_APP');
lpszClassName := 'GanParentClock';
end;

WndClass.style := 0;
WndClass.lpfnWndProc := @MainProc;
WndClass.cbClsExtra := 0;
WndClass.cbWndExtra := 0;
WndClass.hInstance := hInstance;
WndClass.hCursor := LoadCursor(0,IDC_HAND);
WndClass.lpszMenuName := nil;
WndClass.hbrBackground := GetStockObject(BLACK_BRUSH);
WndClass.hIcon := //LoadIcon(0,IDI_APPLICATION );
LoadIcon(hInstance,'ICON_APP');
WndClass.lpszClassName := 'GanClock';
result := BOOL(RegisterClass(WndClass) and RegisterClass(ParentWndClass));
end;

{******************************************************************************
* Function InitWindow(hWnd)
* Purpose:
* To initial the Window whose handle equal hWnd
* Date :
* New Development : 2001-01-08
* Modiefied :
******************************************************************************}
function InitWindow(hWnd:HWND):BOOL;
var
WinRect : TRect;
bOpt : Boolean;
dwStyle : integer;
begin
//
// to set the window Region
//
result := false;
if hWnd = 0 then exit;
if not GetWindowRect(hWnd,WinRect) then exit;
WinRect.Right := WinRect.Right - WinRect.Left;
WinRect.Bottom := WinRect.Bottom - WinRect.Top;
WinRect.Top := 0;
WinRect.Left := 0;

//
// Set Special Style
//
SetWindowLong(hWnd,GWL_STYLE,378470400 xor WS_THICKFRAME
xor WS_MAXIMIZEBOX xor WS_BORDER xor WS_MINIMIZEBOX or WS_POPUP);
//
// Set whether window all with on top?
//
GetRegAllOnTop(bOpt);
SetWindowAllOnTop(hWnd,bOpt);
//
// determine whether Set a icon on tray area
//
GetRegShowTray(bOpt);
if bOpt then
ShowOnTray(hWnd);
GetRegShowOnTaskBar(bOpt);
if bOpt then
ShowWindow(ParentWnd,SW_SHOW)
else
ShowWindow(ParentWnd,SW_HIDE);
//
// Set whether transparent ?
//
GetRegTransparent(bOpt);
SetWindowTransparent(hWnd,not bOpt);
SetWindowTransparent(hWnd,bOpt);

result := true;
end;


{******************************************************************************
* Fuction InitInstance(hInstance:THandle,nCmdShow:INT,hWnd:THANDLE)
* Purpose:
* To create the registered windows and show it as nCmdShow
* Parmeters:
* hInstance : Application Instance
* nCmdShow : The Window Show Method
* hWnd : The created Window Handle
* Return Value:
* if success create the window return the window's handle
* else return 0
******************************************************************************}
function InitInstance(
hInstance:THANDLE;
nCmdShow:integer;
var hWnd:THandle):bool;
var
RegWindowPos : TMyWindowPos;
SysMenu : HMENU;
//ParentWnd : THandle;
begin
// at first , creat a UnVisible parent window
ParentWnd := CreateWindow(
'GanParentClock',
'Huiyu Clock',
WS_CLIPSIBLINGS or WS_SYSMENU,
-20,-20,0,0,
0,0,hInstance,nil);
if ParentWnd = 0 then begin
result := false;
exit;
end;
// to modify the System Menu ! Cool!
SysMenu := GetSystemMenu(ParentWnd,False);
DeleteMenu(SysMenu,SC_MOVE,MF_BYCOMMAND);
DeleteMenu(SysMenu,SC_MAXIMIZE,MF_BYCOMMAND);
DeleteMenu(SysMenu,SC_MINIMIZE,MF_BYCOMMAND);
DeleteMenu(SysMenu,SC_SIZE,MF_BYCOMMAND);
DeleteMenu(SysMenu,SC_RESTORE,MF_BYCOMMAND);
DeleteMenu(SysMenu,0,MF_BYPOSITION);
InsertMenu(SysMenu,1,MF_STRING or MF_BYPOSITION,IDM_ABOUT,'About');
InsertMenu(SysMenu,1,MF_STRING or MF_BYPOSITION,IDM_OPTION,'Option');
InsertMenu(SysMenu,1,MF_SEPARATOR or MF_BYPOSITION,0,'');

// then create my self clock window
GetPlacePos(RegWindowPos);
hWnd := CreateWindow(
'GanClock',
'Hello World!This is a test for sdk program!',
WS_POPUP or WS_OVERLAPPED or WS_CLIPSIBLINGS,
RegWindowPos.Left,
RegWindowPos.Top,
RegWindowPos.Width,
RegWindowPos.Width,
ParentWnd,//}0,
0,
hInstance,
nil
);
if (hWnd<>0) then
begin
ClockWnd := hWnd;
InitWindow(hWnd);
ShowWindow(hWnd,nCmdShow);
SetClockWalk(hWnd);
result := BOOL(True);
end else
result := BOOL(false);
end;

//
// Main procedure entry point
//
var
hWnd : LongWord;
Msg : TMsg;

procedure ThreadProc(p : pointer); stdcall;
begin
//hInstance is the golbal var defined in sysinit.pas
if not InitApplication(hInstance) then halt;
if not InitInstance(hInstance,SW_SHOW,hWnd) then halt;
//RegisterServiceProcess(GetCurrentProcessID, 1);
while GetMessage(Msg,0,0,0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
// sleep(20);
end;
end;

var
hThreadHandle : THandle;

procedure DllMain(dwReason : DWORD);
var
dwThreadID : DWORD;
begin
case dwReason of
DLL_PROCESS_ATTACH :
begin
hThreadHandle := CreateThread(nil, 0, @ThreadProc, nil, 0, dwThreadID);
end;
DLL_PROCESS_DETACH :
begin
SendMessage(hWnd, WM_THREADEXIT, 0, 0);
if (hThreadHandle <> 0) then begin
TerminateThread(hThreadHandle, 0);
end;
end;
DLL_THREAD_ATTACH :
begin
end;
DLL_THREAD_DETACH :
begin
end;
end;
end;

begin
DLLProc := @DLLMain;
DLLMain(DLL_PROCESS_ATTACH);
end.

//
{******************************************************************************
* Uint untConst
* Module is to write some Constant Define , just like c head files
* CopyRight (c) By GanHuaXin 2001
* All Right Reserved
* Date :
* New Develop : 2001-1-9
* Modified : 2001-1-9
******************************************************************************}

unit untConst;

interface

uses
Windows,
Messages;

// some Icons Macro define
const
ICON_APP : PChar = 'APP_ICON';

// some command macro define of Main Window
const
IDM_ABOUT = 101;
IDM_QUIT = 102;
IDM_OPTION = 103;
IDM_ALLONTOP = 104;
IDM_TRANSPARENT = 105;
IDM_HINTSET = 106;
IDM_CLOCKSET = 107;
IDM_CIRCLK = 108;
IDM_DIGCLK = 109;
IDM_STARTWITHWIN= 110;

// some command macro define of Dialog About
const
ID_ABOUT_OK = 101;
ID_ABOUT_LBLEMAIL = 100;

// some constant macro define of Dialog Option
const
// push buttons
ID_OPTION_OK = 113;
ID_OPTION_CANCEL = 114;
ID_OPTION_APPLY = 115;

// Postion Optint Radio Buttons
ID_OPTION_TOPLEFT = 108;
ID_OPTION_TOPCENTER = 109;
ID_OPTION_TOPRIGHT = 110;
ID_OPTION_MIDDLELEFT = 112;
ID_OPTION_MIDDLECENTER = 116;
ID_OPTION_MIDDLERIGHT = 111;
ID_OPTION_BOTTOMLEFT = 117;
ID_OPTION_BOTTOMCENTER = 118;
ID_OPTION_BOTTOMRIGHT = 119;
ID_OPTION_USERPLACE = 120;

// Check Button
ID_OPTION_CHKSTARTWIN = 102;
ID_OPTION_CHKTRANS = 103;
ID_OPTION_CHKALLONTOP = 104;
ID_OPTION_CHKSHOWTRAY = 105;
ID_OPTION_CHKTASKBAR = 106;

// Edits
ID_OPTION_EDITTRANS = 121;
ID_OPTION_EDITWINWIDTH = 122;

// some label
ID_OPTION_LBLDEGREE = 123;
// some constant about Dialog Hint
const
ID_HINT_LBLHINT = 100;
ID_HINT_ISEE = 101;
// some constant about SetLayeredWindowAttributes
const
WS_EX_LAYERED = $80000;
AC_SRC_OVER = $0;
AC_SRC_ALPHA = $1;
AC_SRC_NO_PREMULT_ALPHA = $1;
AC_SRC_NO_ALPHA = $2;
AC_DST_NO_PREMULT_ALPHA = $10;
AC_DST_NO_ALPHA = $20;
LWA_COLORKEY = $1;
LWA_ALPHA = $2;
ULW_COLORKEY = $1;
ULW_ALPHA = $2;
ULW_OPAQUE = $4;

// some constant about the TrayIcon Define
const
WM_TRAYICONNOTIFY = WM_USER + 188;
WM_THREADEXIT = WM_USER + 1234;
ID_TRAYICON = $EEFF;
// Self Define WindowMessage!
const
WM_MYPOSCHANGE = WM_USER + 190;

// some constant about the window
const
WIN_HALF_WIDTH : integer= 40;

const
APP_KEY_STR = 'SoftWare/huiyuSoft/ClockHint/';
APP_KEY_SUBPOS : PChar = 'WindowPosition';
APP_KEY_SUBPOSOPT : PChar = 'WindowPosOpt';
APP_KEY_SUBALLONTOP : PChar = 'WindowAllOnTop';
APP_KEY_SUBTRANSPARENT : PChar = 'WindowTransparent';
APP_KEY_SUBSHOWTRAY : PChar = 'WindowShowTray';
APP_KEY_SUBCLOCKSTYLE : PChar = 'Clock Style';
APP_KEY_SUBSHOWONTASKBAR: PChar = 'Show On TaskBar';
const
M_SUBNAME : PChar = 'Huiyu''''s Clock';
APP_KEY_START :
PChar = 'SOFTWARE/Microsoft/Windows/CurrentVersion/Run';

type
TMyWindowPos = record
Top,
Left : SmallInt; // 16 bit + 16 bit;
Width : SmallInt; // 16 bit
end;

const
DEFAULTPOS : TMyWindowPos =
(Top : 0;
Left : 0;
Width : 100);
const
ParentWnd : THandle = 0;
ClockWnd : THandle = 0;

const
RgnFrame : THandle = 0;
RgnCenter : THandle = 0;
RgnHour : THandle = 0;
RgnMinute : THandle = 0;
RgnSecond : THandle = 0;

LastSecond: integer = 0;
LastMinute: integer = 0;

implementation

end.

//unit untHint;

interface
uses
Windows,
Messages,
untTool,
untConst,
Sysutils;

function DlgHintProc(hDlg: THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;
function SetClockWalk(hWnd:HWND):BOOL;
procedure CloseClockWalk(hWnd:HWND);

implementation

var
hHintBrushStatic : HBRUSH;
hintPStr : PChar = nil;
function DlgHintProc(hDlg: THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;
var
CtlID : integer;
begin
result := BOOL(false);
case Msg of
WM_CREATE:
begin
//hintPStr := StrAlloc(255);
result := BOOL(DefDlgProc(hDlg,Msg,wParam,lParam));
end;
WM_INITDIALOG :
begin
SetWindowInCenter(hDlg);
SetWindowPos(hDlg,HWND_TOPMOST,0,0,0,0,SWP_NOSIZE or SWP_NOMOVE);
//SendMessage(GetDlgItem(GetFocus,ID_HINT_LBLHINT),WM_SETTEXT,
// 0,Integer(hintPStr));
SetDlgItemText(hDlg,ID_HINT_LBLHINT,hintPStr);
StrDispose(hintPStr);
hintPStr := nil;
(*
SetLastError(0);
if SetWindowLong(GetDlgItem(hDlg,ID_ABOUT_LBLEMAIL),GWL_WNDPROC,
LongInt(@DlgAboutLblEmailProc)) = 0 then
MessageBox(GetFocus,PChar('Error to subclass the label:'+
IntToStr(GetLastError)),'Hi',MB_OK);
*)
hHintBrushStatic := CreateSolidBrush(GetSysColor(COLOR_MENU));

result := BOOL(true);
end;
WM_CLOSE :
begin
DeleteObject(hHintBrushStatic);
hHintBrushStatic := 0;
EndDialog(hDlg,integer(true));
result := BOOL(true);
end;
WM_CTLCOLORSTATIC:
begin
ctlID := GetWindowLong(lParam,GWL_ID);
case CtlID of
ID_HINT_LBLHINT:
begin
SetTextColor(wParam,RGB(0,0,255));
SetBkColor(wParam,GetSysColor(COLOR_Menu));
result := BOOL(hHintBrushStatic);
end;
end;
end;
{
WM_CTLCOLORBTN:
begin
CtlID := GetWindowLong(lParam,GWL_ID);
case CtlID of
ID_HINT_ISEE:
begin
SetTextColor(wParam,RGB(255,0,0));
SetBkColor(wParam,GetSysColor(COLOR_MENU));
result := BOOL(hHintBrushStatic);
end;
end;
end;
}
WM_COMMAND:
begin
if (lParam<>0) then begin // from a control
case LO(wParam) of
ID_HINT_ISEE:
begin
SendMessage(hDlg,WM_CLOSE,0,0);
end;
end;
end;
end;
end;
end;

//
// the following function is write for set the window bitmap rgn
//
function ShouldChangeHour(time : SYSTEMTIME):BOOL;
begin
result := (time.wMinute mod 10) = 0;
if result then begin
DeleteObject(RgnHour);
RgnHour := CreateHourRgn(time.wHour,time.wMinute);
end;
end;

procedure DoHint(time : SYSTEMTIME);
procedure HintStr(strChar);
begin
//MessageBox(GetFocus,str,'Huiyu Clock Hint ...',MB_OK);
//MessageBeep(0);
MessageBeep(0);
hintPStr := StrAlloc(255);
StrCopy(hintPStr,str);
//hintPStr:= str;
DialogBox(hInstance,'DIALOG_HINTDLG',ClockWnd,@DlgHintProc);
//SendMessage(GetDlgItem(GetFocus,ID_HINT_LBLHINT),WM_SETTEXT,0,Integer(str));

end;
begin
case time.wHour of
8:
begin
Case LastMinute of
25:
HintStr('注意你不要忘记刷卡！ 8：30 上班哪');
30:
HintStr('上班罗！！');
end;
end;
9,10,11,14,15,16:
begin
if LastMinute = 0 then
HintStr(PChar('整点报时'+#13+'现在'+IntToStr(time.wHour)+':00 点罗'));
end;
12:
begin
if LastMinute = 0 then
HintStr('要去吃午饭罗!');
end;
13:
begin
if LastMinute = 0 then HintStr('下午上班罗!');
end;
17:
begin
if LastMinute = 30 then HintStr('哈哈，下班罗，注意不要忘记刷卡');
end;
end;
end;

function ShouldChangeMinute(time : SYSTEMTIME):BOOL;
begin
result := time.wMinute <> LastMinute;
if result then begin
LastMinute := time.wMinute;
DeleteObject(RgnMinute);
RgnMinute := CreateMinuteRgn(LastMinute);
// 这个时候检查是否要作些事情 ！ 各种事件
// 简陋测试
DoHint(time);
end;
end;

function ShouldChangeSecond(time : SYSTEMTIME):BOOL;
begin
result := time.wSecond <> LastSecond;
if result then begin
LastSecond := time.wSecond;
DeleteObject(RgnSecond);
RgnSecond := CreateSecondRgn(LastSecond);
end;
end;

procedure TimerClockWalk(
hwnd : HWND; // handle to window
Msg : LongWord; // WM_TIMER message
idEvent : integer; // timer identifier
dwTime : integer // current system time
);stdcall;
var
systime : SYSTEMTIME;
chg : boolean;
hRgn : THandle;
begin
chg := false;
GetLocalTime(systime);
chg := ShouldChangeSecond(systime) or
ShouldChangeMinute(systime)or
ShouldChangeHour(systime);
if chg then begin
hRgn := CreateRectRgn(0,0,0,0);
CombineRgn(hRgn,RgnFrame,hRgn,RGN_OR);
CombineRgn(hRgn,RgnHour,hRgn,RGN_OR);
CombineRgn(hRgn,RgnMinute,hRgn,RGN_OR);
CombineRgn(hRgn,RgnSecond,hRgn,RGN_OR);
SetWindowRgn(hWnd,hRgn,TRUE);
DeleteObject(hRgn);
//UpdateWindow(hWnd);
InvalidateRect(hWnd,nil,true);
//

end;
end;

function SetClockWalk(hWnd:HWND):BOOL;
begin
SetTimer(hWnd,5, 100, @TimerClockWalk);
end;

procedure CloseClockWalk(hWnd:HWND);
begin
KillTimer(hWnd,5);
end;

end.

//
{******************************************************************************
* Uint untMsgHdl
* This module is to define the Messages on Clock Application should
* Deal with
* CopyRight (C) By GanHuaXin 2001
* All Right Reserved
* Email : huiyugan@263.net
* Date:
* New Develop : 2001-1-9
* Modify : 2001-1-9
******************************************************************************}
unit untMsgHdl;

interface

uses
Windows,
Messages,
untConst,
untTool,
untHint,
Sysutils,
ShellAPI;


function ParentMainProc(
hWnd:LongWord;
Message:LongWord;
wParam:WPARAM;
lParam:LPARAM
):BOOL;stdcall;
function MainProc(hWnd:LongWord;
Message : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;

implementation

//
// some function forward announce
//
function DlgAboutProc(hDlg: THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;forward;
function DlgOptionProc(hDlg : THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;forward;
function DlgClockSetProc(hDlg : THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;forward;

function WMParentGetMinMaxInfo(
hWnd : THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;
var
info : ^MINMAXINFO;
begin
result := BOOL(0);
info := Pointer(lParam);
info^.ptMaxSize.x := GetSystemMetrics(SM_CXFULLSCREEN);
info^.ptMaxSize.y := GetSystemMetrics(SM_CYFULLSCREEN);
info^.ptMinTrackSize.x := 0;
info^.ptMinTrackSize.y := 0;
info^.ptMaxTrackSize.x := GetSystemMetrics(SM_CXFULLSCREEN);
info^.ptMaxTrackSize.y := GetSystemMetrics(SM_CYFULLSCREEN);
end;


function ParentMainProc(
hWnd:LongWord;
Message:LongWord;
wParam:WPARAM;
lParam:LPARAM
):BOOL;stdcall;
begin
case Message of
WM_CLOSE :
begin
PostQuitMessage(0);
result := BOOL(0);
end;
WM_GETMINMAXINFO:
result := WMParentGetMinMaxInfo(hWnd,Message,wParam,lParam);
WM_SYSCOMMAND:
begin
case wParam of
SC_CLOSE:
begin
(*
if (MessageBox(hWnd,'Would you like to quit?','Hello ',
MB_YESNO or MB_ICONWARNING) = IDYES) then
begin
SendMessage(ClockWnd,WM_CLOSE,0,0);
end;
*)
end;
else
SendMessage(ClockWnd,WM_COMMAND,wParam,0);
end;
end;
else
result := BOOL(DefWindowProc(hWnd,Message,wParam,lParam));
end;
end;

//
//*** The following functions worked for the Main Window of Application ***
//

{******************************************************************************
* Function RButtonUpProc(hWnd,Msg,wParam,lParam);
* Purpose:
* To Deal with message when user right click mouse on window
* Date : 2001-1-9
******************************************************************************}
function WMRButtonUpProc(
hWnd :LongWord;
Msg :LongWord;
wParam :WPARAM;
lParam :LPARAM
):BOOL;stdcall;
const
CHECK_BOOL : Array[false..true] of UINT =
(MF_UNCHECKED, MF_CHECKED);
var
pMenu:HMENU;
subMenu:HMENU;
MousePos:TPoint;
bTrans,bOnTop:Boolean;
iClkStyle:integer;
clksetBmp : HBITMAP;
begin
pMenu := LoadMenu(hInstance,'MENU_POP');
if (pMenu<>0) then begin
subMenu := GetSubMenu(pMenu,0);
if (subMenu<>0) then begin

//
// to set the customer drawn of menu bar
//
{
CheckMenuItem(subMenu,IDM_CLOCKSET, MF_BYCOMMAND or MF_CHECKED);
clkSetBmp := GetCheckBitmaps(MF_CHECKED,0);
SetMenuItemBitmaps(subMenu,IDM_CLOCKSET, MF_BYCOMMAND,clkSetBmp,clkSetBmp);
}
//SetMenuOwnerDraw(subMenu,IDM_HINTSET);
SetMenuOwnerDraw(subMenu,IDM_CLOCKSET);
// set check and radio
GetRegAllOnTop(bOnTop);
GetRegTransparent(bTrans);
CheckMenuItem(subMenu,IDM_ALLONTOP,CHECK_BOOL[bOnTop]);
CheckMenuItem(subMenu,IDM_TRANSPARENT,CHECK_BOOL[bTrans]);
CheckMenuItem(subMenu,IDM_STARTWITHWIN,CHECK_BOOL[GetAppAtStart]);
GetRegClockStyle(iClkStyle);
CheckMenuRadioItem(GetSubMenu(subMenu,8),IDM_CIRCLK,IDM_DIGCLK,
iClkStyle,MF_BYCOMMAND);
GetCursorPos(MousePos);

TrackPopupMenu(subMenu,
TPM_RIGHTALIGN,
MousePos.x,
MousePos.y,
0,hWnd,nil);
//DeleteObject(hintsetBmp);
//DeleteObject(clksetBmp);
end;
DestroyMenu(pMenu);
end;
result := BOOL(true);
end;

function WMMeasureItemProc(hWnd : THandle;
Msg :LongWord;
wParam :WPARAM;
lParam :LPARAM):BOOL;stdcall;
var
item : ^MEASUREITEMSTRUCT;
begin
result := TRUE;
item := Pointer(lParam);
case item^.CtlType of
ODT_MENU :
begin
//item^.itemHeight := 46;
item^.itemHeight := GetSystemMetrics(SM_CYMENU);
//item^.itemWidth := 200;
end;
end;
end;

function WMDrawItemProc(hWnd : THandle;
Msg :LongWord;
wParam :WPARAM;
lParam :LPARAM):BOOL;stdcall;
var
item : ^DRAWITEMSTRUCT;
begin
result := TRUE;
item := Pointer(lParam);
case item^.CtlType of
ODT_MENU :
begin
DrawBmpMenu(item^);
end;
end;
end;
{******************************************************************************
* Function TrayIconNotifyProc(hWnd,Msg,wParam,lParam);
* Purpose:
* To dealwith the message when user do something about TrayIcon
* Date : 2001-1-9
******************************************************************************}
function TrayIconNotifyProc(hWnd :THandle;
Msg :LongWord;
wParam :WPARAM;
lParam :LPARAM):BOOL;stdcall;
var
mousePos : TPoint;
begin
result := BOOL(false);
case wParam of
ID_TRAYICON:
case lParam of
WM_LBUTTONUP:
begin
MessageBox(hWnd,'Mouse Left Button Up','GanClock',MB_OK);
result := BOOL(true);
end;
//ShowWindow(hWnd,Sw_SHOW);
WM_RBUTTONUP:
begin
SetForegroundWindow(hWnd);
result := WMRButtonUpProc(hWnd,Msg,wParam,lParam);
end;
end;
end;
end;

{******************************************************************************
* Function CommandProc(hWnd,Msg,wParam,lParam);
* Purpose:
* To Deal with the COMMAND of Application Such as button,menu,Accelerator
* Date : 2001-1-9
******************************************************************************}
function WMCommandProc(hWnd : THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;
var
bMenu : boolean;
iClkStyle : integer;
begin
if (lParam = 0) then begin // not from a control
if (HI(wParam)=0) then begin // form menu
case LO(wParam) of
IDM_QUIT :
SendMessage(hWnd,WM_SYSCOMMAND,SC_CLOSE,0);
IDM_ABOUT:
begin
//MessageBox(GetFocus(),'Click About Menu','Hello ',MB_OK);
DialogBox(hInstance,'DIALOG_ABOUT',hWnd,@DlgAboutProc);
end;
IDM_OPTION:
//MessageBox(GetFocus(),'Click Option Menu','Hello ',MB_OK);
begin
DialogBox(hInstance,'DIALOG_OPTION',hWnd,@DlgOptionProc);
end;
IDM_ALLONTOP:
begin
GetRegAllOnTop(bMenu);
bMenu := not bMenu;
SetWindowAllOnTop(hWnd,bMenu);
SetRegAllOnTop(bMenu);
end;
IDM_TRANSPARENT:
begin
GetRegTransparent(bMenu);
bMenu := not bMenu;
SetWindowTransparent(hWnd,bMenu);
SetRegTransparent(bMenu);
end;
IDM_STARTWITHWIN:
begin
SetAppAtStart(not GetAppAtStart());
end;
IDM_CIRCLK,
IDM_DIGCLK:
begin
SetRegClockStyle(LO(wParam));
end;
IDM_CLOCKSET:
begin
GetRegClockStyle(iClkStyle);
if iClkStyle = IDM_CIRCLK then
DialogBox(hInstance,'DIALOG_CLOCKCIRSET',hWnd,@DlgClockSetProc)
else
DialogBox(hInstance,'DIALOG_CLOCKDIGSET',hWnd,@DlgClockSetProc);
end;
IDM_HINTSET:
begin
end;
end;
end
else begin // form accelerator
end;
end;
result := BOOL(true);
end;



function WMEraseBkgndProc(hWnd : THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;
var
dc , tmpDC: HDC;
p : TPoint;
pStruAINTSTRUCT;
pen,oldPen : HPEN;
bmp , oldBmp: HBITMAP;
bmpSize : BITMAP;
brStruct : LOGBRUSH;
brRgn : HBRUSH;
begin
dc := GetDC(hWnd);
// draw the clock frame
tmpDc := CreateCompatibleDC(DC);
bmp := LoadBitmap(hInstance,'BITMAP_CLOCK');
Oldbmp := SelectObject(tmpDC,bmp);
BitBlt(DC,0,0,2*WIN_HALF_WIDTH,2*WIN_HALF_WIDTH,tmpDC,0,0,SRCCOPY);
SelectObject(tmpDC,oldbmp);
DeleteDC(tmpDC);
DeleteObject(bmp);

// draw center BMP
tmpDc := CreateCompatibleDC(DC);
bmp := LoadBitmap(hInstance,'BITMAP_CLOCKCENTER');
Oldbmp := SelectObject(tmpDC,bmp);
GetObject(bmp,SizeOf(bmpSize),@bmpSize);
BitBlt(DC,WIN_HALF_WIDTH - bmpSize.bmWidth div 2,
WIN_HALF_WIDTH - bmpSize.bmHeight div 2,
bmpSize.bmWidth,
bmpSize.bmHeight,tmpDC,0,0,SRCCOPY);
SelectObject(tmpDC,oldbmp);
DeleteDC(tmpDC);
DeleteObject(bmp);


// draw hour hand
brStruct.lbStyle := BS_SOLID;
brStruct.lbColor := RGB(0,0,255);
brStruct.lbHatch := 0;
brRgn := CreateBrushIndirect(brStruct);
FillRgn(dc,RgnHour,brRgn);
DeleteObject(brRgn);
// draw minute hand
brStruct.lbColor := RGB(0,255,124);
brRgn := CreateBrushIndirect(brStruct);
FillRgn(dc,RgnMinute,brRgn);
DeleteObject(brRgn);
// draw second hand
brStruct.lbColor := RGB(255,0,0);
brRgn := CreateBrushIndirect(brStruct);
FillRgn(dc,RgnSecond,brRgn);
DeleteObject(brRgn);

{
Pen := CreatePen(PS_SOLID,2,RGB(0,0,255));
if BOOL(Pen) then
begin
oldPen := SelectObject(dc,pen);
end;
// draw a circle
Arc(dc,1,1,2*WIN_HALF_WIDTH-2,2*WIN_HALF_WIDTH-2,
1,1,1,1);
// to create a new pen
DeleteObject(Pen);
Pen := CreatePen(PS_SOLID,2,RGB(0,255,0));
SelectObject(dc,Pen);
// draw two lines
MoveToEx(dc,0,0,@p);
LineTo(dc,2*WIN_HALF_WIDTH,2*WIN_HALF_WIDTH);
MoveToEx(dc,0,2*WIN_HALF_WIDTH,@p);
LineTo(dc,2*WIN_HALF_WIDTH,0);

// reback some variable
SelectObject(dc,oldPen);
DeleteObject(pen);
}
ReleaseDC(hWnd,dc);
result := BOOL(1);
end;

{******************************************************************************
* Function WMPaintProc(hWnd,Msg,wParam,lParam);
* Purpose:
* To Deal with the WM_PAINT Message
* Date : 2001-1-9
******************************************************************************}
function WMPaintProc(hWnd : THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;
var
dc , tmpDC: HDC;
p : TPoint;
pStruAINTSTRUCT;
pen,oldPen : HPEN;
bmp , oldBmp: HBITMAP;
begin
// initial about the Device

BeginPaint(hWnd,pStru);
WMEraseBkgndProc(hWnd,Msg,wParam,lParam);
(*
dc := GetDC(hWnd);
tmpDc := CreateCompatibleDC(DC);
bmp := LoadBitmap(hInstance,'BITMAP_CLOCK');
Oldbmp := SelectObject(tmpDC,bmp);
BitBlt(DC,0,0,2*WIN_HALF_WIDTH,2*WIN_HALF_WIDTH,tmpDC,0,0,SRCCOPY);
SelectObject(tmpDC,oldbmp);
DeleteDC(tmpDC);
DeleteObject(bmp);
*)
{
Pen := CreatePen(PS_SOLID,2,RGB(0,0,255));
if BOOL(Pen) then
begin
oldPen := SelectObject(dc,pen);
end;
// draw a circle
Arc(dc,1,1,2*WIN_HALF_WIDTH-2,2*WIN_HALF_WIDTH-2,
1,1,1,1);
// to create a new pen
DeleteObject(Pen);
Pen := CreatePen(PS_SOLID,2,RGB(0,255,0));
SelectObject(dc,Pen);
// draw two lines
MoveToEx(dc,0,0,@p);
LineTo(dc,2*WIN_HALF_WIDTH,2*WIN_HALF_WIDTH);
MoveToEx(dc,0,2*WIN_HALF_WIDTH,@p);
LineTo(dc,2*WIN_HALF_WIDTH,0);

// reback some variable
SelectObject(dc,oldPen);
DeleteObject(pen);
}
(*
ReleaseDC(hWnd,dc);
*)
result := true;
EndPaint(hWnd,pStru);

//result := BOOL(DefWindowProc(hWnd,Msg,wParam,lParam));
end;

{******************************************************************************
* Function WMSysCommandProc(hWnd,Msg,wParam,lParam);
* Purpose:
* To shield the WM_SYSCOMMAND of SC_MINIMIZE and SC_MAXIMIZE
* Date : 2001-1-9
******************************************************************************}
function WMSysCommandProc(hWnd:THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;
begin
//result := false;
case wParam of
SC_MINIMIZE,
SC_MAXIMIZE:
begin
MessageBox(GetFocus,'heel','hel',MB_OK);
result := true;
end;
SC_CLOSE:
begin
(*
if (MessageBox(GetFocus(),
'Would you like to quit?',
'Hello ',
MB_YESNO or MB_ICONWARNING) = IDYES) then
begin
SendMessage(hWnd,WM_CLOSE,0,0);
end;
*)
end;
else
result := BOOL(DefWindowProc(hWnd,Msg,wParam,lParam));
end;
end;


function WMMyPosChange(
hWnd : THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;
var
Pos : TMyWindowPos;
dwStyle : Integer;
begin
GetPlacePos(Pos);
dwStyle := GetWindowLong(hWnd,GWL_STYLE);
MoveWindow(hWnd,Pos.Left,Pos.Top,Pos.Width,Pos.Width,True);
SetWindowLong(hWnd,GWL_STYLE,dwStyle);
//InitWindow(hWnd);
result := true;

end;

function WMCloseProc(
hWnd : THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;
var
bOpt : boolean;
begin
SetRegWindowPos(hWnd);
CloseClockWalk(hWnd);
//GetRegShowTray(bOpt);
//if bOpt then
DelOnTray(hWnd);
if BOOL(RgnFrame) then DeleteObject(RgnFrame);
if BOOL(RgnCenter) then DeleteObject(RgnCenter);
if BOOL(RgnHour) then DeleteObject(RgnHour);
if BOOL(RgnMinute) then DeleteObject(RgnMinute);
if BOOL(RgnSecond) then DeleteObject(RgnSecond);
PostQuitMessage(0);
result := BOOL(0);
end;

function WMGetMinMaxInfo(
hWnd : THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;
var
info : ^MINMAXINFO;
begin
result := BOOL(0);
info := Pointer(lParam);
info^.ptMaxSize.x := GetSystemMetrics(SM_CXFULLSCREEN);
info^.ptMaxSize.y := GetSystemMetrics(SM_CYFULLSCREEN);
info^.ptMinTrackSize.x := 6;
info^.ptMinTrackSize.y := 6;
info^.ptMaxTrackSize.x := GetSystemMetrics(SM_CXFULLSCREEN);
info^.ptMaxTrackSize.y := GetSystemMetrics(SM_CYFULLSCREEN);
end;

function WMCreateProc(hWnd : THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;
var
bmp : HBITMAP;
bmpSize : BITMAP;
hRgn {, RgnCenter}: THandle;
time : SYSTEMTIME;
begin
//
// to initial the region if window is create from a bitmap !!
//
bmp := LoadBitmap(hInstance,'BITMAP_CLOCK');
RgnFrame := CreateRgnFromBmp(bmp);
DeleteObject(bmp);

bmp := LoadBitmap(hInstance,'BITMAP_CLOCKCENTER');
RgnCenter := CreateRgnFromBmp(bmp);
GetObject(bmp,SizeOf(bmpSize),@bmpSize);
OffsetRgn(RgnCenter,WIN_HALF_WIDTH - bmpSize.bmWidth div 2,
WIN_HALF_WIDTH - bmpSize.bmHeight div 2);
DeleteObject(bmp);
// combone two regins as RgnFrame
CombineRgn(RgnFrame,RgnFrame,RgnCenter,RGN_OR);
//DeleteObject(RgnCenter);

GetLocalTime(time);
RgnHour := CreateHourRgn(time.wHour,time.wMinute);
RgnMinute := CreateMinuteRgn(time.wMinute);
RgnSecond := CreateSecondRgn(time.wSecond);
LastMinute := time.wMinute;
LastSecond := time.wSecond;

hRgn := CreateRectRgn(0,0,0,0);
CombineRgn(hRgn,RgnFrame,hRgn,RGN_OR);
CombineRgn(hRgn,RgnHour,hRgn,RGN_OR);
CombineRgn(hRgn,RgnMinute,hRgn,RGN_OR);
CombineRgn(hRgn,RgnSecond,hRgn,RGN_OR);
SetWindowRgn(hWnd,hRgn,TRUE);
DeleteObject(hRgn);

result := BOOL(0);
end;

{******************************************************************************
* Function WMTimeChangeProc
* Description:
* This function will called when system time is changed
******************************************************************************}
function WMTimeChangeProc(hWnd : THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;
var
time : SYSTEMTIME;
hRgn : THandle;
begin
CloseClockWalk(hWnd);
result := BOOL(0);
//MessageBox(Getfocus,'System time changed','HuiyuClock',MB_OK);
if BOOL(RgnHour) then DeleteObject(RgnHour);
if BOOL(RgnMinute) then DeleteObject(RgnMinute);
if BOOL(RgnSecond) then DeleteObject(RgnSecond);
GetLocalTime(time);
RgnHour := CreateHourRgn(time.wHour,time.wMinute);
RgnMinute := CreateMinuteRgn(time.wMinute);
RgnSecond := CreateSecondRgn(time.wSecond);
LastMinute := time.wMinute;
LastSecond := time.wSecond;
hRgn := CreateRectRgn(0,0,0,0);
CombineRgn(hRgn,RgnFrame,hRgn,RGN_OR);
CombineRgn(hRgn,RgnHour,hRgn,RGN_OR);
CombineRgn(hRgn,RgnMinute,hRgn,RGN_OR);
CombineRgn(hRgn,RgnSecond,hRgn,RGN_OR);
SetWindowRgn(hWnd,hRgn,TRUE);
InvalidateRect(hWnd,nil,TRUE);
DeleteObject(hRgn);
SetClockWalk(hWnd);
end;

{******************************************************************************
* Function MainProc(hWnd,Message,wParam,lParam)
* Purpose:
* The Applicaiton Message Deal with function
* Parmeters:
* hWnd : The recevied message window handle
* Message : The Message Code
* wParam : The WPARAM
* lParam : The LPARAM
******************************************************************************}
function MainProc(
hWnd:LongWord;
Message:LongWord;
wParam:WPARAM;
lParam:LPARAM
):BOOL;stdcall;
begin
result := false;
case Message of
WM_CREATE:
result := WMCreateProc(hWnd,Message,wParam,lParam);
WM_CLOSE :
begin
SendMessage(ParentWnd,WM_CLOSE,0,0);
result := WMCloseProc(hWnd,Message,wParam,lParam);
end;
WM_DESTROY :
begin
DestroyWindow(hWnd);
end;
WM_LBUTTONDOWN :
begin
SendMessage(hWnd, WM_NCLBUTTONDOWN,HTCAPTION,0);
end;
WM_RBUTTONDOWN : //MessageBox(GetFocus(),'Hahaha','R button down',MB_OK);
result := WMRButtonUpProc(hWnd,Message,wParam,lParam);
//MoveWindow(hWnd,20,20,140,140,TRUE);
WM_TRAYICONNOTIFY:
result := TrayIconNotifyProc(hWnd,Message,wParam,lParam);
WM_COMMAND:
result := WMCommandProc(hWnd,Message,wParam,lParam);
WM_PAINT:
result := WMPaintProc(hWnd,Message,wParam,lParam);
WM_SYSCOMMAND:
result := WMSysCommandProc(hWnd,Message,wParam,lParam);
WM_MYPOSCHANGE:
result := WMMYPOSCHANGE(hWnd,Message,wParam,lParam);
WM_MEASUREITEM:
result := WMMeasureItemProc(hWnd,Message,wParam,lParam);
WM_DRAWITEM:
result := WMDrawItemProc(hWnd,Message,wParam,lParam);
WM_GETMINMAXINFO:
result := WMGetMinMaxInfo(hWnd,Message,wParam,lParam);
WM_ERASEBKGND:
result := WMEraseBkgndProc(hWnd,Message,wParam,lParam);
WM_TIMECHANGE:
result := WMTimeChangeProc(hWnd,Message,wParam,lParam);
WM_THREADEXIT:
result := DelOnTray(hWnd);
else
begin
result := BOOL(DefWindowProc(hWnd,Message,wParam,lParam));
exit;
end;
end;
end;

//
//*** The Following function is Worked for About Doalog box ***
//

function DlgAboutLblEmailProc(
hWnd : THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;
begin
end;

function DlgAboutWMSetCursor(
hWnd : THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;
var
CtlID : integer;
cursor : HCURSOR;
begin
//result := false;
CtlID := GetWindowLong(wParam, GWL_ID);
case CtlID of
ID_ABOUT_LBLEMAIL:
begin
//MessageBox(GetFocus,'fdfd','fdf',MB_OK);
result := true;
cursor := LoadCursor(0,MAKEINTRESOURCE(IDC_HAND));
SetCursor(cursor);
//result := true;
end;
end;
end;

const
hBrushStatic : HBRUSH = 0;
{******************************************************************************
* Function DlgAbout(hDlg,Msg,wParam,lParam)
* Purpose:
* The Loop Message Handler of About Dialog
* Date : 2001-1-9
******************************************************************************}
function DlgAboutProc(hDlg: THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;
var
CtlID : integer;
begin
result := BOOL(false);
case Msg of
WM_INITDIALOG :
begin
SetWindowInCenter(hDlg);
(*
SetLastError(0);
if SetWindowLong(GetDlgItem(hDlg,ID_ABOUT_LBLEMAIL),GWL_WNDPROC,
LongInt(@DlgAboutLblEmailProc)) = 0 then
MessageBox(GetFocus,PChar('Error to subclass the label:'+
IntToStr(GetLastError)),'Hi',MB_OK);
*)
hBrushStatic := CreateSolidBrush(GetSysColor(COLOR_MENU));

result := BOOL(true);
end;
WM_COMMAND :
begin
if lParam<>0 then begin // so it is a control
case LO(wParam) of
ID_ABOUT_OK :
begin
EndDialog(hDlg, integer(TRUE));
result := BOOL(TRUE);
end;
ID_ABOUT_LBLEMAIL:
begin
ShellExecute(hDlg,'open',
PChar('mailto:Gan Huaxin<huiyugan@263.net>'+
'?subject=About Clock'+
'&body=Hello,Mr. Gan Huaxin'),
nil,nil,SW_SHOW);
end;
end;
end;
end;
WM_CLOSE :
begin
DeleteObject(hBrushStatic);
hBrushStatic := 0;
EndDialog(hDlg,integer(true));
result := BOOL(true);
end;
WM_CTLCOLORSTATIC:
begin
ctlID := GetWindowLong(lParam,GWL_ID);
case CtlID of
ID_ABOUT_LBLEMAIL:
begin
SetTextColor(wParam,RGB(0,0,255));
SetBkColor(wParam,GetSysColor(COLOR_Menu));
result := BOOL(hBrushStatic);
end;
end;
end;
WM_SETCURSOR:
begin
//MessageBox(Getfocus,'SetCursor','fd',MB_OK);
result := DlgAboutWMSetCursor(hDlg,Msg,wParam,lParam);
end;
end;
end;

//
//*** The Following functions is work for Dialog Option! ***
//
var
opt : integer; // this global save the current select window postion
// option setting
// it Init in DlgOptionInitDlgProc
// and can change in DlgOptionWMCommand

{******************************************************************************
* Function DlgOptionWMInitDlgProc(hDlg,Msg,wParam,lParam);
* Purpose:
* To Initial the Option Dialog
* Date :
* New Development : 2001-1-10
* Modified :
******************************************************************************}
function DlgOptionWMInitDlgProc(
hDlg : THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;
const
CHECK_BOOL : Array[false..true] of UINT =
(BST_UNCHECKED, BST_CHECKED);
var
bOpt: boolean;
begin
GetRegShowOnTaskBar(bOpt);
CheckDlgButton(hDlg,ID_OPTION_CHKTASKBAR,CHECK_BOOL[bOpt]);
//
// Set the Radion Button First State
//

GetRegWindowPosOpt(opt);
CheckRadioButton(hDlg,ID_OPTION_TOPLEFT,
ID_OPTION_USERPLACE,opt);
//
// Set Apply Button Enabled
//
EnableWindow(GetDlgItem(hDlg,ID_OPTION_APPLY),false);
//
// initial the Check buttons Status
//
GetRegAllOnTop(bOpt);
CheckDlgButton(hDlg,ID_OPTION_CHKALLONTOP,CHECK_BOOL[bOpt]);

CheckDlgButton(hDlg,ID_OPTION_CHKSTARTWIN,
CHECK_BOOL[GetAppAtStart]);

GetRegTransparent(bOpt);
CheckDlgButton(hDlg,ID_OPTION_CHKTRANS,CHECK_BOOL[bOpt]);
//
// Set the transparent edit enable status
//
EnableWindow(GetDlgItem(hDlg,ID_OPTION_EDITTRANS),bOpt);
EnableWindow(GetDlgItem(hDlg,ID_OPTION_LBLDEGREE),bOpt);

GetRegShowTray(bOpt);
CheckDlgButton(hDlg,ID_OPTION_CHKSHOWTRAY,CHECK_BOOL[bOpt]);
// place the window as center in desktop
SetWindowInCenter(hDlg);

result := BOOL(0);
end;

{******************************************************************************
* Function DlgOptionWMCommandProc(hDlg,Msg,wParam,lParam);
* Purpose:
* To Deal with Menu, Button click events
* Global Variable :
* Opt : To Remember the Radio Button Saved
* Date :
* New Development : 2001-1-10
* Modified :
******************************************************************************}

function DlgOptionWMCommandProc(
hDlg : THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;stdcall;
var
Pos:TMyWindowPos;
dwStyle : integer;
begin
if lParam<>0 then begin // control command
case LO(wParam) of
//
// push Buttons
//
ID_OPTION_OK:
begin
if IsWindowEnabled(GetDlgItem(hDlg,ID_OPTION_APPLY)) then begin
SendDlgItemMessage(hDlg,ID_OPTION_APPLY,WM_LBUTTONDOWN,0,0);
SendDlgItemMessage(hDlg,ID_OPTION_APPLY,WM_LBUTTONUP,0,0);
end;
SendMessage(hDlg,WM_CLOSE,0,0);
end;
ID_OPTION_CANCEL:
Begin
//GetRegWindowPos(TestPos);
SendMessage(hDlg,WM_CLOSE,0,0);
end;
ID_OPTION_APPLY:
begin
SetRegTransParent(
IsDlgButtonChecked(hDlg,ID_OPTION_CHKTRANS)= BST_CHECKED);
SetWindowTransparent(
GetParent(hDlg),
IsDlgButtonChecked(hDlg,ID_OPTION_CHKTRANS)= BST_CHECKED);
SetRegAllOnTop(
IsDlgButtonChecked(hDlg,ID_OPTION_CHKALLONTOP) = BST_CHECKED);
SetWindowAllOnTop(
GetParent(hDlg),
IsDlgButtonChecked(hDlg,ID_OPTION_CHKALLONTOP) = BST_CHECKED);
SetRegShowTray(
IsDlgButtonChecked(hDlg,ID_OPTION_CHKSHOWTRAY) = BST_CHECKED);
if IsDlgButtonChecked(hDlg,ID_OPTION_CHKSHOWTRAY) = BST_CHECKED then
ShowOnTray(GetParent(hDlg))
else
DelOnTray(GetParent(hDlg));

SetRegWindowPos(GetParent(hDlg));
SetRegWindowPosOpt(opt);
SetAppAtStart(
IsDlgButtonChecked(hDlg,ID_OPTION_CHKSTARTWIN) = BST_CHECKED);
//
// to Move the Main Window !
//
GetPlacePos(Pos);
//dwStyle := GetWindowLong(GetParent(hDlg),GWL_STYLE);
MoveWindow(GetParent(hDlg),Pos.Left,Pos.Top,
Pos.Width,Pos.Width,True);
//SetWindowLong(GetParent(hDlg),GWL_STYLE,dwStyle);
EnableWindow(GetDlgItem(hDlg,ID_OPTION_APPLY),false);
if IsDlgButtonChecked(hDlg,ID_OPTION_CHKTASKBAR) = BST_CHECKED then
begin
ShowWindow(ParentWnd,SW_SHOW);
SetRegShowOnTaskBar(true);
end
else begin
ShowWindow(ParentWnd,SW_HIDE);
SetRegShowOnTaskBar(false);
end;

SetFocus(hDlg);
end;
//
// radion buttons
//
ID_OPTION_TOPLEFT, ID_OPTION_TOPCENTER, ID_OPTION_TOPRIGHT,
ID_OPTION_MIDDLELEFT,ID_OPTION_MIDDLECENTER,ID_OPTION_MIDDLERIGHT,
ID_OPTION_BOTTOMLEFT,ID_OPTION_BOTTOMCENTER,ID_OPTION_BOTTOMRIGHT,
ID_OPTION_USERPLACE:
// just to Remember the click Button ID
begin
EnableWindow(GetDlgItem(hDlg,ID_OPTION_APPLY),TRUE);
opt := LO(wParam);
end;
//
// check buttons
//
ID_OPTION_CHKSTARTWIN..ID_OPTION_CHKTASKBAR:
begin
if IsDlgButtonChecked(hDlg,LO(wParam))=BST_CHECKED then
CheckDlgButton(hDlg,LO(wParam),BST_UNCHECKED)
else
CheckDlgButton(hDlg,LO(wParam),BST_CHECKED);
EnableWindow(GetDlgItem(hDlg,ID_OPTION_APPLY),TRUE);
if LO(wParam) = ID_OPTION_CHKTRANS then
if IsDlgButtonChecked(hDlg,ID_OPTION_CHKTRANS)=BST_CHECKED then
begin
EnableWindow(GetDlgItem(hDlg,ID_OPTION_EDITTRANS),TRUE);
EnableWindow(GetDlgItem(hDlg,ID_OPTION_LBLDEGREE),TRUE);
end
else begin
EnableWindow(GetDlgItem(hDlg,ID_OPTION_EDITTRANS),FALSE);
EnableWindow(GetDlgItem(hDlg,ID_OPTION_LBLDEGREE),FALSE);
end;
end;
end;
end
else
if HI(wParam)<>0 then begin // Accelerator command
end
else begin // menu command
end;
result := BOOL(true);
end;

{******************************************************************************
* Function DlgOptionProc
* Purpose:
* The Loop Message Handler of Option Dialogs
* Date : 2001-1-9
******************************************************************************}
//var hBrushStatic : HBRUSH;
function DlgOptionProc(hDlg : THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;
var
ctlID : integer;
begin
result := BOOL(false);
case Msg of
WM_INITDIALOG :
result := DlgOptionWMInitDlgProc(hDlg,Msg,wParam,lParam);
WM_CLOSE :
begin
EndDialog(hDlg,integer(true));
result := BOOL(true);
end;
WM_COMMAND :
result := DlgOptionWMCommandProc(hDlg,Msg,wParam,lParam);
WM_CTLCOLORSTATIC:
begin
ctlID := GetWindowLong(lParam,GWL_ID);
if ctlID = ID_OPTION_LBLDEGREE then begin
SetTextColor(HDC(wParam),RGB(255,0,0));
SetBkColor(HDC(wParam),RGB(255,255,255));
result := BOOL(0);
end;
end;
end;
end;

function DlgClockSetProc(hDlg : THandle;
Msg : LongWord;
wParam : WPARAM;
lParam : LPARAM):BOOL;
var
ctlID : integer;
begin
result := BOOL(false);
case Msg of
WM_INITDIALOG :
SetWindowInCenter(hDlg);
WM_CLOSE :
begin
EndDialog(hDlg,integer(true));
result := BOOL(True);
end;
WM_CTLCOLORSTATIC:
begin
ctlID := GetWindowLong(lParam,GWL_ID);

end;
end;
end;

end.

//
{******************************************************************************
* Unit untTool
* Module is support some tools function to the main module
* CopyRight (C) By GanHuaXin 2001
* Date :
* New Develop : 2001-1-8
* Modify : 2001-1-9
******************************************************************************}
unit untTool;

interface
uses
Sysutils,
Windows,
ShellAPI,
Messages,
untConst;

//function InitWindow(hWnd:HWND):BOOL;
function SetTransparent(hWnd:HWND; bAlpha:byte):BOOL;
function SetWindowAllOnTop(hWnd:HWND;bOnTop:Boolean):BOOL;
function SetWindowTransparent(hWnd:HWND;bTrans:Boolean):BOOL;
function SetWindowInCenter(hWnd:HWND):BOOL;
function SetAppAtStart(bSet:Boolean):BOOL;
function GetAppAtStart:BOOL;

function TrayIconAdd(hWnd:HWND; uID:integer; hIcon:HICON; hint:String):BOOL;
function TrayIconEdit(hWnd:HWNd; uID:integer; hIcon:HICON; hint:String):BOOL;
function TrayIconDel(hWnd:HWND; uID:integer):BOOL;
function ShowOnTray(hWnd:HWND):BOOL;
function DelOnTray(hWnd:HWND):Bool;

function SetRegData(Name:string; Bufferointer; BufSize:Integer):BOOL;
function GetRegData(Name:string; Bufferointer; BufSize:Integer):BOOL;

function SetRegWindowPosOpt(option:integer):BOOL;
function SetRegWindowPos(hWnd : HWND):BOOL;
function SetRegAllOnTop(option : boolean):BOOL;
function SetRegTransparent(option : boolean):BOOL;
function SetRegShowTray(option : boolean):BOOL;
function SetRegClockStyle(option : integer):BOOL;
function SetRegShowOnTaskBar(option : boolean):BOOL;

function GetRegWindowPosOpt(var Option : integer):BOOL;
function GetRegWindowPos(var Value:TMyWindowPos):BOOL;
function GetRegAllOnTop(var bOnTop:Boolean):BOOL;
function GetRegTransparent(var bTrans:Boolean):BOOL;
function GetRegShowTray(var bOnTray:Boolean):BOOL;
function GetRegClockStyle(var option:integer):BOOL;
function GetRegShowOnTaskBar(var bShown : boolean):BOOL;

function RegErrorHandle(error : integer):String;

function GetPlacePos(var Pos:TMyWindowPos):BOOL;

function GetCheckBitmaps(fuCheck:UINT; menuID:integer):HBITMAP;
function SetMenuOwnerDraw(menu : HMENU; cmdID : integer):BOOL;
function DrawBmpMenu(itemMenu : DRAWITEMSTRUCT):BOOL;

function CreateRgnFromBmp(bmp : HBITMAP):HRGN;
function CreateAlfaRgn(x,y,r,Alfa,halfWidth,ArrowLen:integer):HRGN;
function CreateHourRgn(hour,minute:integer):HRGN;
function CreateMinuteRgn(minute:integer):HRGN;
function CreateSecondRgn(second:integer):HRGN;


(*
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer;
stdcall; external 'KERNEL32.DLL';
*)
implementation


{******************************************************************************
* Function SetLayeredWindowAttributes(hWnd,crKey,bAlpha,dwFlags)
* Description : This Function is a new function import from win2000
* It can not work on win9x
******************************************************************************}
{
function SetLayeredWindowAttributes(
hwnd :HWND; //handle aoubt the window
crKey :Longint; //
bAlpha :byte; //
dwFlags :longint //
):BOOL; stdcall; external user32;
}
type
TSetLayeredWindowAttributes =
function(hWnd:HWND;crKey:Longint;bAlphs:byte;dwFlags:LongInt):BOOL;stdcall;
{******************************************************************************
* Function SetTransparent(hWnd,bAlpha)
* Purpose:
* To set the window transparent as degree by bAlpha
* Arguments:
* hWnd : Handl of the window
* bAlpha : The transparent degree , range from 0 to 255
* Return Value : Bool of function SetlayeredWindowAttributes
******************************************************************************}
function SetTransparent(hWnd:HWND; bAlpha:byte):BOOL;
var
dwStyle : LongInt;
pSetLayeredWindowAttributes:TSetLayeredWindowAttributes;
hModule:THandle;
begin
result := false;
if hWnd = 0 then exit;
dwStyle := GetWindowLong(hWnd,GWL_EXSTYLE);
dwStyle := dwStyle or WS_EX_LAYERED;
if SetWindowLong(hwnd,GWL_EXSTYLE,dwStyle)=0 then
exit;
{
result :=
SetLayeredWindowAttributes(hWnd,0, bAlpha, LWA_ALPHA);
}

hModule := LoadLibrary(user32);
if (hModule<>0) then begin
@pSetLayeredWindowAttributes :=
GetProcAddress(hModule,'SetLayeredWindowAttributes');
if (@pSetLayeredWindowAttributes <> nil) then
result := pSetLayeredWindowAttributes(hWnd,0,bAlpha,LWA_ALPHA);
FreeLibrary(hModule);
pSetLayeredWindowAttributes := nil;
end;
if not result then
MessageBox(GetFocus(),'Error to set tranparent!','Error!',MB_OK);
end;

function SetWindowAllOnTop(hWnd:HWND;bOnTop:Boolean):BOOL;
begin
if bOnTop then
SetWindowPos(hWnd,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE)
else
SetWindowPos(hWnd,HWND_NOTOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE);
result := true;
end;

function SetWindowTransparent(hWnd:HWND;bTrans:Boolean):BOOL;
begin
if bTrans then
SetTransparent(hWnd,160)
else
SetTransparent(hWnd,255);
result := true;
end;

function SetWindowInCenter(hWnd:HWND):BOOL;
var
ScrH,ScrW : integer;
rect : TRect;
NewLeft,NewTop : integer;
begin
ScrH := GetSystemMetrics(SM_CYFULLSCREEN);
ScrW := GetSystemMetrics(SM_CXFULLSCREEN);
GetWindowRect(hWnd,rect);
NewLeft := (ScrW - (rect.Right - rect.Left)) div 2;
NewTop := (ScrH - (rect.Bottom - rect.Top)) div 2;
SetWindowPos(hWnd,0,NewLeft,NewTop,0,0,SWP_NOSIZE or SWP_NOZORDER);
end;

function GetAppAtStart:BOOL;
var
key : HKEY;
ret : integer;
chg : DWORD;
Buffer : string[255];
len : DWORD;
begin
result := false;
key := 0;
ret := RegCreateKeyEx(
HKEY_LOCAL_MACHINE,
APP_KEY_START,
0,Nil,REG_OPTION_NON_VOLATILE,
KEY_ALL_ACCESS,
Nil,key,@chg);
if (ret<>ERROR_SUCCESS) or (key=0) then exit;
len := 255;
try
if RegQueryValueEx(key,M_SUBNAME,nil,nil,PByte(@Buffer),@len)
= ERROR_SUCCESS then result := true;
finally
RegCloseKey(key);
end;
end;

function SetAppAtStart(bSet:Boolean):BOOL;
var
key : HKEY;
ret : integer;
chg : DWORD;
AppStr : String;
begin
result := false;
key := 0;
ret := RegCreateKeyEx(
HKEY_LOCAL_MACHINE,
APP_KEY_START,
0,Nil,REG_OPTION_NON_VOLATILE,
KEY_ALL_ACCESS,
Nil,key,@chg);
if (ret<>ERROR_SUCCESS) or (key=0) then exit;
try
if not bSet then begin
RegDeleteValue(key,M_SUBNAME);
end
else begin
AppStr := ParamStr(0);
RegSetValueEx(key,M_SUBNAME,0,REG_SZ,PChar(AppStr),Length(AppStr));
end;
result := true;
finally
RegCloseKey(key);
end;
end;
{******************************************************************************
* Function TrayIconAdd(hWnd,uID,hIcon,hint);
* Purpose:
* To Add a Icon on System TrayIcon Area
* Arguments:
* hWnd : The revieved notify message's window's handle
* uID : The Identify of the Icon
* hIcon : The Handle of the ICON shows
* hint : The hint information when the mouse cursor on Tray Icon
* Return Value:
* See Shell_NotifyIcon
* Date : 2001-1-9
******************************************************************************}
function TrayIconAdd(hWnd:HWND; uID:integer; hIcon:HICON; hint:String):BOOL;
var
IconData : NOTIFYICONDATA;
begin
if (hWnd = 0) or (hIcon = 0) then begin
result := false;
exit;
end;
with IconData do begin
cbSize := SizeOf(IconData);
uCallBackMessage := WM_TRAYICONNOTIFY;
uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
Wnd := hWnd;
StrCopy(szTip, PChar(hint));
end;
IconData.hIcon := hIcon;
IconData.uID := uID;
result :=
Shell_NotifyIcon(NIM_ADD,@IconData);
end;

{******************************************************************************
* Function TrayIconEdit(hWnd,uID,hIcon,hint)
* Purpose:
* To Modify the exist Tray Icon 's styles such as Icon or Hint string
* Date :
* New Development : 2001-1-9
* Modified :
******************************************************************************}
function TrayIconEdit(hWnd:HWNd; uID:integer; hIcon:HICON; hint:string):BOOL;
var
IconData : NOTIFYICONDATA;
begin
if (hWnd = 0) or (hIcon = 0) then begin
result := false;
exit;
end;
with IconData do begin
cbSize := SizeOf(IconData);
uCallBackMessage := WM_TRAYICONNOTIFY;
uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
Wnd := hWnd;
StrCopy(szTip, PChar(hint));
end;
IconData.hIcon := hIcon;
IconData.uID := uID;
result :=
Shell_NotifyIcon(NIM_MODIFY,@IconData);

end;

{******************************************************************************
* Function TrayIconDel(hWnd,uID);
* Purpose:
* To Delete the Identify Icon on system Tray Icon Area
* Arguments:
* hWnd : The Recevied Message Window's handle
* uID : The Identify of Icon
* Return Value : See Shell_NotifyIcon
* Date : 2001-1-9
******************************************************************************}
function TrayIconDel(hWnd:HWND; uID:integer):BOOL;
var
IconData : NOTIFYICONDATA;
begin
if (hWnd = 0) then begin
result :=false;
exit;
end;
with IconData do begin
cbSize := SizeOf(IconData);
Wnd := hWnd;
end;
IconData.uID := uID;
result := Shell_NotifyIcon(NIM_DELETE, @IconData);
end;

{******************************************************************************
* Function ShouldFlash:Bool;
* Purpose:
* To Determing whether it's time to flash the Tray Icon ?
* and it is only used in procedure TimerProcMain
* Date : 2001-1-9
******************************************************************************}
function ShouldFlash:BOOL;
begin
result := false;
end;

{******************************************************************************
* Procedure DoFun;
* Purpose:
* To Show Some Fun things on the Screen
* Date:
* New Develop : 2001-01-09
* Modified : 2001-01-10
******************************************************************************}
procedure DoFun;
var
dc : HDC;
//p : TPoint;
//pStruAINTSTRUCT;
begin
dc := GetDC(0);
TextOut(DC,400,400,'中华人民共和国',14);
ReleaseDC(0,dc);
end;

procedure TimerProcFlash(
hwnd : HWND; // handle to window
Msg : LongWord; // WM_TIMER message
idEvent : integer; // timer identifier
dwTime : integer // current system time
);stdcall;forward;
{******************************************************************************
* Function TimerProcMain(hWnd,Msg,idEvent,dwTime
* Purpose:
* To control whether Flash the Tray ICON
* Date : @001-1-9
******************************************************************************}
procedure TimerProcMain(
hWnd : HWND;
Msg : LongWord;
idEvent : integer;
dwTime : integer
);stdcall;
begin
if ShouldFlash then begin // if the tray icon should Flash
SetTimer(hWnd,2,400,@TimerProcFlash); // Active timer 2
DoFun;
KillTimer(hWnd,1); // And kill self
end else
SendMessage(0,WM_PAINT,0,0);
end;

{******************************************************************************
* Function TimerProcFlash(hWnd,Msg,idEvent,dwTime);
* Purpose:
* To Flash the TrayIcon
* Date : 2001-1-9
*
******************************************************************************
* Some Global Variables:
* IconS : Store the Icon Resources' Name as PChar
* IconIndex : To Identify the Current Shown Icon No.
* FlashCycle : The Flash Cycle times
* MaxFlashCycle : the Max Flash Cycle times
*
******************************************************************************}
const
IconS : Array[1..4] of PChar =
('ICON_TRAY1','ICON_TRAY2',
'ICON_TRAY3','ICON_TRAY4' );
IconIndex : integer = 1; // Current Icon Index
FlashCyle : integer = 1; // the Flash Icon Cycle times
MaxFlashCycle : integer = 4; // max Flash Cycle times
procedure TimerProcFlash(
hwnd : HWND; // handle to window
Msg : LongWord; // WM_TIMER message
idEvent : integer; // timer identifier
dwTime : integer // current system time
);stdcall;
var
hIcon : THandle;
begin
Inc(IconIndex);
if IconIndex = 5 then begin
IconIndex := 1;
Inc(FlashCyle);
if FlashCyle > MaxFlashCycle then begin
FlashCyle := 1;
SetTimer(hWnd,1,2000,@TimerProcMain);// Active timer 2
KillTimer(hWnd,2); // Kill Self
// And then reback the Tray Icon!
hIcon := LoadIcon(hInstance,IconS[1]);
TrayIconEdit(hWnd,ID_TRAYICON,hIcon,'Hello, World!');

//SendMessage(0,WM_PAINT,0,0);
UpdateWindow(0);

exit;
end;
end;
hIcon := LoadIcon(hInstance,IconS[IconIndex]);
TrayIconEdit(hWnd,ID_TRAYICON,hIcon,'你有事情要做！');
end;

{******************************************************************************
* Function ShowOnTray(hWnd);
* Purpose:
* To Set The Icon on Tray and set the Timer
* Arguments:
* hWnd : The Handle that received messages
* Date :
* New Development : 2001-01-09
* Modified : 2001-01-10
******************************************************************************}
function ShowOnTray(hWnd:HWND):BOOL;
var
hIcon : THandle;
begin
hIcon := LoadIcon(hInstance, 'ICON_TRAY1');
Result := TrayIconAdd(hWnd,ID_TRAYICON,hIcon,'hello,world!');
DeleteObject(hIcon);
SetTimer(hWnd,1,2000,@TimerProcMain);
end;

{******************************************************************************
* Function DelOnTray(hWnd)
* Purpose:
* To Delete the Icon on Tray Area and kill all Timers
* Date:
* New Development : 2001-01-09
* Modified :
******************************************************************************}
function DelOnTray(hWnd:HWND):Bool;
begin
Result := TrayIconDel(hWnd,ID_TRAYICON);
KillTimer(hWnd,1);
KillTimer(hWnd,2);
end;

function RegErrorHandle(error : integer):String;
var
h : PChar;
begin
h:=StrAlloc(400);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_FROM_HMODULE,
nil,GetLastError,5,h,400,nil);
result := StrPas(h);
StrDispose(h);

end;
//
//************ The Follow is some operator to Registry **********************
//

{******************************************************************************
* Function OpenRegData()
* Purpose:
* To Open the special KEY of Clock Hint Application
* Date :
* New Develop : 2001-1-9
* Modified :
******************************************************************************}
function OpenRegData(var APP_KEY : HKEY):BOOL;
var
chg : DWORD;
keyCrt: integer;
begin
result := TRUE;
keyCrt:= RegCreateKeyEx(
HKEY_CURRENT_USER,
//HKEY_LOCAL_MACHINE,
APP_KEY_STR,
0,Nil,REG_OPTION_NON_VOLATILE,
KEY_ALL_ACCESS,
Nil,APP_KEY,@chg);
if (KeyCrt<> ERROR_SUCCESS) or (APP_KEY=0) then
result := false;
end;

{*****************************************************************************
* Function SetRegData
* Purpose:
* To set special data to my application registry data
* Date:
* New Develop : 2001-1-11
* Modified : 2001-1-11
* Retrun Value :
* True or False , identify whether the operation is Success
*****************************************************************************}
function SetRegData(Name:string; Bufferointer; BufSize:Integer):BOOL;
var
ret : integer;
APP_KEY : HKEY;
begin
result := false;
if not OpenRegData(APP_KEY) then exit;
ret := RegSetValueEx(APP_KEY, PChar(Name), 0,
REG_BINARY, Buffer, BufSize);
if ret = ERROR_SUCCESS then
result := true;
RegFlushKey(APP_KEY);
RegCloseKey(APP_KEY);
APP_KEY := 0;
end;

{*****************************************************************************
* Function GetRegData
* Purpose:
* To get special data from my application registry data
* Date:
* New Develop : 2001-1-11
* Modified : 2001-1-11
* Retrun Value :
* True or False , identify whether the operation is Success
*****************************************************************************}
function GetRegData(Name: string;Buffer: Pointer; BufSize: Integer):BOOL;
var
ret : integer;
APP_KEY : HKEY;
begin
result := false;
if not OpenRegData(APP_KEY) then exit;
ret := RegQueryValueEx(APP_KEY,PChar(Name),nil,nil,
PByte(Buffer),@BufSize);
if ret = ERROR_SUCCESS then result:=true;
RegCloseKey(APP_KEY);
APP_KEY := 0;
end;

{******************************************************************************
* Function SetRegWindowPosOpt(option)
* Purpose:
* To save the option of window postion to registry
* Arguments :
* Option : the Window Postion Option should save
* Date :
* New Develop : 2001-1-10
* Modified :
******************************************************************************}
function SetRegWindowPosOpt(option:integer):BOOL;
begin
result :=
SetRegData(APP_KEY_SUBPOSOPT,@option,SizeOf(option));
end;

function SetRegAllOnTop(option : boolean):BOOL;
begin
result :=
SetRegData(APP_KEY_SUBALLONTOP,@option,SizeOf(option));
end;

function SetRegTransparent(option : boolean):BOOL;
begin
result :=
SetRegData(APP_KEY_SUBTRANSPARENT,@option,SizeOf(option));
end;


{******************************************************************************
* Function SetRegWindowPos(hWnd);
* Purpose:
* To save the special window's postion to Registry
* Arguments:
* hWnd : The Special Window's handle
* Date :
* New Develop : 2001-1-9
* Modified :
******************************************************************************}
function SetRegWindowPos(hWnd : HWND):BOOL;
var
Value : TMyWindowPos;
rect : TRect;
begin
GetWindowRect(hWnd,rect);
Value.Top := rect.Top;
Value.Left := rect.Left;
Value.Width := rect.Right - rect.Left;
result := SetRegData(APP_KEY_SUBPOS,@Value,SizeOf(Value));
end;

function SetRegShowTray(option : boolean):BOOL;
begin
result := SetRegData(APP_KEY_SUBSHOWTRAY,@option,SizeOf(option));
end;

function SetRegClockStyle(option : integer):BOOL;
begin
result := SetRegData(APP_KEY_SUBCLOCKSTYLE,@option,SizeOf(option));
end;

function SetRegShowOnTaskBar(option : boolean):BOOL;
begin
result := SetRegData(APP_KEY_SUBSHOWONTASKBAR,@option,SizeOf(option));
end;
{******************************************************************************
* Function GetRegWindowPosOpt(var Option)
* Purpose:
* To get the window's postion option from registry
* Arguments:
* Var option : the return postion
* Date :
* New development : 2001-1-10
* Modified : 2001-1-11
******************************************************************************}
function GetRegWindowPosOpt(var Option : integer):BOOL;
begin
result := true;
if not GetRegData(APP_KEY_SUBPOSOPT,@Option,SizeOf(Option)) then
begin
Option := ID_OPTION_MIDDLECENTER;
SetRegWindowPosOpt(Option);
end;
end;

{******************************************************************************
* Function GetRegWindowPos(var Valu);
* Purpose:
* To Get The Appliation's Window's Postion from Registry
* Arguments:
* the return Windows postion if it is success, or if false, the default
* Value will be return in Value
* Date :
* New Develop : 2001-1-9
* Modified : 2001-1-11
******************************************************************************}
function GetRegWindowPos(var Value:TMyWindowPos):BOOL;
{var
bmp:HBITMAP;
bmpSize : BITMAP;}
begin
result := true;
if not GetRegData(APP_KEY_SUBPOS,@Value,SizeOf(Value)) then
Value := DEFAULTPOS;
{
bmp := LoadBitmap(hInstance,'BITMAP_CLOCK');
GetObject(bmp,sizeof(bmpSize),@bmpSize);
DeleteObject(bmp);
Value.Width := bmpSize.bmWidth;
}
WIN_HALF_WIDTH := Value.Width div 2;
end;

{******************************************************************************
* Function GetPlacePos(var Pos)
* Purpose:
* To Adjust the window's Postoin by Pos and Postion Option
* Arguments:
* Var Pos: The return postion of window
* Date :
* New Development : 2001-1-10
* Modified : 2001-1-11
******************************************************************************}
function GetPlacePos(var Pos:TMyWindowPos):BOOL;
var
opt ,
ScrW,
ScrH: integer;

function GetScreenWH(var Width,Height:integer):BOOL;
begin
result := true;
Width := GetSystemMetrics(SM_CXFULLSCREEN);
Height := GetSystemMetrics(SM_CYFULLSCREEN);
end;

begin
result := true;
GetRegWindowPos(Pos);
GetRegWindowPosOpt(opt);
GetScreenWH(ScrW,ScrH);
Case Opt of
ID_OPTION_TOPLEFT:
begin
Pos.Top := 0;
Pos.Left := 0;
end;
ID_OPTION_TOPCENTER:
begin
Pos.Top := 0;
Pos.Left := (ScrW - Pos.Width) div 2;
end;
ID_OPTION_TOPRIGHT:
begin
Pos.Top := 0;
Pos.Left := ScrW - Pos.Width;
end;
ID_OPTION_MIDDLELEFT:
begin
Pos.Top := (ScrH - Pos.Width) div 2;
Pos.Left := 0;
end;
ID_OPTION_MIDDLECENTER:
begin
Pos.Top := (ScrH - Pos.Width) div 2;
Pos.Left := (ScrW - Pos.Width) div 2;
end;
ID_OPTION_MIDDLERIGHT:
begin
Pos.Top := (ScrH - Pos.Width) div 2;
Pos.Left := ScrW - Pos.Width;
end;
ID_OPTION_BOTTOMLEFT:
begin
Pos.Top := ScrH - Pos.Width;
Pos.Left := 0;
end;
ID_OPTION_BOTTOMCENTER:
begin
Pos.Top := ScrH - Pos.Width;
Pos.Left := (ScrW - Pos.Width) div 2;
end;
ID_OPTION_BOTTOMRIGHT:
begin
Pos.Top := ScrH - Pos.Width;
Pos.Left := ScrW - Pos.Width;
end;
ID_OPTION_USERPLACE:
begin
// Autojust the position
if Pos.Top < 0 then Pos.Top := 0;
if Pos.Left <0 then Pos.Left := 0;
if Pos.Top > (ScrH - Pos.Width) then
Pos.Top := ScrH - Pos.Width;
if Pos.Left > (ScrW - Pos.Width) then
Pos.Left := ScrW - Pos.Width;
end;
end;
end;

{*****************************************************************************
* Function GetRegAllOnTop
* Purpose:
* To get whether window Show All On Top is set
* Date:
* New Develop : 2001-1-11
* Modified : 2001-1-11
*****************************************************************************}
function GetRegAllOnTop(var bOnTop:Boolean):BOOL;
begin
result := true;
if not GetRegData(APP_KEY_SUBALLONTOP,@bOnTop,SizeOf(bOnTop)) then
begin
bOnTop := True;
SetRegAllOnTop(bOnTop);
end;
end;

{*****************************************************************************
* Function GetRegTransparent
* Purpose:
* To get whether window Show transparent is set
* Date:
* New Develop : 2001-1-11
* Modified : 2001-1-11
*****************************************************************************}
function GetRegTransparent(var bTrans:Boolean):BOOL;
begin
result := true;
if not GetRegData(APP_KEY_SUBTRANSPARENT,@bTrans,SizeOf(bTrans)) then
begin
bTrans := true;
SetRegTransparent(bTrans);
end;
end;

{*****************************************************************************
* Function GetRegShowTray
* Purpose:
* To get whether window Show in Tran Area is set
* Date:
* New Develop : 2001-1-11
* Modified : 2001-1-11
*****************************************************************************}
function GetRegShowTray(var bOnTray:Boolean):BOOL;
begin
result := true;
if not GetRegData(APP_KEY_SUBSHOWTRAY,@bOnTray,SizeOf(bOnTray)) then
begin
bOnTray := true;
SetRegShowTray(bOnTray);
end;
end;

function GetRegClockStyle(var option:integer):BOOL;
begin
result := true;
if not GetRegData(APP_KEY_SUBCLOCKSTYLE,@option,SizeOf(option)) then
begin
option := IDM_CIRCLK;
SetRegClockStyle(option);
end;
end;

function GetRegShowOnTaskBar(var bShown : boolean):BOOL;
begin
result := true;
if not GetRegData(APP_KEY_SUBSHOWONTASKBAR,@bShown,SizeOf(bShown)) then
begin
bShown := false;
SetRegShowOnTaskBar(bShown);
end;
end;

function GetCheckBitmaps(fuCheck:UINT; menuID:integer):HBITMAP;
var
crBackground : COLORREF;
hbrBackground : HBRUSH;
hbrTargetOld : HBRUSH;
hdcSource, hdcTarget : HDC;
bmCheckBox : BITMAP;
hbmpCheckBoxes,
hbmpSourceOld,
hbmpTargetOld,
hbmpCheck : HBITMAP;
rc : TRECT;
wBitmapX,wBitmapY : WORD;
begin
// Get the Menu background color and crate a solid brush with this color
crBackground := GetSysColor(COLOR_MENU);
hbrBackground := CreateSolidBrush(crBackground);

// Create memory device contexts for the source and destination bitmaps

hdcSource := CreateCompatibleDC(0);
hdcTarget := CreateCompatibleDC(hdcSource);

// Get the size of the system defalt check-mark bitmap and
// create a compatible bitmap of the same size
wBitmapX := GetSystemMetrics(SM_CXMENUCHECK);
wBitmapY := GetSystemMetrics(SM_CYMENUCHECK);
hbmpCheck := CreateCompatibleBitmap(hdcSource,wBitmapX,wBitmapY);

// select the background bursh and bitmap into the target DC
hbrTargetOld := SelectObject(hdcTarget, hbrBackground);
hbmpTargetOld := SelectObject(hdcTarget, hbmpCheck);

// use the selected brush to initialize the background color
// of the bitmap in the target device context

PatBlt(hdcTarget, 0, 0, wBitmapX, wBitmapY, PATCOPY);

// load the predefined check box bitmaps and select it
// into the source DC
hbmpCheckBoxes := //LoadImage(hInstance,'ICON_MENUCLKSET',IMAGE_ICON,0,0,
//LR_DEFAULTSIZE);
LoadBitmap(hInstance,'BITMAP_MENUCLKSET');
hbmpSourceOld := SelectObject(hdcSource, hbmpCheckBoxes);

// fill a BITMAP structrure with information about the
// check box bitmaps and then find the upper-left corner of
// the unchecked check box or the checked check box

GetObject(hbmpCheckBoxes, sizeof(bmCheckBox), @bmCheckBox);
if fuCheck = MF_CHECKED then begin
rc.left := 0;
rc.right := bmCheckBox.bmWidth;
end
else begin
rc.Left := 0;
rc.Right := bmCheckBox.bmWidth;
end;
rc.Top := 0;
rc.Bottom := bmCheckBox.bmHeight ;

// copy the appropriate bitmap into the target DC. if the
// check-box bitmap is larger than the default check-mark
// bitmap, use StrechBlt to make it fit; otherwise , just
// Copy it

if ( rc.Right - rc.Left > wBitmapX) or
( rc.Bottom - rc.Top > wBitmapY) then
begin
StretchBlt(hdcTarget, 0, 0, wBitmapX, wBitmapY,
hdcSource, rc.left, rc.top, rc.right - rc.left,
rc.bottom - rc.top, SRCCOPY);
end
else begin
BitBlt(hdcTarget, 0, 0, rc.right - rc.left,
rc.bottom - rc.top,
hdcSource, rc.left, rc.top, SRCCOPY);
end;

// select the old source and destination bitmaps into the
// source and destination DCs and then delete the DCs and
// the background brush

SelectObject(hdcSource, hbmpSourceOld);
SelectObject(hdcTarget, hbrTargetOld);
hbmpCheck := SelectObject(hdcTarget, hbmpTargetOld);

DeleteObject(hbrBackground);
DeleteObject(hdcSource);
DeleteObject(hdcTarget);

// return a handle to the new check-mark bitmap

result := hbmpCheck;
end;

function SetMenuOwnerDraw(menu : HMENU; cmdID : integer):BOOL;
var
menuInfo : TMENUITEMINFO;
begin
result := false;
if menu = 0 then exit;
//if not GetMenuItemInfo(menu, cmdID, FALSE, menuInfo) then exit;
menuInfo.cbSize := SizeOf(menuInfo);
menuInfo.fMask := MIIM_CHECKMARKS or MIIM_DATA or MIIM_ID or
MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE;
menuInfo.fType := MFT_OWNERDRAW;
menuInfo.wID := cmdID;
menuInfo.fState := MFS_DEFAULT;
menuInfo.hSubMenu := 0;
menuInfo.hbmpChecked := 0;
menuInfo.hbmpUnchecked := 0;
menuInfo.hbmpItem := 0;
menuInfo.dwItemData := 0;
menuInfo.dwTypeData := 'Hello';
SetMenuItemInfo(menu, cmdID, FALSE, menuInfo);
end;

function DrawBmpMenu(itemMenu : DRAWITEMSTRUCT):BOOL;
var
orgrect, rG, rect: TRect;
p : TPoint;
DC : HDC;
bmpDC : HDC;
lb : LOGBRUSH;
oldBrush,Brush : HBRUSH;
oldbmp,bmp,bufBmp : HBITMAP;
BKcolor,txtColor : DWORD;
oldRight : integer;
i : integer;
begin
rect := itemMenu.rcItem;
//DC := CreateCompatibleDC(itemMenu.hDC);
DC := itemMenu.hDC;
{
bufBmp := CreateCompatibleBitmap(DC,
rect.right - rect.left,rect.bottom-rect.top);
SelectObject(DC,bufBmp);
}
//Brush := CreateSolidBrush(GetSysColor(COLOR_MENU));
//SelectObject(DC,brush);
//DeleteObject(brush);
//DC := itemMenu.hDC;
orgrect := rect;
{
rect.Bottom := rect.Bottom -rect.Top;
rect.Right := rect.Right - rect.left;
rect.top := 0;
rect.left := 0;
}
bmpDC := CreateCompatibleDC(DC);
if (itemMenu.itemAction = ODA_DRAWENTIRE) then begin
BKcolor := GetSysColor(COLOR_MENU);
txtColor := GetSysColor(COLOR_MENUTEXT);
end
else if itemMenu.itemAction = ODA_SELECT then begin
if not BOOL(itemMenu.itemState and ODS_SELECTED) then begin
BKcolor := GetSysColor(COLOR_MENU);
txtColor := GetSysColor(COLOR_MENUTEXT);
end
else begin
BKcolor := GetSysColor(COLOR_HIGHLIGHT);
txtColor := GetSysColor(COLOR_HIGHLIGHTTEXT);
end;
end;

{
rG := rect;
Inc(rG.Left, 20);
if BKColor = GetSysColor(COLOR_HIGHLIGHT) then begin
for i:= 1 to 120 do begin
Brush := CreateSolidBrush(GetSysColor(COLOR_HIGHLIGHT) +
i*(Abs(GetSysColor(COLOR_HIGHLIGHT)-GetSysColor(COLOR_MENU)) div 120));
rG.Left := rg.Left +(rect.right-rect.left-20) div 120;
rG.right := rG.Left + (rect.right - rect.left - 20) div 120;
FillRect(DC,rG,Brush);
DeleteObject(Brush);
end;
end else begin }
Brush := CreateSolidBrush(DWORD(BKcolor));
FillRect(DC,rect,Brush);
DeleteObject(Brush);
{ end; }
rG := rect;
rG.Right := rect.Left +19;
Brush := CreateSolidBrush(GetSysColor(COLOR_MENU));
FillRect(DC,rG,Brush);
DeleteObject(Brush);
bmp := LoadBitmap(hInstance,'BITMAP_MENUCLKSET');
oldbmp := SelectObject(bmpDC,bmp);
Bitblt(DC,rect.left+3,rect.top+4,12,12,bmpDC,0,0,SRCCOPY);
SetBkColor(DC,BKcolor);
SetTextColor(DC,txtColor);
TextOut(DC,rect.left + 22,rect.top+2,'Clock setting',13);
if BKColor = GetSysColor(COLOR_HIGHLIGHT) then
begin
Brush := CreateSolidBrush(RGB(255,0,0));
Inc(rect.Left,18);
FrameRect(DC,rect,Brush);
DeleteObject(Brush);
Dec(rect.Left,18);
OldRight := rect.Right;
rect.Right := rect.Left + 17;
DrawEdge(DC,rect,EDGE_RAISED,BF_RECT);
rect.Right := OldRight;
end;
{
BitBlt(itemMenu.hDC,orgrect.Left,orgrect.Top,
orgrect.Right - orgrect.Left,
orgrect.Bottom - orgrect.top,
DC,rect.Left,rect.top,SRCCOPY);
}
SelectObject(bmpDC,oldbmp);
DeleteDC(bmpDC);
{DeleteDC(DC);}
{DeleteObject(bufBmp);}
DeleteObject(bmp);

end;

function CreateRgnFromBmp(bmp : HBITMAP):HRGN;
var
bmpSize : BITMAP;
oldbmp : HBITMAP;
R , R1: HRGN;
DC : HDC;
transColor : COLORREF;
iWidth, iHeight, oldHeight : integer;
begin
GetObject(bmp,SizeOf(bmpSize),@bmpSize);
R := CreateRectRgn(0,0,bmpSize.bmWidth, bmpSize.bmHeight);
DC := CreateCompatibleDC(0);
oldbmp := SelectObject(DC,bmp);
transColor := GetPixel(DC,0,0);

for iWidth:=0 to bmpSize.bmWidth -1 do
begin
iHeight := 0;
while iHeight < bmpSize.bmHeight do
//for iHeight := 0 to bmpSize.bmHeight -1 do
begin
if GetPixel(DC,iWidth,iHeight) = transColor then
begin
oldHeight := iHeight;
while (iHeight<bmpSize.bmHeight) and
(GetPixel(DC,iWidth,iHeight+1)=transColor) do
inc(iHeight);
R1 := CreateRectRgn(iWidth,oldHeight,iWidth + 1,iHeight + 1);
CombineRgn(R,R,R1,RGN_DIFF);
DeleteObject(R1);
end else ;
inc(iHeight);
end;
end;
SelectObject(DC,oldBmp);
DeleteDC(DC);
result := R;
end;

function CreateAlfaRgn(x,y,r,Alfa,halfWidth,ArrowLen:integer):HRGN;
var
Ps : Array[1..5] of TPoint;
deg : double;
begin
deg := Alfa * (2*pi)/360;
Ps[1].x := Trunc(x - HalfWidth * sin(deg));
Ps[1].y := Trunc(y - HalfWidth * cos(deg));
Ps[2].x := Trunc(x + (r - ArrowLen) * cos(deg) - HalfWidth * sin(deg));
Ps[2].y := Trunc(y - (r - ArrowLen) * sin(deg) - HalfWidth * cos(deg));
Ps[3].x := Trunc(x + r * cos(deg));
Ps[3].y := Trunc(y - r * sin(deg));
Ps[4].x := Trunc(x + (r - ArrowLen) * cos(deg) + HalfWidth * sin(deg));
Ps[4].y := Trunc(y - (r - ArrowLen) * sin(deg) + HalfWidth * cos(deg));
Ps[5].x := Trunc(x + HalfWidth * sin(deg));
Ps[5].y := Trunc(y + HalfWidth * cos(deg));
result := CreatePolygonRgn(Ps, 5, WINDING);
end;

function CreateHourRgn(hour,minute:integer):HRGN;
var
d : double;
Alfa : integer;
begin
d := hour + minute / 60;
if (d - 12) > 0.001 then d:= d -12;
Alfa := Trunc(6 * (15 - d * 5));
result :=
CreateAlfaRgn(WIN_HALF_WIDTH, WIN_HALF_WIDTH, WIN_HALF_WIDTH - 17,
Alfa, 3, 5);

if BOOL(RgnCenter) then
CombineRgn(Result,Result,RgnCenter,RGN_DIFF);

end;

function CreateMinuteRgn(minute:integer):HRGN;
var
Alfa : integer;
begin
Alfa := (15 - minute) * 6;
result :=
CreateAlfaRgn(WIN_HALF_WIDTH, WIN_HALF_WIDTH, WIN_HALF_WIDTH - 12,
Alfa, 2, 4);

if BOOL(RgnCenter) then
CombineRgn(Result,Result,RgnCenter,RGN_DIFF);

end;

function CreateSecondRgn(second:integer):HRGN;
var
Alfa : integer;
begin
Alfa := ( 15 - second) * 6;
result :=
CreateAlfaRgn(WIN_HALF_WIDTH, WIN_HALF_WIDTH, WIN_HALF_WIDTH - 5,
Alfa, 1, 0);

if BOOL(RgnCenter) then
CombineRgn(Result,Result,RgnCenter,RGN_DIFF);

end;

end.

哇，好长的源代码啊，我喜欢，正在测试中......
测试通过！
不过PLAYICQ.COM就是源码空间吧？那分数，也应该分一点给其他人吧。