delphi做桌面气泡提醒程序

气泡提醒如图：

delphi源码

准备：GifImageD7组件（实现透明背景，否则image控件无法加载GIF图片）

源码如下：

uses  ExtCtrls;

// 取得桌面存放图标的listview句柄
function GetDesktopLvHand: THandle;
begin
  Result := FindWindow('progman', nil);
  Result := GetWindow(Result, GW_Child);
  Result := GetWindow(Result, GW_Child);
end;

// 取得图标的坐标位置
function GetIcoPosition(h: THandle; idx: Integer): TPoint;
var
  hpro, pid, dm, i: Cardinal;
  p: Pointer;
begin
  GetWindowThreadProcessId(h, pid);
  hpro := OpenProcess(PROCESS_ALL_ACCESS, False, pid);
  if hpro <> 0 then
    try
      p := VirtualAllocEx(hpro, nil, SizeOf(TPoint), MEM_COMMIT,
        PAGE_READWRITE);
      ListView_GetItemPosition(h, idx, TPoint(p^));
      ReadProcessMemory(hpro, p, @Result, SizeOf(Result), dm);
    finally
      VirtualFreeEx(hpro, p, 0, MEM_RELEASE);
      CloseHandle(hpro);
    end;
end;

// 取得图标的文本
function ListView_GetItemText_Ex(hwndLV: HWND; i, iSubItem: Integer;
  pszText: PChar; cchTextMax: Integer): Integer;
var
  LVItem: TLVItem;
  ProcessID, ProcessHD, Temp: DWORD;
  MemPoint: Pointer;
begin
  GetWindowThreadProcessId(hwndLV, ProcessID);

  ProcessHD := OpenProcess
    (PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, False,
    ProcessID);

  MemPoint := VirtualAllocEx(ProcessHD, nil, SizeOf(TLVItem) + cchTextMax,
    MEM_COMMIT, PAGE_READWRITE);

  LVItem.iSubItem := iSubItem;
  LVItem.cchTextMax := cchTextMax;
  LVItem.pszText := PChar(Integer(MemPoint) + SizeOf(TLVItem));

  WriteProcessMemory(ProcessHD, MemPoint, @LVItem, SizeOf(TLVItem), Temp);
  Result := SendMessage(hwndLV, LVM_GETITEMTEXT, i, Integer(MemPoint));

  ReadProcessMemory(ProcessHD, Pointer(Integer(MemPoint) + SizeOf(TLVItem)),
    pszText, cchTextMax, Temp);

  VirtualFreeEx(ProcessHD, MemPoint, SizeOf(TLVItem) + cchTextMax,
    MEM_DECOMMIT);
  VirtualFreeEx(ProcessHD, MemPoint, 0, MEM_RELEASE);
end;

function GetIcoItemText(i: Integer): string;
var
  TextBuffer: array [0 .. 100] of char;
  FDeskTopLvHandle: THandle;
begin
  FDeskTopLvHandle := GetDesktopLvHand;
  ListView_GetItemText_Ex(FDeskTopLvHandle, i, 0, TextBuffer, 100);
  Result := TextBuffer;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  IcoCount, i: Integer;
  DeskToplvhandle: THandle;
  IcoPoint: TPoint;
begin
  // 取得桌面存放图标的Listview句柄
  DeskToplvhandle := GetDesktopLvHand;
  // 取得桌面图标的个数
  IcoCount := Listview_GetItemCount(DeskToplvhandle);

  for i := 0 to IcoCount - 1 do
  begin
    IcoPoint := GetIcoPosition(DeskToplvhandle, i);
        if GetIcoItemText(i)='我的电脑' then //桌面快捷方式名称
        begin
          form1.Top:=IcoPoint.Y-32; //提醒气泡位置
          form1.Left:=IcoPoint.X+32; //提醒气泡位置
        end;
  end;
end;

最后运行效果图：

图我随便做了下。。要漂亮的话还得花点心思