SysTray program fra sjensen

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

amsling=samling ;)

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)

pas-fil:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus, Filectrl,
  StdCtrls, ExtCtrls, ShellApi, Registry, Buttons, ComCtrls;

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å

  icon_100      = 100;  // ikonnumre
  icon_101      = 101;  // ikonnumre

type
  TForm1 = class(TForm)
    pmnSysTrayEx: TPopupMenu;
    M01: TMenuItem;
    M02: TMenuItem;
    button2: TBitBtn;
    Button1: TBitBtn;
    Panel1: TPanel;
    CheckBox1: TCheckBox;
    icon100: TImage;
    icon101: TImage;
    button3: TBitBtn;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure button2Click(Sender: TObject);
    procedure M01Click(Sender: TObject);
    procedure M02Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure button3Click(Sender: TObject);
  private
    nid: TNOTIFYICONDATA;
    Registry: TRegistry;
    TrayIconId: UINT;
    TrayIcon: HICON;

    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;

  // sæt start trayikon
  TrayIconId          := icon_100;
  traytip              := 'Ikon nr. 100';

  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;

  // fjern systemmenu fra form
  SystemMenu          := GetSystemMenu(Handle, False);
  DeleteMenu(SystemMenu, SC_TASKLIST, MF_BYCOMMAND);
  DeleteMenu(SystemMenu, 7, MF_BYPOSITION);
  DeleteMenu(SystemMenu, 5, MF_BYPOSITION);
  DeleteMenu(SystemMenu, SC_MAXIMIZE, MF_BYCOMMAND);
  DeleteMenu(SystemMenu, SC_MINIMIZE, MF_BYCOMMAND);
  DeleteMenu(SystemMenu, SC_SIZE, MF_BYCOMMAND);
  DeleteMenu(SystemMenu, SC_RESTORE, MF_BYCOMMAND);
  DeleteMenu(SystemMenu, SC_MOVE, MF_BYCOMMAND);

end;

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;

end.
{Slut på program}

og dfm-filen:
object Form1: TForm1
  Left = 208
  Top = 128
  HelpContext = 15000
  BorderIcons = [biSystemMenu]
  BorderStyle = bsSingle
  Caption = 'Form1'
  ClientHeight = 212
  ClientWidth = 352
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'Times New Roman'
  Font.Style = []
  Position = poDefault
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 15
  object icon100: TImage
    Left = 220
    Top = 124
    Width = 32
    Height = 32
    AutoSize = True
    Picture.Data = {
      055449636F6E0000010001002020100000000000E80200001600000028000000
      2000000040000000010004000000000080020000000000000000000000000000
      0000000000000000000080000080000000808000800000008000800080800000
      80808000C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000
      FFFFFF00999999999999999999999999999999999FFFFFFFFFFFFF8888888888
      8FFFFFF997FFFFFFFFFF888888888888888FFFF9977FFFFFFFF8444C44488888
      8888FFF99777FFFFFF4444444444488888888FF997777FFF44444C4C4C4C4C48
      888888F9977777F44444443444444444888888F99777774C444C433C4C4C4C4C
      48888889977774444444C334C444C444C48888899777744C4C4C433C4C4C4C4C
      4C8888899777444444C43334CCC4C4C4C44888899777444C4C43333C4C4C4C4C
      4C38888997744444C4433333CCCCC4CCC433888997744C4C4C4333333C4C4C4C
      4C33888997744444C43333333CCCCCCCC43388899774444C4C333333CC4CCC4C
      4C33888997744444C433333CCCCCCCC33333888997744C4C4C334C4C4CCCCCC3
      33338889977444444433CCCC3CCCCCC3333388F99777444C4C433C433C4CCC4C
      333888F997774444343333333CCCCCCCC4C88FF99777744C333333333C4C4C43
      3C88FFF997777444333333333CCCCCC3348FFFF99777774C333333333C4C3C43
      3FFFFFF997777774333333C333CC3433FFFFFFF9977777774333334C333C4C37
      7FFFFFF9977777777744433444C4477777FFFFF99777777777774C4C4C477777
      777FFFF99777777777777777777777777777FFF9977777777777777777777777
      77777FF9977777777777777777777777777777F9999999999999999999999999
      9999999900000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      00000000}
  end
  object icon101: TImage
    Left = 292
    Top = 124
    Width = 32
    Height = 32
    AutoSize = True
    Picture.Data = {
      055449636F6E0000010001002020100000000000E80200001600000028000000
      2000000040000000010004000000000080020000000000000000000000000000
      0000000000000000000080000080000000808000800000008000800080800000
      80808000C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000
      FFFFFF009999999999999999999999999999999994444F00F40F444444444444
      444444499C444F00F40F444444444444444444499CC44F0F0F0F444444440000
      004444499CCC4F0F0F0F444440008888880044499CCCCF04F00F444008888888
      888804499CCCCF00000F4008F8F8F8F8888804499CCCCF04F00F0F8F88888888
      800004499CCCCF0F0040F8F8F8F8F800078804499CCCCCF0040F8F888F880077
      787804499CCCCCCFC0F8F8F8F8F00787878044499CCCCCCC0F8F8F8F80070878
      788044499CCCCCC0F8F8F8F807770787880444499CCCCCC0FFFF8F8077780878
      780444499CCCCC08F8F8F80F77870787804444499CCCCC0FFF8F80F0F7780878
      044444499CCCC0F8F8F8078F0F870787044444499CCCC0FF8FF07777F0F80880
      444444499CCCC0F8F8F077878F0F0804444444499CCC0FFFFF07777878F00044
      444444499CCC0FF8F000000000000F4F444444499CCC0FFFF07778787880F0F0
      F44444499CCC0FF807878787870CCF00F44444499CCC0FFF0778787870CCF000
      F44444499CCC0FF8078787800CCCCFFF0F4444499CCC0FF07878780CCCCCCCCC
      FF4444499CCCC0F0777700CCCCCCCCCCCC4444499CCCC0F07700CCCCCCCCCCCC
      CCC444499CCCCC0000CCCCCCCCCCCCCCCCCC44499CCCCCCCCCCCCCCCCCCCCCCC
      CCCCC4499CCCCCCCCCCCCCCCCCCCCCCCCCCCCC49999999999999999999999999
      9999999900000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      00000000}
  end
  object Label1: TLabel
    Left = 208
    Top = 104
    Width = 45
    Height = 15
    Alignment = taCenter
    Caption = 'Ikon 100'
  end
  object Label2: TLabel
    Left = 280
    Top = 104
    Width = 45
    Height = 15
    Alignment = taCenter
    Caption = 'Ikon 101'
  end
  object button2: TBitBtn
    Left = 16
    Top = 176
    Width = 161
    Height = 25
    Caption = '&Gem billede'
    Default = True
    ModalResult = 1
    TabOrder = 0
    OnClick = button2Click
    Glyph.Data = {
      DE010000424DDE01000000000000760000002800000024000000120000000100
      0400000000006801000000000000000000001000000010000000000000000000
      80000080000000808000800000008000800080800000C0C0C000808080000000
      FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
      3333333333333333333333330000333333333333333333333333F33333333333
      00003333344333333333333333388F3333333333000033334224333333333333
      338338F3333333330000333422224333333333333833338F3333333300003342
      222224333333333383333338F3333333000034222A22224333333338F338F333
      8F33333300003222A3A2224333333338F3838F338F33333300003A2A333A2224
      33333338F83338F338F33333000033A33333A222433333338333338F338F3333
      0000333333333A222433333333333338F338F33300003333333333A222433333
      333333338F338F33000033333333333A222433333333333338F338F300003333
      33333333A222433333333333338F338F00003333333333333A22433333333333
      3338F38F000033333333333333A223333333333333338F830000333333333333
      333A333333333333333338330000333333333333333333333333333333333333
      0000}
    Layout = blGlyphRight
    NumGlyphs = 2
  end
  object Button1: TBitBtn
    Left = 184
    Top = 176
    Width = 161
    Height = 25
    Caption = '&Afbryd program'
    TabOrder = 1
    OnClick = Button1Click
    Glyph.Data = {
      76010000424D7601000000000000760000002800000020000000100000000100
      0400000000000001000000000000000000001000000010000000000000000000
      800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
      FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00330000000000
      03333377777777777F333301BBBBBBBB033333773F3333337F3333011BBBBBBB
      0333337F73F333337F33330111BBBBBB0333337F373F33337F333301110BBBBB
      0333337F337F33337F333301110BBBBB0333337F337F33337F333301110BBBBB
      0333337F337F33337F333301110BBBBB0333337F337F33337F333301110BBBBB
      0333337F337F33337F333301110BBBBB0333337F337FF3337F33330111B0BBBB
      0333337F337733337F333301110BBBBB0333337F337F33337F333301110BBBBB
      0333337F3F7F33337F333301E10BBBBB0333337F7F7F33337F333301EE0BBBBB
      0333337F777FFFFF7F3333000000000003333377777777777333}
    Layout = blGlyphRight
    NumGlyphs = 2
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 352
    Height = 41
    Align = alTop
    Caption = 'SysTray Eksempel'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -21
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    ParentFont = False
    TabOrder = 2
  end
  object CheckBox1: TCheckBox
    Left = 16
    Top = 64
    Width = 225
    Height = 17
    Caption = 'Start program når bruger logger på ?'
    TabOrder = 3
  end
  object button3: TBitBtn
    Left = 16
    Top = 128
    Width = 161
    Height = 25
    Caption = '&Skift Ikon'
    TabOrder = 4
    OnClick = Button3Click
    Glyph.Data = {
      F6000000424DF600000000000000760000002800000010000000100000000100
      0400000000008000000000000000000000001000000010000000000000000000
      800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
      FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00555555777555
      5555555555000757755555575500005007555570058880000075570870088078
      007555787887087777755550880FF0800007708080888F7088077088F0708F78
      88077000F0778080005555508F0008800755557878FF88777075570870080088
      0755557075888070755555575500075555555555557775555555}
    Layout = blGlyphRight
  end
  object pmnSysTrayEx: TPopupMenu
    Left = 6
    Top = 9
    object M01: TMenuItem
      Caption = 'Indstillinger'
      OnClick = M01Click
    end
    object M02: TMenuItem
      Caption = 'Afbryd'
      Default = True
      OnClick = M02Click
    end
  end
end

Som jeg også nævnte i det tidligere spørgsmål er alle velkomne til at få en kopi pr. mail. Bare skriv en mail-id og jeg sender fluks en kopi.

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.

canman: tak for dit svar men det var ikke lige det jeg bedte om. Jeg vil dog tage et kig på RX-lib på et senere tidspunkt.

sjensen: Kanon...  Jeg ser lige på det og prøver det med D5 og så hører du fra mig igen.

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

j,

kig i din indbox. Jeg har lige sendt dig en kopi af programmet.

Og J,

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.

sjensen:Det er et kanon smart lille program og det virkede bare under D5 med det samme.

Tak for det og som du kan se har jeg hævet point til det samme som andreas gav.

jeg takker og er meget overvældet 8-)

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.