Ошибка ShellAPI.Shell_NotifyIcon

sorockinalex · #1 21.02.2013, 22:24

В общем, дела такие: Проект состоит из пакетов. Есть пакет DataModule.bpl, который компилируется первым... К этому пакету обращаются все остальные модули. На форме дата-модуля расположены запросы для баз данных, а в теле прописаны процедуры, которые часто встречаются... Есть также где-то намыленая функция отображения всплываюих подсказок, там для этого несколько процедур и сложная белеберда используется. Просто вставил и работает...

Теперь сам вопрос: Если в главном exe файле в свойствах проекта включить Build With Runtime Packages и в качестве пакета оставить только DataModule- то компиляция проходит успешно, программа работает как положено... А если убрать - то выдаёт ошибку в главном юните (Exe) в разделе Uses как раз на том самом DataModule и выдаёт ошибку:

Цитата:

[Fatal Error] Unit1.pas(8): Unit CoolTrayIcon was compiled with a different version of ShellAPI.Shell_NotifyIcon

Помогите пожалуйста победить наконец отключения из рантайм пакетов дата модуля, а то не могу сделать без этого полноценное его обновление при загрузке exe файла...

sorockinalex · #2 21.02.2013, 22:27

Вот верхняя часть кода этого модуля, в которой описана иконка трей, остальное просто процедуры для других модулей...

Код:

unit UDataModule;
 
interface
 
uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Forms,
  Dialogs,
  StdCtrls, //TLabel
  Grids, //TStringGrid
  DB,
  ADODB,
  IniFiles,
  Graphics, ImgList, Controls, IBDatabase, IBCustomDataSet, IBQuery, XPMan,
  Winsock;
//TColor
 
//  Windows, Messages, SysUtils,Classes,Dialogs, DB, ADODB, IniFiles, Forms, ExtCtrls;
 
