unttool.pas

半透明顯示在窗體上

           '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; Buffer:Pointer; 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