{

  TPhantom 4.0

  programming by Roland Gruber (gruberroland@netscape.net)

  You can use this component in commercial and noncommercial
  programms as long as you mention the author(i.g. in an infobox).

  The use of this component is at your own risk.
  I do not take any responsibility for any damages.

  If you improve this component I would be happy if you
  sent me a copy of the source code and if you have
  suggestions how to improve the component just send
  me an e-mail.
  (gruberroland@netscape.net)

  PAY ATTENTION!!! This component does not work with Win NT!

  How to use this component:

  Visible: defines if your form is visible or not
  Serviceprocess: hides the program from Strg+Alt+Entf
                  and makes sure that it is continued
                  even the user loggs of and loggs in under
                  a different name
  Iconfile: filename of the .ico-file for the taskbar icon
  Iconvisibility: defines if the taskbar icon is visible
  Popupright: name of the popup window that appears when
               the user right clicks on the taskbar icon
  Popupleft:  the same as above on left click
  Leftclick:  what happens if the user left clicks on
               the taskbar icon
  Rightclick: same as above on a right click
  Doubleclick: same as above on a double click
  Tip: Text that is shown when cursor is over taskbar icon
  Flash: flashes the button in the taskbar
         (!!! returns to false immediately after being set to true (one flashing)!!!)
  FlashTime: time(ms) of flashing
  Priority: Priority of the application
  }
 unit Phantom;

interface

uses
  Windows, wintypes, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  menus, shellapi, extctrls;

  const
  TASKBAREVENT: PChar = 'NewTNIMessage_20';

type

  TPrioritaet = (Idle, Normal, Hoch, Realtime);
  TPhantom = class(TComponent)
  private
    fIconDatei: Ticon;
    ftip:string  ;
    fSichtbar: Boolean ;
    fServiceprocess: Boolean ;
    fLinksKlick: TNotifyEvent;
    fRechtsKlick: TNotifyEvent;
    fDoppelKlick: TNotifyEvent;
    fIconSichtbarkeit: boolean;
    fPopupRechts: TPopupMenu;
    fPopupLinks: TPopupMenu;
    fblinken:boolean;
    fblinkdauer:integer;
    fprioritaet: TPrioritaet;
    { Private-Deklarationen }
    procedure PWsichtbarkeit(value:boolean);
    procedure PWserviceprocess(value:boolean);
    procedure sichtbarmachen;
    procedure unsichtbarmachen;
    procedure WPopRechts;
    procedure WPopLinks;
    procedure CreateIcon;
    procedure ChangeIcon;
    procedure DeleteIcon;
    procedure settip(value:string);
    procedure Wicondatei(value:Ticon);
    procedure WIconSichtbarkeit(value:boolean);
    procedure blink(value:boolean);
    procedure prioritaetsetzen(value:TPrioritaet);
  protected
    { Protected-Deklarationen }
    procedure serviceprocessEin;
    procedure serviceprocessAus;
    procedure WRechtsklick; virtual;
    procedure WLinksklick; virtual;
    procedure WDoppelklick; virtual;
    procedure WndProc(var Msg: TMessage);
    procedure Notification(Component: TComponent; Operation: TOperation); override;
  public
    { Public-Deklarationen }
      procedure loaded;override;
      destructor Destroy; override;
      constructor Create(AOwner: TComponent); override;
   published
    { Published-Deklarationen }
    property Visible: Boolean read fsichtbar write PWsichtbarkeit;{Formular verstecken/anzeigen}
    property Serviceprocess: Boolean read fserviceprocess write PWserviceprocess;{Als Service-Process registrieren/abmelden (gegen Strg+Alt+Entf)}
    property Iconfile: Ticon read fIconDatei write Wicondatei;
    property Iconvisibility: boolean read fIconSichtbarkeit write WIconSichtbarkeit;
    property Leftclick: TNotifyEvent read fLinksKlick write flinksklick;
    property Rightclick: TNotifyEvent read fRechtsKlick write fRechtsklick;
    property Doublelick: TNotifyEvent read fDoppelKlick write fDoppelklick;
    property PopupRight: TPopupMenu read fPopupRechts write fPopuprechts;
    property PopupLeft: TPopupMenu read fPopupLinks write fPopuplinks;
    property Tip: string read FTip write SetTip;
    property Flash: boolean read fblinken write blink;
    property FlashTime: integer read fblinkdauer write fblinkdauer;
    property Priority: TPrioritaet  read fprioritaet write prioritaetsetzen;
  end;