{new constant definitions}
const
  NIF_INFO = $10;
  NIF_MESSAGE = 1;
  NIF_ICON = 2;
  NOTIFYICON_VERSION = 3;
  NIF_TIP = 4;
  NIM_SETVERSION = $00000004;
  NIM_SETFOCUS = $00000003;
  NIIF_INFO = $00000001;
  NIIF_WARNING = $00000002;
  NIIF_ERROR = $00000003;
 
  NIN_BALLOONSHOW = WM_USER + 2;
  NIN_BALLOONHIDE = WM_USER + 3;
  NIN_BALLOONTIMEOUT = WM_USER + 4;
  NIN_BALLOONUSERCLICK = WM_USER + 5;
  NIN_SELECT = WM_USER + 0;
  NINF_KEY = $1;
  NIN_KEYSELECT = NIN_SELECT or NINF_KEY;
 
  {other constants can be found in vs.net---vc7's dir: PlatformSDK\Include\ShellAPI.h}
 
  {define the callback message}
  TRAY_CALLBACK = WM_USER + $7258;
 
  {new NotifyIconData structure definition}
type
  PNewNotifyIconData = ^TNewNotifyIconData;
  TDUMMYUNIONNAME = record
    case Integer of
      0: (uTimeout: UINT);
      1: (uVersion: UINT);
  end;
 
  TNewNotifyIconData = record
    cbSize: DWORD;
    Wnd: HWND;
    uID: UINT;
    uFlags: UINT;
    uCallbackMessage: UINT;
    hIcon: HICON;
    //Version 5.0 is 128 chars, old ver is 64 chars
    szTip: array[0..127] of Char;
    dwState: DWORD; //Version 5.0
    dwStateMask: DWORD; //Version 5.0
    szInfo: array[0..255] of Char; //Version 5.0
    DUMMYUNIONNAME: TDUMMYUNIONNAME;
    szInfoTitle: array[0..63] of Char; //Version 5.0
    dwInfoFlags: DWORD; //Version 5.0
  end;
 
type
  Tallowrules = array[0..20] of Bool;
  TExecuteModal = procedure(H: HWND; Pars: string);
  TFamilyName = function: string;
  TPluginName = function: string;
  TMenuPosition = function: string;
 
  TDM = class(TDataModule)
    IBDatabase: TIBDatabase;
    IBQuery: TIBQuery;
    IBTransaction: TIBTransaction;
    XPManifest1: TXPManifest;
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    //Èêîíêà â òðåå è âñïëûâàþùèå ïîäñêàçêè
    IconData: TNewNotifyIconData;
    procedure SysTrayIconMsgHandler(var Msg: TMessage); message TRAY_CALLBACK;
    procedure ShowBalloonTips(s: string);
    procedure AddSysTrayIcon;
    procedure DeleteSysTrayIcon;
  public
    procedure EditKeyPressDigits(Sender: TObject; var Key: Char);
    procedure EditKeyPressDigits1(Sender: TObject; var Key: Char);
  end;
 
function LoadPlugin(PlName: string; H: HWND; Pars: string): string;
function SecondsIdle: DWord;
procedure UnloadPlugin(PluginName: string);
function GetHMODULE(PluginName: string): HMODULE;
procedure WritePluginHandleInArray(PluginName: string; WindowHandle: HWND);
procedure DelPluginFromArray(PluginName: string);
procedure LogOff(Sender: TObject);
procedure StrBreakApart(const S, Delimeter: string; Parts: TStrings);
function RemDoubleS(InputText, s: string): string;
function DoubleQuoting(InputText: string): string;
procedure ClearStringGrid(FRM: TForm; SG: TStringGrid);
procedure FillStringGrid1(FRM: TForm; SG: TStringGrid; LBL: TLabel);
function GetAllowedToLoadPluginNames(employeeid_: cardinal): TStringList;
function GetModuleRights(PluginName: string): Tallowrules;
function Encrypt(const InString: string; StartKey, MultKey, AddKey: Integer):
  string;
function Decrypt(const InString: string; StartKey, MultKey, AddKey: Integer):
  string;
procedure LoadFormProperties(FRM: TForm);
function GetLocalIP: string;
function GetSystemComputerName: string;
 
const
  MY_MESSAGE = WM_USER + 1;
  StartKey = 4275; // Start default key
  MultKey = 475683; // Mult default
  AddKey = 17973; // Add default key
 
type
  PluginIdNameHandle = record
    PluginId: HMODULE;
    PluginName: string;
    WindowHandle: HWND;
  end;
 
var
  DM: TDM;
  //Õýíäë ãëàâíîãî îêíà
  MainHandle: HWND;
  //Ìàññèâ äåñêðèïòîðîâ è íàçâàíèé çàãðóæåííûõ ìîäóëåé
  PluginsIdsNamesHandles: array of PluginIdNameHandle;
  //Ãëîáàëüíûå ïåðåìåííûå äëÿ ëîãèíà ïîëüçîâàòåëÿ
  logemployeeid,
    logemployeepersonalid: Cardinal;
  logemployeefirstname,
    logemployeelastname,
    logemployeepatronymic: string;
  logonid: Cardinal;
 
implementation
 
{$R *.dfm}
 
uses
  ShellAPI;
 
procedure TDM.SysTrayIconMsgHandler(var Msg: TMessage);
begin
  case Msg.lParam of
    WM_MOUSEMOVE: ;
    WM_LBUTTONDOWN: ;
    WM_LBUTTONUP: ;
    WM_LBUTTONDBLCLK: ;
    WM_RBUTTONDOWN: ;
    WM_RBUTTONUP: ;
    WM_RBUTTONDBLCLK: ;
    //followed by the new messages
    NIN_BALLOONSHOW: ;
    {Sent when the balloon is shown}
//      ShowMessage('NIN_BALLOONSHOW');
    NIN_BALLOONHIDE: ;
    {Sent when the balloon disappears?Rwhen the icon is deleted,
    for example. This message is not sent if the balloon is dismissed because of
    a timeout or mouse click by the user. }
//      ShowMessage('NIN_BALLOONHIDE');
    NIN_BALLOONTIMEOUT: ;
    {Sent when the balloon is dismissed because of a timeout.}
//      ShowMessage('NIN_BALLOONTIMEOUT');
    NIN_BALLOONUSERCLICK: ;
    {Sent when the balloon is dismissed because the user clicked the mouse.
    Note: in XP there's Close button on he balloon tips, when click the button,
    send NIN_BALLOONTIMEOUT message actually.}
//      ShowMessage('NIN_BALLOONUSERCLICK');
  end;
end;
 
{AddSysTrayIcon procedure add an icon to notification area}
 
procedure TDM.AddSysTrayIcon;
begin
  IconData.cbSize := SizeOf(IconData);
  IconData.Wnd := AllocateHWnd(SysTrayIconMsgHandler);
  {SysTrayIconMsgHandler is then callback message' handler}
  IconData.uID := 0;
  IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  IconData.uCallbackMessage := TRAY_CALLBACK; //user defined callback message
  IconData.hIcon := Application.Icon.Handle; //an Icon's Handle
  IconData.szTip := '';
  if not Shell_NotifyIcon(NIM_ADD, @IconData) then
    ShowMessage('add fail');
end;
 
{ShowBalloonTips procedure carry out the new feature: Balloon Tips}
 
procedure TDM.ShowBalloonTips(s: string);
var
  TipInfo, TipTitle: string;
begin
  IconData.cbSize := SizeOf(IconData);
  IconData.uFlags := NIF_INFO;
  TipInfo := s;
  strPLCopy(IconData.szInfo, TipInfo, SizeOf(IconData.szInfo) - 1);
  IconData.DUMMYUNIONNAME.uTimeout := 250;
  TipTitle := 'TPMDocs';
  strPLCopy(IconData.szInfoTitle, TipTitle, SizeOf(IconData.szInfoTitle) - 1);
  IconData.dwInfoFlags := NIIF_INFO; //NIIF_ERROR;  //NIIF_WARNING;
  Shell_NotifyIcon(NIM_MODIFY, @IconData);
  {in my testing, the following code has no use}
  IconData.DUMMYUNIONNAME.uVersion := NOTIFYICON_VERSION;
  if not Shell_NotifyIcon(NIM_SETVERSION, @IconData) then
    ShowMessage('setversion fail');
end;
 
{here's the deletion procedure}
 
procedure TDM.DeleteSysTrayIcon;
begin
  DeallocateHWnd(IconData.Wnd);
  if not Shell_NotifyIcon(NIM_DELETE, @IconData) then
    ShowMessage('delete fail');
end;

sorockinalex · #3 21.02.2013, 22:31

подозреваю, ошибка где-то здесь кроется... возможно при отключении Build With runtime packages в процессе компиляции где-то используется другой ShellApi

Код:

implementation
 
{$R *.dfm}
 
uses
  ShellAPI;

в глубинах делфи не силён, поэтому прошу помощи профи!

sorockinalex · #4 22.02.2013, 00:00

Блин, я что-то не понимаю... Прочитал уже три статьи про Build with runtime packages и не врубился, не могу получить ответа на свой вопрос:
Если в строку Build With Runtime Packages вписан только мой модуль DataModule.bpl - что это значит???
Значит он с загрузкой программы автоматически грузится в память и его не надо самому в программе подгружать? - нет, подгружаю, иначе вроде ошибка возникает...

Freeman · #5 22.02.2013, 20:33

Кажется, кто-то не совсем понимает концепцию пакетов. Почитай цикл статей Gunsmoker-а про создание плагинов. Многабукаф, но ничего другого приличного не знаю. Своими словами объяснять на форуме долго.

Или найди себе знающего дельфиста для очных консультаций.

Alegun · #6 22.02.2013, 22:41

Цитата:

Сообщение от sorockinalex

...[Fatal Error] Unit1.pas(8): Unit CoolTrayIcon was compiled with a different version of ShellAPI.Shell_NotifyIcon...

Не пойму, если глючит компонент CoolTrayIcon (он и в D7 глючит и даже простоTrayIcon балует тож, видно родовое проклятье такое у них у всех :О), причём здесь пакет DataModule.bpl. Если на время выкинуть из dclusr.dpk упоминание юнита с култрейайконом, симптомы остаются? Его лучше удалить из палитры и подключать прям в рантайме (многократно проверено)

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты