www.pudn.com > oicqspysrc.zip > NWNotifyIcon.pas

unit NWNotifyIcon; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  ShellAPI, Menus; 
 
const 
  WM_IconMessage = WM_USER + 888; 
  WM_CtrlMsssage = WM_USER + 666; 
 
type 
  TNWNotifyIcon = class(TComponent) 
  private 
    { Private declarations } 
    FButtonDown: Boolean; 
    FButtonRect: TRect; 
    FCanvas: TCanvas; 
    FDown: Boolean; 
    FGlyph: TBitmap; 
    FIcon: TIcon; 
    FIconData : TNotifyIconData; 
    FIconPopupMenu: TPopupMenu; 
    FParentForm: TForm; 
    FPrevParentWndProc: Pointer; 
    FRightMargin: Integer; 
    FSeekAndDestroy: Boolean; 
    FVisible: Boolean; 
    procedure NewParentWndProc(var Msg: TMessage); 
    procedure PaintCaption(Down: Boolean); 
    procedure SetGlyph(Value: TBitmap); 
    procedure SetIcon(const Value: TIcon); 
    procedure SetIconPopupMenu(const Value: TPopupMenu); 
    procedure SetRightMargin(Value: Integer); 
    procedure SetVisible(Value: Boolean); 
  protected 
    { Protected declarations } 
    procedure Notification(AComponent: TComponent; Operation: TOperation); override; 
  public 
    { Public declarations } 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; 
  published 
    { Published declarations } 
    property Glyph: TBitmap read FGlyph write SetGlyph; 
    property Icon: TIcon read FIcon write SetIcon; 
    property IconPopupMenu: TPopupMenu read FIconPopupMenu write SetIconPopupMenu; 
    property RightMargin: Integer read FRightMargin write SetRightMargin default 68; 
    property Visible: Boolean read FVisible write SetVisible default True; 
  end; 
 
procedure Register; 
 
implementation 
 
{$R *.DCR} 
 
procedure Register; 
begin 
  RegisterComponents('NoctWolf', [TNWNotifyIcon]); 
end; 
 
constructor TNWNotifyIcon.Create(AOwner: TComponent); 
var 
  P: Pointer; 
begin 
  inherited Create(AOwner); 
  FCanvas := TCanvas.Create; 
  FGlyph := TBitmap.Create; 
  FIcon := TIcon.Create; 
 
  FGlyph.LoadFromResourceName(HInstance,'CAPTIONBMP'); 
  FIcon.Handle:=LoadIcon(HInstance,PChar('NOTIFYICON')); 
 
  FParentForm := TForm(AOwner); 
  FRightMargin:=68; 
  FVisible := True; 
 
  with FIconData do 
  begin 
    cbSize := SizeOf(FIconData); 
    Wnd := FParentForm.Handle; 
    uID := 0; 
    uFlags := nif_Icon Or nif_Message Or nif_Tip; 
    uCallBackMessage := WM_IconMessage; 
    hIcon := FIcon.Handle; 
    StrLCopy(szTip,PChar(Application.Title),64); 
  end; 
 
  FPrevParentWndProc := Pointer(GetWindowLong(FParentForm.Handle, GWL_WNDPROC)); 
  P := MakeObjectInstance(NewParentWndProc); 
  SetWindowLong(FParentForm.Handle, GWL_WNDPROC, LongInt(p)); 
end; 
 
destructor TNWNotifyIcon.Destroy; 
begin 
  Shell_NotifyIcon(NIM_DELETE,@FIconData); 
  if not FSeekAndDestroy then{ParentForm.HandleAllocated} 
  begin 
    Visible := False; 
    SetWindowLong(FParentForm.Handle, GWL_WNDPROC, LongInt(FPrevParentWndProc)); 
  end; 
  FIcon := TIcon.Create; 
  FGlyph.Free; 
  FCanvas.Free; 
  inherited Destroy; 
end; 
 
procedure TNWNotifyIcon.NewParentWndProc(var Msg: TMessage); 
var 
  Point: TPoint; 
  I: Integer; 
