{******************************************************************************
*   Unit untTool
*   Module is support some tools function to the main module
*   CopyRight (C) Nanjing Fujitsu Nanda SoftWare Tech. Co., LTD.
*   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; Buffer:Pointer; BufSize:Integer):BOOL;
function GetRegData(Name:string; Buffer:Pointer; 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;
  //pStru:PAINTSTRUCT;
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
*
******************************************************************************}
var
  IconS : Array[1..4] of PChar =
          ('ICON_TRAY1','ICON_TRAY2',