其他

开发平台：
Delphi

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.

						