begin 
  with Msg do 
  begin 
    Result := CallWindowProc(FPrevParentWndProc, FParentForm.Handle, Msg, WParam, LParam); 
    if FVisible then 
    begin 
      if (Msg = wm_NCPaint) or (Msg = wm_NCActivate) then 
      begin 
        PaintCaption(False); 
      end 
      else if Msg = wm_NCHitTest then 
      begin 
        if Result = htCaption then 
        begin 
          Point.x := LoWord(lParam); 
          ScreenToClient(FParentForm.Handle, Point); 
          if (Point.x > FButtonRect.Left) and (Point.x < FButtonRect.Right) then 
          begin 
            if not FDown and FButtonDown then PaintCaption(True); 
            Result := WM_CtrlMsssage; 
          end 
          else if FDown then 
          begin 
            PaintCaption(False); 
          end; 
        end 
        else 
          if FDown then PaintCaption(False); 
      end 
      else if (Msg = wm_NCLButtonDown) or (Msg = wm_NCLButtonDblClk) then 
      begin 
        if wParam = WM_CtrlMsssage then 
        begin 
          if not FDown then PaintCaption(True); 
          if not FButtonDown then 
          begin 
            FButtonDown := True; 
            SetCapture(FParentForm.Handle); 
          end; 
        end 
        else 
        begin 
          if FDown then PaintCaption(False); 
          if FButtonDown then 
          begin 
            FButtonDown := False; 
            ReleaseCapture; 
          end; 
        end; 
      end 
      else if (Msg = wm_NCLButtonUp) or (Msg = wm_LButtonUp) then 
      begin 
        if FButtonDown then 
        begin 
          FButtonDown := False; 
          ReleaseCapture; 
          if FDown then 
          begin 
            FIconData.hIcon := FIcon.Handle; 
            Shell_NotifyIcon(NIM_ADD,@FIconData); 
            FParentForm.Hide; 
          end; 
        end; 
        if FDown then PaintCaption(False); 
      end 
      else if (Msg = wm_Close) or (Msg = wm_Destroy) then 
      begin 
        FSeekAndDestroy := True; 
      end 
      else if (Msg=WM_IconMessage)and(LParam=WM_RButtonDown)then 
      begin 
        if IconPopupMenu<>nil then 
        begin 
          SetForegroundWindow(FParentForm.Handle); 
          GetCursorPos(Point); 
          IconPopupMenu.Popup(Point.x,Point.y); 
        end; 
      end 
      else if(Msg=WM_IconMessage)and(LParam=WM_LButtonDblClk)then 
      begin 
        if not FParentForm.Showing then 
        begin 
          I := -1; 
          if FIconPopupMenu <> nil then 
            I := GetMenuDefaultItem(FIconPopupMenu.Handle,1,0); 
          if I > -1 then 
          begin 
            FIconPopupMenu.Items[I].Click; 
          end 
          else 
          begin 
            FParentForm.Show; 
            Shell_NotifyIcon(NIM_DELETE,@FIconData); 
          end; 
        end; 
      end; 
    end; 
  end; 
end; 
 
procedure TNWNotifyIcon.Notification(AComponent: TComponent; 
  Operation: TOperation); 
begin 
  inherited Notification(AComponent, Operation); 
  if (Operation = opRemove) and (AComponent = FIconPopupMenu) then 
    FIconPopupMenu := nil; 
end; 
 
procedure TNWNotifyIcon.PaintCaption(Down: Boolean); 
var 
  DC: hDC; 
  R: TRect; 
  Image, CaptionImage: TBitmap; 
  LeftX, x, y, FrameY: Integer; 
  Shift: Byte; 
 
  procedure DrawUpFrame; 
  begin 
    with FCanvas do 
    begin 
      Pen.Color := clBtnHighlight; 
      MoveTo(LeftX, FrameY + y + 1); 
      LineTo(LeftX, FrameY); 
      LineTo(LeftX + x + 3, FrameY); 
      Pen.Color := clBlack; 
      MoveTo(LeftX, FrameY + y + 2); 
      LineTo(LeftX + x + 2, FrameY + y + 2); 
      LineTo(LeftX + x + 2, FrameY - 1); 
      Pen.Color := clBtnShadow; 
      MoveTo(LeftX + x + 1, FrameY + 1); 
      LineTo(LeftX + x + 1, FrameY + y + 1); 
      LineTo(LeftX, FrameY + y + 1); 
      Shift := 1; 
    end; 
  end; 
 
  procedure DrawDownFrame; 
  begin 
    with FCanvas do 
    begin 
      Pen.Color := clBlack; 
      MoveTo(LeftX, FrameY + y + 1); 
      LineTo(LeftX, FrameY); 
      LineTo(LeftX + x + 3, FrameY); 
      Pen.Color := clBtnHighlight; 
      MoveTo(LeftX, FrameY + y + 2); 
      LineTo(LeftX + x + 2, FrameY + y + 2); 
      LineTo(LeftX + x + 2, FrameY - 1); 
      Pen.Color := clBtnShadow; 
      MoveTo(LeftX + x, FrameY + 1); 
      LineTo(LeftX + 1, FrameY + 1); 
      LineTo(LeftX + 1, FrameY + y + 1); 
      Pen.Color := clSilver; 
      MoveTo(LeftX + x + 1, FrameY + 1); 
      LineTo(LeftX + x + 1, FrameY + y + 1); 
      LineTo(LeftX, FrameY + y + 1); 
      Shift := 2; 
    end; 
  end; 
begin 
  DC:=0; 
  FDown := Down; 
  if FVisible then 
  begin 
    try 
      DC := GetWindowDC(FParentForm.Handle); 
      FCanvas.Handle := DC; 
      Image := TBitmap.Create; 
      CaptionImage := TBitmap.Create; 
      GetWindowRect(FParentForm.Handle, R); 
      R.Right := R.Right - R.Left; 
 
      if FParentForm.BorderStyle = bsSingle then 
        FrameY := GetSystemMetrics(sm_cyFrame) + 1 
      else if FParentForm.BorderStyle = bsDialog then 
        FrameY := GetSystemMetrics(sm_cyBorder) + 4 
      else if FParentForm.BorderStyle = bsSizeToolWin then 
        FrameY := GetSystemMetrics(sm_cySizeFrame) + 2 
      else if FParentForm.BorderStyle = bsToolWindow then 
        FrameY := GetSystemMetrics(sm_cyBorder) + 4 
      else 
        FrameY := GetSystemMetrics(sm_cyFrame) + 2; 
 
      LeftX := R.Right - RightMargin - FrameY; 
 
      if (FParentForm.BorderStyle = bsSizeToolWin) or 
         (FParentForm.BorderStyle = bsToolWindow) then 
      begin 
        y := GetSystemMetrics(sm_cySMCaption) - 8; 
        x := GetSystemMetrics(sm_cxSMSize) - 5; 
      end 
      else 
      begin 
        y := GetSystemMetrics(sm_cyCaption) - 8; 
        x := GetSystemMetrics(sm_cxSize) - 5; 
      end; 
 
      with FButtonRect do 
      begin 
        Left := LeftX - FrameY; 
        Top := FrameY; 
        Right := Left + x + 3; 
        Bottom := y + 2; 
      end; 
 
      if Down then 
        DrawDownFrame 
      else 
        DrawUpFrame; 
 
      Image.Assign(FGlyph); 
      Image.Canvas.Brush.Color:=clBtnFace; 
      Image.Canvas.BrushCopy(Image.Canvas.ClipRect,FGlyph,FGlyph.Canvas.ClipRect,FGlyph.Canvas.Pixels[0,FGlyph.Height-1]); 
      CaptionImage.Assign(Image); 
      CaptionImage.Canvas.Brush.Color:=clBtnText; 
      CaptionImage.Canvas.BrushCopy(CaptionImage.Canvas.ClipRect,Image,Image.Canvas.ClipRect,clBlack); 
 
      StretchBlt(DC, LeftX + Shift, FrameY + Shift, x, y, CaptionImage.Canvas.Handle, 0, 0, CaptionImage.Width, CaptionImage.Height, srcCopy); 
      CaptionImage.Free; 
      Image.Free; 
    finally 
      ReleaseDC(FParentForm.Handle, DC); 
    end; 
  end; 
end; 
 
procedure TNWNotifyIcon.SetGlyph(Value: TBitmap); 
begin 
  if FGlyph <> Value then 
  begin 
    FGlyph.Assign(Value); 
    SendMessage(FParentForm.Handle, wm_NCActivate, 0, 0); 
  end; 
end; 
 
procedure TNWNotifyIcon.SetIcon(const Value: TIcon); 
begin 
  if FIcon <> Value then 
  begin 
    FIcon.Assign(Value); 
    FIconData.hIcon := FIcon.Handle; 
    Shell_NotifyIcon(NIM_MODIFY,@FIconData); 
  end; 
end; 
 
procedure TNWNotifyIcon.SetIconPopupMenu(const Value: TPopupMenu); 
begin 
  if FIconPopupMenu <> Value then 
  begin 
    FIconPopupMenu := Value; 
    if Value <> nil then Value.FreeNotification(Self); 
  end; 
end; 
 
procedure TNWNotifyIcon.SetRightMargin(Value: Integer); 
begin 
  if FRightMargin <> Value then 
  begin 
    FRightMargin := Value; 
    SendMessage(FParentForm.Handle, wm_NCActivate, 0, 0); 
  end; 
end; 
 
procedure TNWNotifyIcon.SetVisible(Value: Boolean); 
begin 
  if FVisible <> Value then 
  begin 
    FVisible := Value; 
    SendMessage(FParentForm.Handle, wm_NCActivate, 0, 0); 
  end; 
end; 
 
end.