{

 TPhantom Version 4.0

  erstellt von Roland Gruber 1999  (gruberroland@netscape.net)

  Diese Komponente darf in kommerziellen Anwendungen sowie
  zum privaten Gebrauch verwendet werden, solange der Name
  des Programmierers genannt wird (z.B. in einer Info-Box).

  Der Gebrauch der Komponente erfolgt auf eigene Gefahr
  und für etweige Schäden wird keine Haftung übernommen.
  (Auch wenn die Wahrscheinlichkeit dafür eher gering ist.)

  Wenn sie diese Komponente verbessern oder Anregungen
  haben würde ich mich über eine e-mail freuen.
  (gruberroland@netscape.net)

  ACHTUNG!!! Diese Komponente funktioniert nicht mit Win NT!

  Erklärung der Funktionen:

  Sichtbar: legt fest ob das Anwendungsformular sichtbar ist
  Serviceprocess: versteckt das Programm vor Strg+Alt+Entf
                  und verhindert, dass es beendet wird, wenn
                  sich der Benutzer ausloggt und unter einem
                  anderen Namen einloggt.
  Icondatei: Name der .ico-Datei die das Symbol für Taskleiste
             enthält.
  Iconsichtbarkeit: legt fest, ob das Icon in der Taskleiste
                    sichtbar ist.
  Popuprechts: Name des Popupmenüs, das erscheint, wenn der
               Benutzer mit der rechten Maustaste auf das
               Taskleistenicon klickt
  Popuplinks:  Dasselbe wie oben mit Klick auf die linke Taste
  Linksklick:  Ereignis,das ausgelöst wird, wenn der Benutzer
               mit der linken Maustaste auf das Icon klickt
  Rechtsklick: analog zu oben mit der rechten Taste
  Doppelklick: analog zu oben mit einem Doppelklick
  Blinken: Läßt die Schaltfläche in der Taskbar einmal blinken
           (!!!nach setzen auf true, wechselt es sofort zurück zu false (vorher blinkt es einmal) !!!)
  Blinkdauer: Legt fest, wie lange(ms) das Blinken anhält
  Prioritaet: Priorität der Anwendung
  }
 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 Sichtbar: 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 IconDatei: Ticon read fIconDatei write Wicondatei;
    property IconSichtbarkeit: boolean read fIconSichtbarkeit write WIconSichtbarkeit;
    property LinksKlick: TNotifyEvent read fLinksKlick write flinksklick;
    property RechtsKlick: TNotifyEvent read fRechtsKlick write fRechtsklick;
    property DoppelKlick: TNotifyEvent read fDoppelKlick write fDoppelklick;
    property PopupRechts: TPopupMenu read fPopupRechts write fPopuprechts;
    property PopupLinks: TPopupMenu read fPopupLinks write fPopuplinks;
    property Tip: string read FTip write SetTip;
    property Blinken: boolean read fblinken write blink;
    property Blinkdauer: integer read fblinkdauer write fblinkdauer;
    property Prioritaet: 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;
sichtbar:=true;
serviceprocess:=false;
iconsichtbarkeit:=false;
fblinken:=false;
fblinkdauer:=300;
prioritaet:=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 sichtbar=true then sichtbarmachen;
if sichtbar=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.
 