paramstr(x) med visible !

Hejsan lolle

Hvis du ændere din dpr fil til det følgende så kan du lave dit trick ...

program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  SysUtils;

{$R *.RES}
begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  if ParamCount > 0 then
    Application.ShowMainForm := UpperCase(ParamStr(1)) <> '-START';

  Application.Run;
end.


Jens B

Hvaa gør det der???

Viser den Form1 i Tray kun når -start er efter ???

Hvis du giver programmet parameteren -start så vises din form ikke ellers gør den !

Her har du det samme kode bare i en noget mindre kompakt form :

program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  SysUtils;

{$R *.RES}
var
  Start : String;
begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Start := '';
  if ParamCount > 0 then
  begin
    Start := UpperCase(ParamStr(1));
    if Start = '-START' then
      Application.ShowMainForm := false;
  end;
  Application.Run;
end.

Jeg har lige prøvet det og det dur, men jeg kan ikke bruge det fordi at jeg skal vise min MainForm i Trayen kun i trayen når -start er efter

Jeg formoder således du er mest til komplette svar ... her er et sådan...

Du tager en nyt delphi projekt. Ændere din dpr fil til det følgende:


program TrayIcon;

uses
  Windows,
  Forms,
  UnitTrayIcon in 'UnitTrayIcon.pas' {Form1},
  Dialogs,
  SysUtils;

{$R *.RES}
const
MemFileSize = 1024;
MemFileName = 'Tray Icon Test';

begin
CreateFileMapping(HWND($FFFFFFFF), nil,PAGE_READWRITE,0,MemFileSize, MemFileName);
if GetLastError <> ERROR_ALREADY_EXISTS
  then
  begin
      Application.Initialize;
      Application.CreateForm(TForm1, Form1);
      Application.ShowMainForm := UpperCase(ParamStr(1)) <> '-START';
      Application.Run;
  end
  else
  MessageDlg('One Instance Only', mtError, [mbOK],0);
end.

Så tager du og ændere unit1 til det følgende :

unit UnitTrayIcon;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Menus, ShellAPi;

const
  wm_IconMessage = wm_User;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    Details1: TMenuItem;
    Close1: TMenuItem;
    N1: TMenuItem;
    About1: TMenuItem;
    procedure Details1Click(Sender: TObject);
    procedure Close1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
  public
    nid: TNotifyIconData;
    Procedure InitializeNID;
    procedure IconTray (var Msg: TMessage);      message wm_IconMessage;
  end;

var
  Form1: TForm1;

implementation


{$R *.DFM}

Procedure TForm1.InitializeNID;
begin
  ShowWindow(Application.Handle, SW_HIDE);
  Icon.Handle :=  LoadIcon (HInstance, 'MAINICON');
  nid.cbSize := sizeof (nid);
  nid.wnd := Handle;
  nid.uID := 1; // icon ID
  nid.uCallBAckMessage := wm_IconMessage;
  nid.hIcon := Icon.Handle;
  nid.uFlags := nif_Message or nif_Icon or nif_Tip;
  strcopy (nid.szTip, PChar('Et lille HINT'));
  Shell_NotifyIcon (NIM_ADD, @nid);
end;

procedure TForm1.IconTray (var msg: TMessage);
var
  Pt: TPoint;
begin
  if Msg.lParam = wm_rbuttondown then
  begin
    GetCursorPos (Pt);
    PopupMenu1.Popup (Pt.x, Pt.y);
  end;
  if Msg.lParam = wm_lbuttondblclk then
    Details1Click (self);
end;

procedure TForm1.Details1Click(Sender: TObject);
begin
  nid.uFlags := 0;
  Shell_NotifyIcon (NIM_DELETE, @nid);
  ShowWindow (Handle, sw_ShowNormal);
  SetForegroundWindow (Handle);
  Show;
end;

procedure TForm1.Close1Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  InitializeNID;
  Action := caNone;
  ShowWindow (Handle, SW_HIDE);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  nid.uFlags := 0;
  Shell_NotifyIcon (NIM_DELETE, @nid);
end;

procedure TForm1.About1Click(Sender: TObject);
begin
  MessageDlg ('Notify Icon Data Demo' + #13+  '    - By Jens Borrisholt' + #13 + '            © 1998', mtInformation, [mbOk], 0);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;  Shift: TShiftState);
begin
if key = 27 then
  Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  InitializeNID;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  InitializeNID;
  ShowWindow (Application.Handle, SW_HIDE);
    //If you omit this line the application will be shown in the taskbar when
    //the application is visible
end;

end.

Eksemplet er det TrayIcon eksempel du finder på http://borrisholt.com. Blot har jeg tilføjet to linjer i dpr filen.

Jens B

Tak det var mig som ikke lige kunne se hvordan første gang *GG*

Du får lige lidt flere point hvis du lige vil hjælpe mig med en anden ting ??

Vil du ???

Hvordan kan man få sit program til at starte og lukke med Windows ???

Jeg ved at man ved at start det med windows kan ligge en Genvej i Start->Programs->Startup (på engelsk) men hvordan kan man få den til at lukke med Windows ???

Jeg er ikke klar over hvad du gerne vil gøre ... Et program lukker automatisk når det får besked her om fra windows, med mindre man slev koder noget der laver om på det ...

Den der med at ligge ting ind i startup gøres som følger :

uses ComObj, ActiveX, ShlObj, Registry, filectrl;
const  SFolderKey = '\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders';  { Registry key where Folder information is kept }


function GetFolderLocation(const FolderType: string): string;
{ Retrieves from registry path to folder indicated in FolderType }
begin
  with TRegistry.Create do
    try
      RootKey := HKEY_CURRENT_USER;
      if not OpenKey(SFolderKey, False) then { open key where shell folder information is kept. }
        raise ERegistryException.CreateFmt('Folder key "%s" not found', [SFolderKey]);
      Result := ReadString(FolderType);  { Get path for specified folder }
      if Result = '' then
        raise ERegistryException.CreateFmt('"%s" item not found in registry',[FolderType]);
      CloseKey;
    finally
      Free;
    end;
end;

procedure MakeLink(AppName : String; StartIn : String = '';LinkLocation : String= '');
var
  SL: IShellLink;
  PF: IPersistFile;
  LnkName: WideString;
begin
  if LinkLocation = '' then
    LinkLocation := GetFolderLocation('Startup');

  if LinkLocation[Length(LinkLocation)] <> #92 then
    LinkLocation := LinkLocation + #92;

  AppName := ExpandFileName(AppName);

  if (not FileExists(AppName)) and (not DirectoryExists(LinkLocation))then
    exit;

  OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, SL)); { IShellLink implementers are required to implement IPersistFile }
  PF := SL as IPersistFile;
  OleCheck(SL.SetPath(PChar(AppName)));  // set link path to proper file
  StartIn := '"' + StartIn + '"';
  SL.SetArguments(PChar(StartIn));
  LnkName := PChar(LinkLocation) + ChangeFileExt(ExtractFileName(AppName), '.lnk');
  PF.Save(PWideChar(LnkName), True);      // save link file
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  if ParamCount = 0 then
    MakeLink(Application.ExeName,'C:\Billeder\');
end;

Jeg har ikke mere tid nu. Jeg er nød til at arbejde, der er faktisk derfor jeg sidder her, dennne søndag morgen :o)

Jens B