AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

TNA

Ein Thema von maximi · begonnen am 10. Sep 2003 · letzter Beitrag vom 7. Nov 2003
Antwort Antwort
Seite 1 von 2  1 2      
maximi

Registriert seit: 9. Jun 2003
217 Beiträge
 
Delphi 7 Personal
 
#1

TNA

  Alt 10. Sep 2003, 10:44
Hallo!
Da ich noch nicht so viel von tna verstehe, habe ich mir mal nen Tutorial runtergeldaden und festegestellt, dass es nicht funktioniert.
Kann mir jemand helfen?


Delphi-Quellcode:
program TaskbarIcon;

{.$DEFINE BALLONNOTIFICATION}


uses
  Windows,
  Messages,
  DllVersion in '..\..\Common~1\DllVersion.pas',
  ShellAPI
{$IFDEF VER130}
  ,ShellAPI_Fragment in '..\..\Common~1\ShellAPI_Fragment.pas'
{$ENDIF}
  ;

const
  szClassname = 'TaskbarIcon-Demo';
  IDM_ABOUT = 1;
  IDM_CLOSE = 2;
  WM_TRAYMSG = WM_USER + 10;

var
  hm : HMENU;
  p : TPoint;
  shell32_ver : dword = 400; // Standardversion 4.0 der "shell32.dll"
  dll : DWORD = 0;
  ver : TDllVersionInfo;

var
  NID : TNotifyIconData = (
    uID : 1052002;
    uFlags : NIF_MESSAGE or NIF_ICON or NIF_TIP;
    uCallbackMessage : WM_TRAYMSG;
    hIcon : 0;
    szTip : szClassname;
  );


//
// "WndProc"
//
function WndProc(wnd: HWND; uMsg: UINT; wp: wParam; lp: LParam): LRESULT; stdcall;
begin
  Result := 0;

  case uMsg of
    WM_CREATE:
      begin
        // Version der "shell32.dll" herausfinden
        dll := LoadLibrary('shell32.dll');
        if(dll <> 0) then
          begin
            DllGetVersion := GetProcAddress(dll,'DllGetVersion');
            if(@DllGetVersion <> nil) then
              begin
                fillchar(ver,sizeof(TDllVersionInfo),0);
                ver.cbSize := sizeof(TDllVersionInfo);
                if(DllGetVersion(@ver) = NOERROR) then
                  shell32_ver := (ver.dwMajorVersion * 100) + ver.dwMinorVersion;
              end;

            FreeLibrary(dll);
          end;

        // abhängig von der "shell32.dll" die Strukturgröße setzen!
        if(shell32_ver = 600) then NID.cbSize := sizeof(TNotifyIconData)
          else if(shell32_ver >= 500) then NID.cbSize := NOTIFYICONDATA_V2_SIZE
            else NID.cbSize := NOTIFYICONDATA_V1_SIZE;

        NID.wnd := wnd;
        NID.hIcon := LoadIcon(0,IDI_INFORMATION);

        // Balloon-Tipps nur ab "shell32.dll" Version 5.0
        if(shell32_ver >= 500) then
          begin
            NID.uFlags := NID.uFlags or NIF_INFO;
            NID.szInfo := 'Ein Beispiel für einen neuen Balloon-Tipp,' +
              #13#10 + 'der auch mehrzeilig sein kann.';
            NID.szInfoTitle := szClassname;
            NID.dwInfoFlags := NIIF_INFO;
          end;

        Shell_NotifyIcon(NIM_ADD,@NID);
        DestroyIcon(NID.hIcon);
      end;
    WM_TRAYMSG:
      case lp of
{$IFDEF BALLOONNOTIFICATION}
        NIN_BALLOONSHOW:
          MessageBox(0,'I see the balloon! :o)',szClassname,MB_OK or MB_ICONINFORMATION);
        NIN_BALLOONHIDE:
          MessageBox(0,'It´s gone ... :o(',szClassname,MB_OK or MB_ICONINFORMATION);
        NIN_BALLOONTIMEOUT:
          MessageBox(0,'KAWOOOM',szClassname,MB_OK or MB_ICONINFORMATION);
        NIN_BALLOONUSERCLICK:
          MessageBox(0,'U clicked the balloon',szClassname,MB_OK or MB_ICONINFORMATION);
{$ENDIF}
        WM_RBUTTONUP:
          begin
            hm := CreatePopupMenu;
            AppendMenu(hm,MF_STRING,IDM_ABOUT,'Information');
            AppendMenu(hm,MF_STRING,IDM_CLOSE,'Beenden');

            GetCursorPos(p);
            SetForegroundWindow(wnd);
            TrackPopupMenu(hm,TPM_RIGHTALIGN,p.X,p.Y,0,wnd,nil);

            DestroyMenu(hm);
          end;
        WM_LBUTTONDBLCLK:
          begin
            NID.hIcon := LoadIcon(0,IDI_WARNING);
            NID.szTip := 'geänderter Tooltipp-Text';

            if(shell32_ver >= 500) then
              begin
                NID.szInfo := 'Hier hat sich der Balloon-Tipp geändert';
                NID.szInfoTitle := szClassname;
                NID.dwInfoFlags := NIIF_WARNING;
              end;

            Shell_NotifyIcon(NIM_MODIFY,@NID);
          end;
      end;
    WM_COMMAND:
      case wp of
        IDM_ABOUT:
          if(shell32_ver >= 500) then
            begin
              NID.szInfo := 'TaskbarIcon-Demo, © 2002 Simmi.';
              NID.szInfoTitle := szClassname;
              NID.dwInfoFlags := NIIF_INFO;
              Shell_NotifyIcon(NIM_MODIFY,@NID);
            end
          else
            MessageBox(0,'TaskbarIcon-Demo, © 2002 Simmi.',szClassname,
              MB_OK or MB_ICONINFORMATION);
        IDM_CLOSE:
          SendMessage(wnd,WM_CLOSE,0,0);
      end;
    WM_DESTROY:
      begin
        Shell_NotifyIcon(NIM_DELETE,@NID);
        PostQuitMessage(0);
      end;
    else
      Result := DefWindowProc(wnd,uMsg,wp,lp);
  end;