procedure Register;
function RegisterServiceProcess(dwProcessId,dwType:dword): Integer;stdcall;external 'kernel32.dll'

implementation

var ficonmessage: UINT;
    FWnd: HWnd;

constructor tphantom.Create(AOwner: TComponent) ;
begin
inherited Create(AOwner);
ficonmessage := RegisterWindowMessage(TASKBAREVENT);
FWnd := AllocateHWnd(WndProc);
FIcondatei := TIcon.Create;
iconvisibility:=false ;
visible:=true;
serviceprocess:=false;
fblinken:=false;
fblinkdauer:=300;
priority:=normal;
end;

destructor TPhantom.Destroy;
begin
  if Ficonsichtbarkeit then deleteIcon;
  FIcondatei.Free;
  DeallocateHWnd(FWnd);
  inherited destroy;
end;

procedure TPhantom.WndProc(var Msg: TMessage);
begin
  with Msg do begin
    if Msg = ficonmessage then
      case LParamLo of
        WM_LBUTTONDOWN:   WLinksKlick;
        WM_RBUTTONDOWN:   WRechtsKlick;
        WM_LBUTTONDBLCLK: WDoppelKlick;
      end
    else
      Result := DefWindowProc(FWnd, Msg, wParam, lParam);
  end;
end;

procedure TPhantom.Notification(Component: TComponent; Operation: TOperation);
begin
  inherited Notification(Component, Operation);
  if Operation = opRemove then begin
    if Component = FPopuprechts then FPopuprechts := nil;
    if Component = FPopuplinks then FPopuplinks := nil;
  end;
end;

procedure TPhantom.PWsichtbarkeit(value:boolean);
begin
fsichtbar:=value;
if (csDesigning in ComponentState) then exit;
if visible=true then sichtbarmachen;
if visible=false then unsichtbarmachen;
end;

procedure TPhantom.PWserviceprocess(value:boolean);
begin
fserviceprocess:=value;
if serviceprocess then serviceprocessEin;
if not serviceprocess then serviceprocessAus;
end;

procedure TPhantom.serviceprocessEin;
begin
if (csDesigning in ComponentState) then exit;
RegisterServiceProcess(GetCurrentProcessID,1)
end;

procedure TPhantom.serviceprocessAus;
begin
if (csDesigning in ComponentState) then exit;
RegisterServiceProcess(GetCurrentProcessID,0)
end;

procedure TPhantom.sichtbarmachen;
begin
if (csDesigning in ComponentState) then exit;
showwindow(FindWindow(nil, @Application.Title[1]),SW_RESTORE)
end;

procedure TPhantom.unsichtbarmachen;
var handle:HWND;
begin
if (csDesigning in ComponentState) then exit;
handle:=FindWindow(nil, @Application.Title[1]);
showwindow(handle,SW_MINIMIZE);
showwindow(handle,SW_HIDE) ;
end;

procedure TPhantom.WRechtsklick;
begin
if Assigned(FPopuprechts) then WPoprechts
  else if Assigned(FRechtsKlick) then
    FRechtsKlick(Self);
end;

procedure TPhantom.WLinksklick;
begin
if Assigned(FPopuplinks) then WPoplinks
  else if Assigned(FLinksKlick) then
    FLinksKlick(Self);
end;

procedure TPhantom.WDoppelklick;
begin
if Assigned(Fdoppelklick)then FDoppelKlick(Self);
end;

