newabelsoft.pas

delphi写的对学习delphi初级入门的数据编程很有用。是用用来查找硬盘mp3文件

  This is necessary in order to properly handle when the user minimizes
  the form using the TASKBAR icon. }

procedure TTrayIcon.HookForm;
begin
  if (Owner as TWinControl) <> nil then
  begin
    // Hook the parent window
    OldWndProc := Pointer(GetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC));
    NewWndProc := MakeObjectInstance(HookFormProc);
    SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(NewWndProc));
  end;
end;


procedure TTrayIcon.UnhookForm;
begin
  if ((Owner as TWinControl) <> nil) and (Assigned(OldWndProc)) then
    SetWindowLong((Owner as TWinControl).Handle, GWL_WNDPROC, LongInt(OldWndProc));
  if Assigned(NewWndProc) then
    FreeObjectInstance(NewWndProc);
  NewWndProc := nil;
  OldWndProc := nil;
end;

{ All main form messages pass through HookFormProc. You can override the
  messages by not passing them along to Windows (via CallWindowProc).
  You should be careful with the graphical messages, though. }

procedure TTrayIcon.HookFormProc(var Msg: TMessage);
begin
  case Msg.Msg of

    WM_SHOWWINDOW: begin
      if (Msg.lParam = 0) and (Msg.wParam = 1) then
      begin
        // Show the taskbar icon (Windows may have shown it already)
        ShowWindow(Application.Handle, SW_RESTORE);
        // Bring the taskbar icon and the main form to the foreground
        SetForegroundWindow(Application.Handle);
        SetForegroundWindow((Owner as TWinControl).Handle);
      end;
    end;
{
    WM_WINDOWPOSCHANGED: begin
      // Bring any modal forms owned by the main form to the foreground
      if Assigned(Screen.ActiveControl) then
        SetFocus(Screen.ActiveControl.Handle);
    end;
}
    WM_ACTIVATE: begin
      // Bring any modal forms owned by the main form to the foreground
      if Assigned(Screen.ActiveControl) then
        if (Msg.WParamLo = WA_ACTIVE) or (Msg.WParamLo = WA_CLICKACTIVE) then
          if Assigned(Screen.ActiveControl.Parent) then
          begin
            // Control on modal form is active
            if HWND(Msg.lParam) <> Screen.ActiveControl.Parent.Handle then
              SetFocus(Screen.ActiveControl.Handle);
          end
          else
          begin
            // Modal form itself is active
            if HWND(Msg.lParam) <> Screen.ActiveControl.Handle then
              SetFocus(Screen.ActiveControl.Handle);
          end;
    end;

  end;
  // Pass the message on
  Msg.Result := CallWindowProc(OldWndProc, (Owner as TWinControl).Handle,
                Msg.Msg, Msg.wParam, Msg.lParam);
end;


{ HandleIconMessage handles messages that go to the shell notification
  window (tray icon) itself. Most messages are passed through WM_TRAYNOTIFY.
  In these cases use lParam to get the actual message, eg. WM_MOUSEMOVE.
  The method sends the usual Delphi events for the mouse messages. It also
  interpolates the OnClick event when the user clicks the left button, and
  makes the menu (if any) popup on left and right mouse down events. }

procedure TTrayIcon.HandleIconMessage(var Msg: TMessage);

  function ShiftState: TShiftState;
  // Return the state of the shift, ctrl, and alt keys
  begin
    Result := [];
    if GetAsyncKeyState(VK_SHIFT) < 0 then
      Include(Result, ssShift);
    if GetAsyncKeyState(VK_CONTROL) < 0 then
      Include(Result, ssCtrl);
    if GetAsyncKeyState(VK_MENU) < 0 then
      Include(Result, ssAlt);
  end;

var
  Pt: TPoint;
  Shift: TShiftState;
  I: Integer;
  M: TMenuItem;