end;

//
// MAIN
//
var
  wc: TWndClassEx = (
    cbSize : sizeof(TWndClassEx);
    Style : 0;
    lpfnWndProc : @WndProc;
    cbClsExtra : 0;
    cbWndExtra : 0;
    hIcon : 0;
    hCursor : 0;
    hbrBackground : 0;
    lpszMenuName : nil;
    lpszClassName : szClassname;
    hIconSm : 0;
  );
  msg: TMsg;
  tMutex : THandle;
  aWnd : HWND;

begin
  // nur eine Instanz des Programms darf aktiv sein
  tMutex := CreateMutex(nil,false,szClassname);
  if(GetLastError = ERROR_ALREADY_EXISTS) then
    begin
      MessageBox(0,'Die Demo läuft bereits.',szClassname,MB_OK or MB_ICONWARNING);
      Halt;
    end;

  // Fensterklasse registrieren, & Fenster erzeugen
  wc.hInstance := hInstance;
  if(RegisterClassEx(wc) = 0) then exit;
  aWnd := CreateWindowEx(0,szClassname,szClassname,
    0,0,0,0,0,0,0,hInstance,nil);
  if(aWnd = 0) then exit;
  ShowWindow(aWnd,SW_HIDE);
  UpdateWindow(aWnd);

  // Nachrichtenschleife
  while(GetMessage(msg,0,0,0)) do
    begin
      TranslateMessage(msg);
      DispatchMessage(msg);
    end;

  // Mutex freigeben
  CloseHandle(tMutex);
end.
  Mit Zitat antworten Zitat
Zerolith

Registriert seit: 12. Mär 2003
Ort: Kempten
188 Beiträge
 
Delphi 6 Enterprise
 
#2

Re: TNA

  Alt 10. Sep 2003, 11:21
also bei mir funktioniert das einwandfrei...

Delphi-Quellcode:
  Windows,
  Messages,
  DllVersion in '..\..\Common~1\DllVersion.pas',
  ShellAPI
{$IFDEF VER130}
  ,ShellAPI_Fragment in '..\..\Common~1\ShellAPI_Fragment.pas'
{$ENDIF}
  ;
ich denke dass der Fehler bei dir hier ist...

kopier die DLLVersion.pas und die ShellApi_Fragment.pas in dein Projekt verzeicnis und änder die Zeilen so ab:

Delphi-Quellcode:
  Windows,
  Messages,
  DllVersion,
  ShellAPI,
  ShellAPI_Fragment;
dann dürfte des scho gehen...

Welches Windows hast du?

cya
Daniel
  Mit Zitat antworten Zitat
maximi

Registriert seit: 9. Jun 2003
217 Beiträge
 
Delphi 7 Personal
 
#3

Re: TNA

  Alt 10. Sep 2003, 12:35
So, das hab ich jetzt verstanden, aber ich hab mir jetzt in der code libary noch etwas über tna anschauen und es funzt wieder nicht.


Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,ShellApi;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    IconData: TNotifyIconData;
  public
    { Public-Deklarationen }
    procedure WndProc(var Msg: TMessage); override;
    procedure WMSysCommand(var Message: TWMSysCommand);
              message WM_SYSCOMMAND;
   end;

              var
  Form1: TForm1;

implementation

{$R *.dfm}


//Icon neben Uhr anzeigen


//Icon beim beenden "zerstören"
procedure TfrmSysInfo.FormDestroy(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_DELETE, @IconData);
end;

//belegung der Maustaten
procedure TfrmSysInfo.WndProc(var Msg: TMessage);
var
  Point: TPoint;

begin
  if Msg.Msg = WM_USER + 20 then begin
    case Msg.lParam of
      WM_RBUTTONDOWN: begin
                        GetCursorPos(Point);
                        PopUpMenu1.PopUp(Point.X, Point.Y);
                      end;
      WM_LBUTTONDOWN: begin
                        frmInfo.ShowModal;
                      end;
      WM_LBUTTONUP: begin
                        frmInfo.Modalresult := 1;
                   end;
    end;
  end;
  inherited;
end;

//Form nach mimimieren nicht in Taskleiste anzeigen
procedure TfrmSysInfo.WMSysCommand(var Message: TWMSysCommand);
begin
     if Message.CmdType AND $FFF0 = SC_MINIMIZE then
        Hide
     else
     inherited;
end;

//???
procedure TfrmSysInfo.FormShow(Sender: TObject);
var
   Owner: hWnd;
begin
     Owner := GetWindow(Handle, GW_OWNER);
     ShowWindow(Owner, SW_HIDE);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
     Application.ShowMainForm := False; //Programm gar nicht erst anzeigen
     IconData.cbSize := SizeOf(IconData);
     IconData.Wnd := Handle;
     IconData.uID := 100;
     IconData.uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
     IconData.uCallBackMessage := WM_USER + 20;
     IconData.hIcon := Application.Icon.Handle;
     IconData.szTip := 'SysInfo';
     Shell_NotifyIcon(NIM_ADD, @IconData); // fügt das Icon ein

end;


end.
Ich hab XP
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#4

Re: TNA

  Alt 10. Sep 2003, 12:40
Das erste Beispiel ist wohl aus den Win32API-Tutorials für Delphi. Allerdings sind deine Fehlerbeschreibungen sehr aussagekräftig. Mit "Geht nicht." kann man sehr viel anfangen und dir sehr geziehlt helfen.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Zerolith

Registriert seit: 12. Mär 2003
Ort: Kempten
188 Beiträge
 
Delphi 6 Enterprise
 
#5

Re: TNA

  Alt 10. Sep 2003, 12:43
Dacht i mir au grad =)

so kann man dem bub gut helfen
Daniel
  Mit Zitat antworten Zitat
maximi

Registriert seit: 9. Jun 2003
217 Beiträge
 
Delphi 7 Personal
 
#6

Re: TNA

  Alt 10. Sep 2003, 12:45
Da sind rund 20 Fehler. Da bin ich lang beschäftigt, die alle aufzuschreiben.
Kopiere nur den code und füge ihn bei Delphi ein, dann wirst du sehen, welche Fehlermeldungen da kommen.

Max
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#7

Re: TNA

  Alt 10. Sep 2003, 12:49
Er kennt TfrmSysInfo nicht? Wie wäre es, wenn du das an dein Projekt anpaßt? Ich sehe gerade, der VCL Code ist auch von mir.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Zerolith

Registriert seit: 12. Mär 2003
Ort: Kempten
188 Beiträge
 
Delphi 6 Enterprise
 
#8

Re: TNA

  Alt 10. Sep 2003, 12:54
Also bei lief das nach ein paar anpassungen einwandfrei...

Die Meisten Fehler traten nachm Kopieren dadurch auf dass ich diese ganzen Formulare nicht hatte... hab oben ein Paar PRoceduren noch einfügen müssen (Destroy und Show) musste n Popup aufs Form ziehn

und die Events halt noch machen... das geht doch das teil?!?

cya
Daniel
  Mit Zitat antworten Zitat
Zerolith

Registriert seit: 12. Mär 2003
Ort: Kempten
188 Beiträge
 
Delphi 6 Enterprise
 
#9

Re: TNA

  Alt 10. Sep 2003, 12:55
Zitat:
Wie wäre es, wenn du das an dein Projekt anpaßt?
ich wollt nit so unfreundlich sein =)
Daniel
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#10

Re: TNA

  Alt 10. Sep 2003, 13:08
OK. Hier für unsere Copy und Paste Freunde mundgerecht aufbereitet:
Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ShellAPI;

type
  TForm1 = class(TForm)
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    IconData: TNotifyIconData;
  public
    { Public-Deklarationen }
    procedure WndProc(var Msg: TMessage); override;
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

////////////////////////////////////////////////////////////////////////////////
// auf Mausklicks reagieren, Fensterprozedur erweitern

procedure TForm1.WndProc(var Msg: TMessage);
var
  Point: TPoint;
begin
  if Msg.Msg = WM_USER + 20 then
  begin
    case Msg.lParam of
      WM_RBUTTONDOWN:
        begin
          //ShowMessage('rechts runter');
        end;
      WM_LBUTTONDOWN:
        begin
          //ShowMessage('links runter');
        end;
      WM_LBUTTONDBLCLK:
        begin
          Form1.Show;
          // Icon nur anzeigen wenn Fenster minimiert
          Shell_NotifyIcon(NIM_DELETE, @IconData);
        end;
    end;
  end;
  inherited;
end;

////////////////////////////////////////////////////////////////////////////////
// beim Minimieren Fomr verstecken und Icon in die TNA

procedure TForm1.WMSysCommand(var Message: TWMSysCommand);
begin
  if Message.CmdType and $FFF0 = SC_MINIMIZE then
  begin
    Hide;
    // Icon nur anzeigen wenn Fenster minimiert
    Shell_NotifyIcon(NIM_ADD, @IconData);
  end
  else
    inherited;
end;

////////////////////////////////////////////////////////////////////////////////
// Beim beenden Icon entfernen

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_DELETE, @IconData);
end;

////////////////////////////////////////////////////////////////////////////////
// Beim Erstellen des Formulares TNotifyIconData-Struktur initialisieren

procedure TForm1.FormCreate(Sender: TObject);
begin
  //Application.ShowMainForm := False; //Programm gar nicht erst anzeigen
  IconData.cbSize := SizeOf(IconData);
  IconData.Wnd := Handle;
  IconData.uID := 100;
  IconData.uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
  IconData.uCallBackMessage := WM_USER + 20;
  IconData.hIcon := Application.Icon.Handle;
  IconData.szTip := 'Dies ist ein TNA-Icon';
  //Shell_NotifyIcon(NIM_ADD, @IconData); // fügt das Icon ein end;
end;

end.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2      


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:27 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz