[Delphi] In Tray verschieben

Dieses Thema im Forum "Programmierung & Entwicklung" wurde erstellt von Smokers, 29. August 2007 .

  1. 29. August 2007
    In Tray verschieben

    Also habe folgendes Problem:
    Habe ein Chatprogramm geschrieben/angepasst....wobei das zweitere zutrifft( steh ich zu ),
    und nun würde ich jedoch gerne das Programm aus der Taskbar verschwinden lassen und in ein Tray Symbol das zur laufzeit ausgewählt werden soll , verwandeln.
    Jedoch kenne ich mich mit den ShellAPIS wenig aus.

    Könnte mir da mal jemand ein paar denk anstöße geben?
    Habe schon google benutzt und nur fertige Scripte gefunden die mir
    1. nicht wirklich einen Lösungsansatz geben
    2. nicht auf meine Form etc zu übertragen gehen.

    hier der Quellcode:

    Code:
    unit Chatmain;
    
    interface
    
    uses
     Classes, Messages, SysUtils, Graphics, Controls, ShellApi,
     Dialogs, Forms, Windows, QControls, QStdCtrls, QExtCtrls, QButtons,
     QForms, Sockets, QMenus, QTypes;
    
    
    type
     TForm1 = class(TForm)
     memRecv: TMemo;
     Panel1: TPanel;
     memSend: TMemo;
     Panel2: TPanel;
     btnSend: TButton;
     TcpClient1: TTcpClient;
     TcpServer1: TTcpServer;
     Panel3: TPanel;
     Label1: TLabel;
     edtRemoteHost: TEdit;
     combohide: TComboBox;
     btnhide: TButton;
     Label2: TLabel;
     procedure btnSendClick(Sender: TObject);
     procedure TcpServer1Accept(sender: TObject;
     ClientSocket: TCustomIpClient);
     procedure btnActivateServerClick(Sender: TObject);
     procedure memSendKeyPress(Sender: TObject; var Key: Char);
    
     private
     { Private declarations }
    
     public
     { Public declarations }
    
     end;
    
     // you must create your own thread to synch
     // writing to a gui component
     TClientDataThread = class(TThread)
     private
     public
     ListBuffer :TStringList;
     TargetList :TStrings;
     procedure synchAddDataToControl;
     constructor Create(CreateSuspended: Boolean);
     procedure Execute; override;
     procedure Terminate;
     end;
    
    var
     Form1: TForm1;
     //DataThread: TClientDataThread;
    
    implementation
    
    {$R *.xfm}
    
    //------------- TClientDataThread impl -----------------------------------------
    constructor TClientDataThread.Create(CreateSuspended: Boolean);
    begin
     inherited Create(CreateSuspended);
     FreeOnTerminate := true;
     ListBuffer := TStringList.Create;
    end;
    
    procedure TClientDataThread.Terminate;
    begin
     ListBuffer.Free;
     inherited;
    end;
    
    procedure TClientDataThread.Execute;
    begin
     Synchronize(synchAddDataToControl);
    end;
    
    procedure TClientDataThread.synchAddDataToControl;
    begin
     TargetList.AddStrings(ListBuffer);
    end;
    //------------- end TClientDataThread impl -------------------------------------
    
    
    procedure TForm1.btnActivateServerClick(Sender: TObject);
    begin
     TcpServer1.LocalPort := '5705' ;
     TcpServer1.Active := True;
    end;
    
    procedure TForm1.btnSendClick(Sender: TObject);
    var
     I: Integer;
    begin
    if memsend.Text <> '' then
     begin
     TcpClient1.RemoteHost := edtRemoteHost.Text;
     TcpClient1.RemotePort := '5705';
     try
     if TcpClient1.Connect then
     for I := 0 to memSend.Lines.Count - 1 do
     TcpClient1.Sendln(memSend.Lines[I]);
     finally
     TcpClient1.Disconnect;
     end;
     //by Smokers start
     memrecv.Text := memrecv.text + #13+#10 + 'Du sagtest: ' +#13+#10+ memsend.Text;
     memsend.Clear;
     memsend.SetFocus;
     end;
    end;
    
    procedure TForm1.TcpServer1Accept(sender: TObject;
     ClientSocket: TCustomIpClient);
    var
     s: string;
     DataThread: TClientDataThread;
    begin
     // create thread
     DataThread:= TClientDataThread.Create(true);
     // set the TagetList to the gui list that you
     // with to synch with.
     DataThread.TargetList := memRecv.lines;
    
     // Load the Threads ListBuffer
     DataThread.ListBuffer.Add('__ "'+ClientSocket.LookupHostName(ClientSocket.RemoteHost) + '" schreibt: __');
     s := ClientSocket.Receiveln;
     while s <> '' do
     begin
     DataThread.ListBuffer.Add(s);
     s := ClientSocket.Receiveln;
     end;
    
    
     // Call Resume which will execute and synch the
     // ListBuffer with the TargetList
     DataThread.Resume;
    
    end;
    
    procedure TForm1.memSendKeyPress(Sender: TObject; var Key: Char);
    begin
    if key = #13 then
     begin
     btnsend.Click;
     key:= #0;
    
     end;
    
    end;
    
    end.
    
     
  2. 29. August 2007
    AW: In Tray verschieben

    Kenne dieses Beispiel,

    wenn ich es in mein Projekt erstmal Simpel einbaue bekomme ich anderuernde Kompilierungsfehler:

    Inkompatible Typen :"HWND' und 'QOpenScrollViewH' ( so 8 mal )
    und Undefinierter Bezeichner 'LParamLo'
    etc


    ?? ^^°
     
  3. 29. August 2007
    AW: In Tray verschieben

    Poste mal pls den Code wo du es schon eingebaut hast. Vllt kann ich dir helfen ihn richtig einzubauen.
     
  4. 29. August 2007
    AW: In Tray verschieben

    Code:
    
    unit Chatmain;
    
    interface
    
    uses
     Classes, Messages, SysUtils, Graphics, Controls, ShellApi,
     Dialogs, Forms, Windows, QControls, QStdCtrls, QExtCtrls, QButtons,
     QForms, Sockets, QMenus, QTypes;
    
    const
     WM_TASKBAREVENT = WM_USER + 1;
    
    type
     TForm1 = class(TForm)
     memRecv: TMemo;
     Panel1: TPanel;
     memSend: TMemo;
     Panel2: TPanel;
     btnSend: TButton;
     TcpClient1: TTcpClient;
     TcpServer1: TTcpServer;
     Panel3: TPanel;
     Label1: TLabel;
     edtRemoteHost: TEdit;
     combohide: TComboBox;
     btnhide: TButton;
     Label2: TLabel;
     procedure btnSendClick(Sender: TObject);
     procedure TcpServer1Accept(sender: TObject;
     ClientSocket: TCustomIpClient);
     procedure btnActivateServerClick(Sender: TObject);
     procedure memSendKeyPress(Sender: TObject; var Key: Char);
    
     private
     { Private declarations }
     procedure WMTaskbarEvent(var Message: TMessage); message WM_TASKBAREVENT;
     public
     { Public declarations }
    
     end;
    
     // you must create your own thread to synch
     // writing to a gui component
     TClientDataThread = class(TThread)
     private
     public
     ListBuffer :TStringList;
     TargetList :TStrings;
     procedure synchAddDataToControl;
     constructor Create(CreateSuspended: Boolean);
     procedure Execute; override;
     procedure Terminate;
     end;
    
    var
     Form1: TForm1;
     //DataThread: TClientDataThread;
    
    implementation
    
    {$R *.xfm}
    
    //start new:
    procedure TaskBarAddIcon;
    var
     tnid: TNotifyIconData;
     Owner: HWnd;
    begin
     with tnid do
     begin
     cbSize := SizeOf(TNotifyIconData);
     Wnd := Form1.Handle;
     uID := 1;
     uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
     uCallbackMessage := WM_TASKBAREVENT;
     hIcon := Application.Icon.Handle;
     end;
     StrCopy(tnid.szTip, 'Tooltipp');
     Shell_NotifyIcon(NIM_ADD, @tnid);
    
     Owner:=GetWindow(Form1.Handle,GW_OWNER);
     If Owner<>0 Then
     ShowWindow(Owner,SW_HIDE);
    end;
    
    procedure TaskBarRemoveIcon;
    var
     tnid: TNotifyIconData;
     Owner: HWnd;
    begin
     tnid.cbSize := SizeOf(TNotifyIconData);
     tnid.Wnd := Form1.Handle;
     tnid.uID := 1;
     Shell_NotifyIcon(NIM_DELETE, @tnid);
     Owner:=GetWindow(Form1.Handle,GW_OWNER);
     If Owner<>0 Then Begin
     ShowWindow(Owner,SW_Show);
     ShowWindow(Owner,SW_Normal);
     End;
    end;
    
    procedure TForm1.WMTaskbarEvent(var Message: TMessage);
    var 
     Point: TPoint;
    begin
     case Message.LParamLo of
     WM_LBUTTONDOWN: TaskBarRemoveIcon;
     WM_RBUTTONDOWN: begin
     SetForegroundWindow(Handle);
     GetCursorPos(point);
     popupmenu1.popup(point.x,point.y);
     end;
     end;
    end;
    
    procedure TForm1.ApplicationEvents1Minimize(Sender: TObject);
    begin
     TaskBarAddIcon;
    end;
    
    
    //end new
    //------------- TClientDataThread impl -----------------------------------------
    constructor TClientDataThread.Create(CreateSuspended: Boolean);
    begin
     inherited Create(CreateSuspended);
     FreeOnTerminate := true;
     ListBuffer := TStringList.Create;
    end;
    
    procedure TClientDataThread.Terminate;
    begin
     ListBuffer.Free;
     inherited;
    end;
    
    procedure TClientDataThread.Execute;
    begin
     Synchronize(synchAddDataToControl);
    end;
    
    procedure TClientDataThread.synchAddDataToControl;
    begin
     TargetList.AddStrings(ListBuffer);
    end;
    //------------- end TClientDataThread impl -------------------------------------
    
    
    procedure TForm1.btnActivateServerClick(Sender: TObject);
    begin
     TcpServer1.LocalPort := '5705' ;
     TcpServer1.Active := True;
    end;
    
    procedure TForm1.btnSendClick(Sender: TObject);
    var
     I: Integer;
    begin
    if memsend.Text <> '' then
     begin
     TcpClient1.RemoteHost := edtRemoteHost.Text;
     TcpClient1.RemotePort := '5705';
     try
     if TcpClient1.Connect then
     for I := 0 to memSend.Lines.Count - 1 do
     TcpClient1.Sendln(memSend.Lines[I]);
     finally
     TcpClient1.Disconnect;
     end;
     //by Smokers start
     memrecv.Text := memrecv.text + #13+#10 + 'Du sagtest: ' +#13+#10+ memsend.Text;
     memsend.Clear;
     memsend.SetFocus;
     end;
    end;
    
    procedure TForm1.TcpServer1Accept(sender: TObject;
     ClientSocket: TCustomIpClient);
    var
     s: string;
     DataThread: TClientDataThread;
    begin
     // create thread
     DataThread:= TClientDataThread.Create(true);
     // set the TagetList to the gui list that you
     // with to synch with.
     DataThread.TargetList := memRecv.lines;
    
     // Load the Threads ListBuffer
     DataThread.ListBuffer.Add('__ "'+ClientSocket.LookupHostName(ClientSocket.RemoteHost) + '" schreibt: __');
     s := ClientSocket.Receiveln;
     while s <> '' do
     begin
     DataThread.ListBuffer.Add(s);
     s := ClientSocket.Receiveln;
     end;
    
    
     // Call Resume which will execute and synch the
     // ListBuffer with the TargetList
     DataThread.Resume;
    
    end;
    
    procedure TForm1.memSendKeyPress(Sender: TObject; var Key: Char);
    begin
    if key = #13 then
     begin
     btnsend.Click;
     key:= #0;
    
     end;
    
    end;
    
    end.
    


    \\\\
    Hie rnochmal zum download als Projekt

    Download offline!
     
  5. 29. August 2007
    AW: In Tray verschieben

    Nein Delphi 7.
    Hab zwar auch Delphi 2006 drauf aber nutze nur den 7ner.
     
  6. 29. August 2007
    AW: In Tray verschieben

    Warum benutzt du dann die CLX anstatt der VCL ???

    Änder mal so deine Uses ab, dann solltest du es kompilieren können.
    Code:
    uses
     Classes, Messages, SysUtils, Graphics, Controls, ShellApi,
     Dialogs, Forms, Windows, Controls, StdCtrls, ExtCtrls, Buttons,
     Forms, Sockets, Menus, Types;
    
     
  7. 29. August 2007
    AW: In Tray verschieben

    Also 2 fehler hab ich noch :

    [Fehler] Chatmain.pas(107): Undefinierter Bezeichner: 'LParamLo'
    [Fehler] Chatmain.pas(117): Undefinierter Bezeichner: 'ApplicationEvents1Minimize'
    [Fehler] Chatmain.pas(117): ';' erwartet, aber '(' gefunden //*by Smokers
    [Fataler Fehler] Project1.dpr(5): Verwendete Unit 'Chatmain.pas' kann nicht compiliert werden


    * =
    procedure TForm1.ApplicationEvents1Minimize(Sender: TObject);

    \\und bei uses fügt er autom.:

    QStdCtrls, QControls, QExtCtrls, QTypes, QMenus;

    hinzu
     
  8. 29. August 2007
    AW: In Tray verschieben

    nimm doch einfach cooltrayicon das ist eine sehr einfach zu benuzende komponente die auch ein paar beispiele enthält

    hier der download http://rapidshare.com/files/52112212/CoolTrayIcon.zip.html
     
  9. 30. August 2007
    AW: In Tray verschieben

    Dann wird er wahrscheinlich trotzdem noch Probleme haben. Ich frag mich, warum Delphi die CLX einbindet ....
     
  10. Video Script

    Videos zum Themenbereich

    * gefundene Videos auf YouTube, anhand der Überschrift.