Du kan i stedet for bruge systray componenten fra RxLib. RxLib er en amsling af fantastisk gode Freeware componenter som du frit kan benytte i dit delphi program Du kan hente pakken her: http://www.rxlib.com
skovhus>Selvfølgelig kan du få en kopi også, og du behøver ikke at betale point for det. Samtidig med at andreas fik en kopi (i det spm. du henviser til) fik ckrame også en og det skulle han heller ikke betale for. Men jeg ville selvfølgeligt være en klovn hvis jeg ikke tager imod dem du vil give.
Programmet, der kun er et eksempel med masser af kommentarer, er ganske rigtigt lavet i D3 men der er kun brugt standard komponenter så det bør virke direkte i D5. Men det er jo bare at prøve det. Jeg har ikke selv prøvet endnu.
Jeg sender dig en kopi, men vi har tidligere haft en diskution her på eksperten vedr. det med at "sælge" sine programmer, så for at ingen skal tro at det er det jeg gør, viser jeg også koden her sammen med svaret.
pas- og dfm-filerne er stort set standard og kan cut/pastes direkte her fra siden, men vær lige opmærksom på de 2 ekstra linier der er indsat i dpr-filen:
program systrayt;
uses Windows, // husk at tilføje denne Forms, Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
begin ShowWindow(Application.Handle, sw_Hide); // erstat Application.Initialize; med denne linie Application.ShowMainForm := False; // og husk denne linie også Application.CreateForm(TForm1, Form1); Application.Run; end.
nedenstående er så hhv. pas- og dfm-fil (som text)
const wm_IconNotification = wm_User + 100; // windows message system. Brug usermessages + 100 // for ikke at konflikte med windows egne messages // Bruges til at fortælle programmet at musepegeren // er på ikonet i tray og til at teste på museklik
RegStart = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Run'; // registryentry der sørger for // at programmet startes samtidig // med at en bruger logger på
procedure saet_trayicon; function AddTrayIconId(iconId: UINT; icon: THandle; tip: PChar): boolean; function DeleteTrayIconId(iconId: UINT): boolean; function ModifyTrayIconId(iconId: UINT; icon: THandle; tip: PChar): boolean; procedure AddRegistryEntry; procedure RemoveRegistryEntry; protected procedure WMIconNotification(var Msg: TMessage); message wm_IconNotification; public end;
var Form1 : TForm1; TrayTip : string; // den tekst der vises over ikonet når man bare lægger musepegeren på // uden at klikke
edtStartLoc : string; // navn på programmet. Bruges til at skrive i registry så programmet // kan starte igen når en bruger logger på
implementation
{$R *.DFM}
// tilføj trayikon function TForm1.AddTrayIconId(iconId: UINT; icon: THandle; tip: PChar): boolean; begin nid.uID := iconId; nid.hIcon := icon;
if tip <> nil then StrLCopy(nid.szTip, tip, SizeOf(nid.szTip)) else nid.szTip[0] := #0;
Result := Shell_NotifyIcon(NIM_ADD, @nid); end;
// fjern trayikon function TForm1.DeleteTrayIconId(iconId: UINT): boolean; begin nid.uId := iconId; Result := Shell_NotifyIcon(NIM_DELETE, @nid); end;
// ændre trayikon. NB! Denne funktion virker ikke altid korrekt. Derfor bruger jeg // den ikke. Jeg sletter og opretter en ny i stedet. Det virker. function TForm1.ModifyTrayIconId(iconId: UINT; icon: THandle; tip: PChar): boolean; begin nid.uID := iconId; nid.hIcon := icon;
if tip <> nil then StrLCopy(nid.szTip, tip, SizeOf(nid.szTip)) else nid.szTip[0] := #0;
Result := Shell_NotifyIcon(NIM_MODIFY, @nid); end;
// skriv programnavn i registry så det kan starte igen procedure TForm1.AddRegistryEntry; begin if Registry.OpenKey(RegStart, True) then begin Registry.WriteString('TrayVgt', edtStartLoc); Registry.CloseKey; end; end;
// fjern navnet fra registry hvis det ikke skal starte automatisk procedure TForm1.RemoveRegistryEntry; begin if Registry.OpenKey(RegStart, False) then begin Registry.DeleteValue('TrayVgt'); Registry.CloseKey; end; end;
// afhængig af valg, sæt trayikonhandle procedure TForm1.saet_trayicon; begin case trayiconid of icon_100 : trayicon := icon100.Picture.Icon.Handle; icon_101 : trayicon := icon101.Picture.Icon.Handle; end; end;
procedure TForm1.FormCreate(Sender: TObject); var SystemMenu: HMENU; begin // klargør til at sætte registry entry Registry := TRegistry.Create; Registry.RootKey := HKEY_LOCAL_MACHINE;
// sæt vars for tray-ikonhåndteringen nid.cbSize := SizeOf(TNOTIFYICONDATA); nid.Wnd := Handle; nid.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP; nid.uCallbackMessage := wm_IconNotification;
saet_trayicon; // sæt valgt ikons handle AddTrayIconId(TrayIconId, TrayIcon, PChar(TrayTip)); // tilføj ikon til trayareal
application.icon.assign(Icon100.picture); // sæt programmets ikon til samme billede // d.v.s. det billede der fremgår at stifinderen // under Project, Options, Application er det // default sat til samme ikon som ikon100 men // det ændres i runtime når man vælger en anden // dette fremgår så at ikonet i formens øverste // venstre hjørne og af knappen i startlinien.
// sæt label til valgt ikon på skærmbillede label1.color := claqua; label2.color := clbtnface;
// sæt programnavn så autostart kan virke næste gang en bruger logger på edtStartLoc := Application.ExeName;
procedure TForm1.FormDestroy(Sender: TObject); begin // firgør hukommelse allokeret til trayikon DeleteTrayIconId(TrayIconId); // frigør hukommelse allokeret til registry Registry.Free; end;
// sæt Windows messages vedr. museklik på trayikonet procedure TForm1.WMIconNotification(var Msg: TMessage); var MouseMsg: longint; Pt: TPoint; begin MouseMsg := Msg.LParam;
case MouseMsg of wm_LButtonDown : ; // enkeltklik med venstre museknap: Ingen aktion wm_RButtonUp : begin // enkeltklik med højre musetast: vis menuen GetCursorPos(Pt); pmnSysTrayEx.PopUp(Pt.X,Pt.Y); end;
wm_LButtonDblClk : M01Click(Self); // dobbeltklik med venstre musetast: vis skærm end; end;
procedure TForm1.button2Click(Sender: TObject); // knappen: Gem billede begin Hide; end;
procedure TForm1.Button1Click(Sender: TObject); // knappen: Afbryd program begin if checkbox1.Checked then begin AddRegistryEntry; end else begin RemoveRegistryEntry; end; close; end;
procedure TForm1.M02Click(Sender: TObject); // menu: afslut program begin Button1Click(Sender); end;
procedure TForm1.M01Click(Sender: TObject); // menu: vis opsætning begin if not Visible then begin Visible := True; end; end;
procedure TForm1.button3Click(Sender: TObject); // Knappen: Vælg ikon begin if DeleteTrayIconId(TrayIconId) then // fjern først den nuværende ikon begin if TrayIconId = icon_100 then // afhængig af hvilken der er vist, sæt den anden op (toggle ikoner) begin TrayIconId := icon_101; traytip := 'Ikon nr. 101'; label2.color := claqua; label1.color := clbtnface; application.icon.assign(Icon101.picture); // ændre også programmets ikon samtidig end else begin TrayIconId := icon_100; traytip := 'Ikon nr. 100'; label1.color := claqua; label2.color := clbtnface; application.icon.assign(Icon100.picture); // ændre også programmets ikon samtidig end; saet_trayicon; // sæt ikonhandle AddTrayIconId(TrayIconId, TrayIcon, PChar(TrayTip)); // tilføj ikonet til trayarealet end; end;
skovhus>Check din indbox. Der burde ligge en kopi af filerne i zippet format. Jeg brugte den mailid du har angivet på din "mini-site" her på eksperten. Hvis du vil have det sendt til en anden må du lige skrive en mail-id jeg kan sende til.
Har du ikke en hjemmeside, hvor du kunne oploade det engang for alle? Det ville da være lidt lettere for dig selv - fordi jeg er endnu en af dem som gerne vil have en kopi. / j@grin.dk
jo jeg har en hjemmeside men det er en proffessionel en, hvor mit firma viser de systemer vi fremstiller og sælger.
I løbet af kort tid åbner jeg dog en specifik Delphi hjemmeside med netop muligheden for at lægge sådanne små programmer og komponenter op til fri download for alle der har lyst.
Så indtil da vil jeg helst sende dem når nogen beder om det.
Men som jeg nævnte tidligere behøvede du ikke at give mig point for det, så hvis du fortryder så sig til så opretter jeg et spm. så du kan få dem tilbage.
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
Ny bruger
Nybegynder
Opret
Preview