begin
  if Msg.Msg = WM_TRAYNOTIFY then
  // Take action if a message from the icon comes through
  begin
    case Msg.lParam of

      WM_MOUSEMOVE:
        if FEnabled then
        begin
          Shift := ShiftState;
          GetCursorPos(Pt);
          MouseMove(Shift, Pt.X, Pt.Y);
        end;

      WM_LBUTTONDOWN:
        if FEnabled then
        begin
          Shift := ShiftState + [ssLeft];
          GetCursorPos(Pt);
          MouseDown(mbLeft, Shift, Pt.X, Pt.Y);
          FClickStart := True;
          if FLeftPopup then
            PopupAtCursor;
        end;

      WM_RBUTTONDOWN:
        if FEnabled then
        begin
          Shift := ShiftState + [ssRight];
          GetCursorPos(Pt);
          MouseDown(mbRight, Shift, Pt.X, Pt.Y);
          PopupAtCursor;
        end;

      WM_MBUTTONDOWN:
        if FEnabled then
        begin
          Shift := ShiftState + [ssMiddle];
          GetCursorPos(Pt);
          MouseDown(mbMiddle, Shift, Pt.X, Pt.Y);
        end;

      WM_LBUTTONUP:
        if FEnabled then
        begin
          Shift := ShiftState + [ssLeft];
          GetCursorPos(Pt);
          if FClickStart then       // Then WM_LBUTTONDOWN was called before
          begin
            FClickStart := False;
            Click;                  // We have a click
          end;
          MouseUp(mbLeft, Shift, Pt.X, Pt.Y);
        end;

      WM_RBUTTONUP:
        if FEnabled then
        begin
          Shift := ShiftState + [ssRight];
          GetCursorPos(Pt);
          MouseUp(mbRight, Shift, Pt.X, Pt.Y);
        end;

      WM_MBUTTONUP:
        if FEnabled then
        begin
          Shift := ShiftState + [ssMiddle];
          GetCursorPos(Pt);
          MouseUp(mbMiddle, Shift, Pt.X, Pt.Y);
        end;

      WM_LBUTTONDBLCLK:
        if FEnabled then
        begin
          DblClick;
          { Handle default menu items. But only if LeftPopup is false,
            or it will conflict with the popupmenu, when it is called
            by a click event. }
          M := nil;
          if Assigned(FPopupMenu) then
            if (FPopupMenu.AutoPopup) and (not FLeftPopup) then
              for I := PopupMenu.Items.Count -1 downto 0 do
              begin
                if PopupMenu.Items[I].Default then
                  M := PopupMenu.Items[I];
              end;
          if M <> nil then
            M.Click;
        end;
      end;
  end

  else        // Messages that didn't go through the icon
    case Msg.Msg of
      { Windows sends us a WM_QUERYENDSESSION message when it prepares
        for shutdown. Msg.Result must not return 0, or the system will
        be unable to shut down. }
      WM_QUERYENDSESSION: begin
        Msg.Result := 1;
      end;
    else      // Handle all other messages with the default handler
      Msg.Result := DefWindowProc(IconData.Wnd, Msg.Msg, Msg.wParam, Msg.lParam);
    end;
end;


procedure TTrayIcon.SetIcon(Value: TIcon);
begin
  FIcon.Assign(Value);
  ModifyIcon;
end;


procedure TTrayIcon.SetIconVisible(Value: Boolean);
begin
  if Value then
    ShowIcon
  else
    HideIcon;
end;


procedure TTrayIcon.SetDesignPreview(Value: Boolean);
begin
  FDesignPreview := Value;
  SettingPreview := True;         // Raise flag
  SetIconVisible(Value);
  SettingPreview := False;        // Clear flag
end;


procedure TTrayIcon.SetCycleIcons(Value: Boolean);
begin
  FCycleIcons := Value;
  if Value then
    SetIconIndex(0);
  CycleTimer.Enabled := Value;
end;


procedure TTrayIcon.SetCycleInterval(Value: Cardinal);
begin
  FCycleInterval := Value;
  CycleTimer.Interval := FCycleInterval;
end;


procedure TTrayIcon.SetIconList(Value: TImageList);
begin
  FIconList := Value;
{
  // Set CycleIcons = false if IconList is nil
  if Value = nil then
    SetCycleIcons(False);
}
  SetIconIndex(0);
end;


procedure TTrayIcon.SetIconIndex(Value: Integer);
begin
  if FIconList <> nil then
  begin
    FIconIndex := Value;
    if Value >= FIconList.Count then
      FIconIndex := FIconList.Count -1;
    FIconList.GetIcon(FIconIndex, FIcon);
  end
  else
    FIconIndex := -1; 
  ModifyIcon;
end;


procedure TTrayIcon.SetHint(Value: String);
begin
  FHint := Value;
  ModifyIcon;
end;


procedure TTrayIcon.SetShowHint(Value: Boolean);
begin
  FShowHint := Value;
  ModifyIcon;
end;


function TTrayIcon.InitIcon: Boolean;
// Set icon and tooltip
var
  ok: Boolean;
begin
  Result := False;
  ok := True;
  if (csDesigning in ComponentState) then
  begin
    if SettingPreview then
      ok := True
    else
      ok := FDesignPreview
  end;

  if ok then
  begin
    IconData.hIcon := FIcon.Handle;
    if (FHint <> '') and (FShowHint) then
      StrLCopy(IconData.szTip, PChar(FHint), SizeOf(IconData.szTip)-1)
      // StrLCopy must be used since szTip is only 64 bytes
    else
      IconData.szTip := '';
    Result := True;
  end;
end;


function TTrayIcon.ShowIcon: Boolean;
// Add/show the icon on the tray
begin
  Result := False;
  if not SettingPreview then
    FIconVisible := True;
  begin
    if (csDesigning in ComponentState) then
    begin
      if SettingPreview then
        if InitIcon then
          Result := Shell_NotifyIcon(NIM_ADD, @IconData);
    end
    else
    if InitIcon then
      Result := Shell_NotifyIcon(NIM_ADD, @IconData);
  end;
end;


function TTrayIcon.HideIcon: Boolean;
// Remove/hide the icon from the tray
begin
  Result := False;
  if not SettingPreview then
    FIconVisible := False;
  begin
    if (csDesigning in ComponentState) then
    begin
      if SettingPreview then
        if InitIcon then
          Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
    end
    else
    if InitIcon then
      Result := Shell_NotifyIcon(NIM_DELETE, @IconData);
  end;
end;


function TTrayIcon.ModifyIcon: Boolean;
// Change icon or tooltip if icon already placed
begin
  Result := False;
  if InitIcon then
    Result := Shell_NotifyIcon(NIM_MODIFY, @IconData);
end;


procedure TTrayIcon.TimerCycle(Sender: TObject);
begin
  if Assigned(FIconList) then
  begin
    FIconList.GetIcon(FIconIndex, FIcon);
    CycleIcon;                    // Call event method
    ModifyIcon;
    
    if FIconIndex < FIconList.Count-1 then
      SetIconIndex(FIconIndex+1)
    else
      SetIconIndex(0);
  end;
end;


function TTrayIcon.ShowBalloonHint(Title: String; Text: String;
  IconType: TBalloonHintIcon; TimeoutSecs: TBalloonHintTimeOut): Boolean;
// Show balloon hint. Return false if error.
const
  aBalloonIconTypes: array[TBalloonHintIcon] of Byte =
    (NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR);
begin
  if FEnabled then
  begin
    // Remove old balloon hint
    with IconData do
    begin
      uFlags := uFlags or NIF_INFO;
      StrPCopy(szInfo, '');
    end;
    ModifyIcon;
    // Display new balloon hint
    with IconData do
    begin
      uFlags := uFlags or NIF_INFO;
      StrPCopy(szInfo, Text);
      StrPCopy(szInfoTitle, Title);
      uTimeout := TimeoutSecs * 1000;
      dwInfoFlags := aBalloonIconTypes[IconType];
    end;
    Result := ModifyIcon;
    { Remove NIF_INFO before next call to ModifyIcon (or else the balloon hint
      will redisplay itself) }
    with IconData do
      uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
  end
  else
    Result := True;
end;

function TTrayIcon.BitmapToIcon(const Bitmap: TBitmap;
  const Icon: TIcon; MaskColor: TColor): Boolean;
{ Render an icon from a 16x16 bitmap. Return false if error.
  MaskColor is a color that will be rendered transparently. Use clNone for
  no transparency. }
var
  BitmapImageList: TImageList;
begin
  BitmapImageList := TImageList.CreateSize(16, 16);
  try
    Result := False;
    BitmapImageList.AddMasked(Bitmap, MaskColor);
    BitmapImageList.GetIcon(0, Icon);
    Result := True;
  finally
    BitmapImageList.Free;
  end;
end;

function TTrayIcon.Refresh: Boolean;
// Refresh the icon
begin
  Result := ModifyIcon;
end;

procedure TTrayI