procedure TPhantom.WPopRechts;
var punkt:Tpoint;
begin
GetCursorPos(Punkt);
SetForeGroundWindow(FWnd);
FPopuprechts.Popup(Punkt.X, Punkt.Y);
end;

procedure TPhantom.WPopLinks;
var punkt:Tpoint;
begin
GetCursorPos(Punkt);
SetForeGroundWindow(FWnd);
FPopuplinks.Popup(Punkt.X, Punkt.Y);
end;

procedure TPhantom.CreateIcon;
var icon: TNOTIFYICONDATA;
begin
with icon do begin
    cbSize := SizeOf(TNOTIFYICONDATA);
    Wnd := FWnd;
    uID := 1;
    uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
    uCallbackMessage :=ficonMessage;
    hIcon := FIcondatei.Handle;
    StrCopy(szTip, PChar(FTip));
    Shell_NotifyIcon(NIM_ADD, @icon);
  end;
ficonsichtbarkeit:=true;
end;

procedure TPhantom.ChangeIcon;
var icon: TNOTIFYICONDATA;
begin
with icon do begin
    cbSize := SizeOf(TNOTIFYICONDATA);
    Wnd := FWnd;
    uID := 1;
    uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
    uCallbackMessage := ficonMessage;
    hIcon := FIcondatei.Handle;
    StrCopy(szTip, PChar(FTip));
    Shell_NotifyIcon(NIM_MODIFY, @icon);
  end;
ficonsichtbarkeit:=true;
end;

procedure TPhantom.DeleteIcon;
var icon: TNOTIFYICONDATA;
begin
with icon do begin
    cbSize := SizeOf(TNOTIFYICONDATA);
    Wnd := FWnd;
    uID := 1;
    uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
    uCallbackMessage := ficonmessage;
    hIcon := FIcondatei.Handle;
    StrCopy(szTip, PChar(FTip));
    Shell_NotifyIcon(NIM_DELETE, @icon);
  end;
ficonsichtbarkeit:=false;
end;

procedure TPhantom.settip(value:string);
begin
if FTip <> value then begin
    FTip := value;
    changeicon;
  end;
end;

procedure TPhantom.Wicondatei(value:Ticon);
begin
if ficondatei<>value then begin
      ficondatei.assign(value);
      if (csDesigning in ComponentState) then exit;
      if ficonsichtbarkeit then changeicon else createicon;
      if ficondatei.empty then deleteicon;
  end;
end;

procedure TPhantom.WIconSichtbarkeit(value:boolean);
begin
ficonsichtbarkeit:=value;
if not (csDesigning in ComponentState) then begin
   if ficonsichtbarkeit then createicon;
   if not ficonsichtbarkeit then deleteicon;
   end;
end;

procedure TPhantom.Loaded;
begin
  inherited Loaded;
  if Ficonsichtbarkeit and not FIcondatei.Empty then begin
    createIcon;
  end;
end;

procedure TPhantom.blink(value:boolean);
begin
fblinken:=value;
if fblinken=false then exit;
flashwindow(application.handle,true);
sleep(fblinkdauer);
flashwindow(application.handle,true);
fblinken:=false;
end;

procedure TPhantom.prioritaetsetzen(value:TPrioritaet);
begin
fprioritaet:=value;
if (csdesigning in componentstate) then exit;
case value of Idle : setpriorityclass(GetCurrentProcess(), IDLE_PRIORITY_CLASS);
              Normal : setpriorityclass(GetCurrentProcess(), NORMAL_PRIORITY_CLASS);
              Hoch : setpriorityclass(GetCurrentProcess(), HIGH_PRIORITY_CLASS);
              Realtime : setpriorityclass(GetCurrentProcess(), REALTIME_PRIORITY_CLASS);
   end;
end;

procedure Register;
begin
  RegisterComponents('Roland', [TPhantom]);
end;

end.
 