Change format of Tray Clock

Is it possible to change the format and maybe add text before or after the Clock in the Tray for Windows 9X & 2000 using API? I have seen applications that can do this but are looking for some delphi code examples. Thanx in advance!
skynergyAsked:
Who is Participating?
 
craig_capelConnect With a Mentor Commented:
I managed to get it to do this using a Button - if anyone can get it to do the same with a Label, i think that would be it?... try this code here (u need a button and a timer)

unit time;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  WindowList: TList;
  Mylabel: Tlabel;
  MyButton: Tbutton;

implementation

{$R *.dfm}

function GetWindow (Handle: HWND; LParam: longint): bool; stdcall;
begin
  Result := true;
  WindowList.Add (Pointer(Handle));
end;

Function GetHandle(PClass,ClassName: String): Hwnd;
var i: integer;
    wnd,Hnd: HWND;
    Buffer: array [0..255] of char;
begin
  ClassName:=LowerCase(ClassName);
  PClass:=LowerCase(Pclass);
  WindowList := TList.Create;
  Wnd:=Findwindow(Pchar(PClass),nil);
  EnumChildWindows (wnd,@GetWindow, 0);
    for i := 0 to WindowList.Count - 1 do
     begin
      Hnd := HWND (WindowList [i]);
      GetWindowText (Hnd, Buffer, SizeOf (Buffer) - 1);
      getclassname(hnd,buffer,sizeof(buffer));
      If ClassName=LowerCase(String(Buffer)) Then
           GetHandle:=Hnd;
     end;
End;

procedure TForm1.Button1Click(Sender: TObject);
Var
 wnd: Hwnd;
 T: Trect;
 S: String;
 cx,cy,x,y: Integer;
begin
  Wnd:=GetHandle('Shell_TrayWnd','TrayClockWClass');
  ShowWindow(Wnd,sw_show);
  GetWindowRect(Wnd,T);
  MyButton:=Tbutton.Create(Self);
  MyButton.ParentWindow:=Wnd;
{  MyLabel:=Tlabel.Create(self);
  MyLabel.InheritsFrom(Tbutton);
  MyLabel.ParentWindow:=Handle;
  MyLabel.Visible:=True;
  MyLabel.Caption:='Time?';}
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  MyLabel.Free;
  Mybutton.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   Mybutton.Caption:=TimeToStr(Now);
end;

end.

-

Craig C.
0
 
kretzschmarCommented:
you have to change the shorttimeformat systemwide for this,
is not recommended to do this
0
 
skynergyAuthor Commented:
Well basically I want to add some text with the clock. What would your solution be for this. Either I hide the default tray clock and add my own one to the system tray?
0
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
kretzschmarCommented:
hmm,
thats not so easy,
maybe impossible,
never tried this.

maybe some other
expert may have a suggestion

meikl ;-)
0
 
malsoftCommented:
What you need to do is subclass the clock's window and handle the painting etc. yourself. The program TClockEx does this ( http://users.iafrica.com/d/da/dalen/tclockex.htm ) and the helpfile contains a few pointers as to how to go about doing it yourself.

Mark
0
 
skynergyAuthor Commented:
Thanx for the tip, I actually had this application that's why I knew one could do it. Thanx for your tip for the help file. I will check it out. I didn't see that before.
0
 
ginsonicCommented:
listening
0
 
craig_capelCommented:
SkyEnergy - Try the source code i wrote, let me know if this is what you mean?
0
 
skynergyAuthor Commented:
Hi Craig

Thanx for the code. It works very well! We changed some of it for our application but we got what we were looking for thanx. Visit my website (http://www.skynergy.com) and you will see what I used it for. I will make the software posting either later today or early next week on my site.

Thanx
Magnus
0
 
craig_capelCommented:
Hey there  - i got bored so i had a look at the I-Time program and i liked it, so i decided to continue with the routine i wrote and modified it....

unit time;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  WindowList: TList;
  MyPanel: Tpanel;
  Beats: Integer;

implementation

{$R *.dfm}

function GetWindow (Handle: HWND; LParam: longint): bool; stdcall;
begin
  Result := true;
  WindowList.Add (Pointer(Handle));
end;

Function GetHandle(PClass,ClassName: String): Hwnd;
var i: integer;
    wnd,Hnd: HWND;
    Buffer: array [0..255] of char;
begin
  ClassName:=LowerCase(ClassName);
  PClass:=LowerCase(Pclass);
  WindowList := TList.Create;
  Wnd:=Findwindow(Pchar(PClass),nil);
  EnumChildWindows (wnd,@GetWindow, 0);
    for i := 0 to WindowList.Count - 1 do
     begin
      Hnd := HWND (WindowList [i]);
      GetWindowText (Hnd, Buffer, SizeOf (Buffer) - 1);
      getclassname(hnd,buffer,sizeof(buffer));
      If ClassName=LowerCase(String(Buffer)) Then
           GetHandle:=Hnd;
     end;
End;

Function ScrollText: String;
Var
 Tmp: String;
 Tmp_chr: Char;
 N,Len: Integer;
Begin
  tmp:=MyPanel.Caption;
  len:=length(tmp);
  tmp_chr:=tmp[1];
  for n:=1 to len-1 do
     begin
        tmp[n]:=tmp[n+1];
     end;
   tmp[len]:=tmp_chr;
 If Tmp[Len]='@' Then
   Tmp:=DateTimeToStr(Now)+' Swatch Beats: '+IntToStr(Beats)+'@'; //Beats made up :)
  //in order to update it, i thought checking to for the @ at the end would be a good way
  //to update the text in the window
 Result:=Tmp;
End;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  MyPanel.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
Var
 R: Integer;
 Str: String;
begin
 Str:=MyPanel.Caption;
 Str:=ScrollText;
 MyPanel.Caption:=Str;
 Inc(Beats);
end;

procedure TForm1.FormCreate(Sender: TObject);
Var
 wnd: Hwnd;
 T: Trect;
 S: String;
 cx,cy,x,y: Integer;
begin
  Wnd:=GetHandle('Shell_TrayWnd','TrayClockWClass');
  ShowWindow(Wnd,sw_show);
  GetWindowRect(Wnd,T);
  MyPanel:=TPanel.Create(Self);
  MyPanel.Caption:=DateTimeToStr(Now)+' Swatch Beats: '+IntToStr(Beats)+'@'; //Beats made up :)
  MyPanel.Height:=T.Bottom-T.Top;
  MyPanel.Width:=T.Right-T.Left;
  MyPanel.ParentWindow:=Wnd;
  MyPanel.BevelOuter:=BVnone;
  MyPanel.Font.Size:=8;
  MyPanel.Font.Color:=ClBlue;
  Timer1.Enabled:=True;
  Timer1.Interval:=300;
end;

end.

  Tell me what you think :)

- Thanks

Craig C.
0
 
craig_capelCommented:
Hey there  - i got bored so i had a look at the I-Time program and i liked it, so i decided to continue with the routine i wrote and modified it....

unit time;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  WindowList: TList;
  MyPanel: Tpanel;
  Beats: Integer;

implementation

{$R *.dfm}

function GetWindow (Handle: HWND; LParam: longint): bool; stdcall;
begin
  Result := true;
  WindowList.Add (Pointer(Handle));
end;

Function GetHandle(PClass,ClassName: String): Hwnd;
var i: integer;
    wnd,Hnd: HWND;
    Buffer: array [0..255] of char;
begin
  ClassName:=LowerCase(ClassName);
  PClass:=LowerCase(Pclass);
  WindowList := TList.Create;
  Wnd:=Findwindow(Pchar(PClass),nil);
  EnumChildWindows (wnd,@GetWindow, 0);
    for i := 0 to WindowList.Count - 1 do
     begin
      Hnd := HWND (WindowList [i]);
      GetWindowText (Hnd, Buffer, SizeOf (Buffer) - 1);
      getclassname(hnd,buffer,sizeof(buffer));
      If ClassName=LowerCase(String(Buffer)) Then
           GetHandle:=Hnd;
     end;
End;

Function ScrollText: String;
Var
 Tmp: String;
 Tmp_chr: Char;
 N,Len: Integer;
Begin
  tmp:=MyPanel.Caption;
  len:=length(tmp);
  tmp_chr:=tmp[1];
  for n:=1 to len-1 do
     begin
        tmp[n]:=tmp[n+1];
     end;
   tmp[len]:=tmp_chr;
 If Tmp[Len]='@' Then
   Tmp:=DateTimeToStr(Now)+' Swatch Beats: '+IntToStr(Beats)+'@'; //Beats made up :)
  //in order to update it, i thought checking to for the @ at the end would be a good way
  //to update the text in the window
 Result:=Tmp;
End;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  MyPanel.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
Var
 R: Integer;
 Str: String;
begin
 Str:=MyPanel.Caption;
 Str:=ScrollText;
 MyPanel.Caption:=Str;
 Inc(Beats);
end;

procedure TForm1.FormCreate(Sender: TObject);
Var
 wnd: Hwnd;
 T: Trect;
 S: String;
 cx,cy,x,y: Integer;
begin
  Wnd:=GetHandle('Shell_TrayWnd','TrayClockWClass');
  ShowWindow(Wnd,sw_show);
  GetWindowRect(Wnd,T);
  MyPanel:=TPanel.Create(Self);
  MyPanel.Caption:=DateTimeToStr(Now)+' Swatch Beats: '+IntToStr(Beats)+'@'; //Beats made up :)
  MyPanel.Height:=T.Bottom-T.Top;
  MyPanel.Width:=T.Right-T.Left;
  MyPanel.ParentWindow:=Wnd;
  MyPanel.BevelOuter:=BVnone;
  MyPanel.Font.Size:=8;
  MyPanel.Font.Color:=ClBlue;
  Timer1.Enabled:=True;
  Timer1.Interval:=300;
end;

end.

  Tell me what you think :)

- Thanks

Craig C.
0
 
craig_capelCommented:
Hey there  - i got bored so i had a look at the I-Time program and i liked it, so i decided to continue with the routine i wrote and modified it....

unit time;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  WindowList: TList;
  MyPanel: Tpanel;
  Beats: Integer;

implementation

{$R *.dfm}

function GetWindow (Handle: HWND; LParam: longint): bool; stdcall;
begin
  Result := true;
  WindowList.Add (Pointer(Handle));
end;

Function GetHandle(PClass,ClassName: String): Hwnd;
var i: integer;
    wnd,Hnd: HWND;
    Buffer: array [0..255] of char;
begin
  ClassName:=LowerCase(ClassName);
  PClass:=LowerCase(Pclass);
  WindowList := TList.Create;
  Wnd:=Findwindow(Pchar(PClass),nil);
  EnumChildWindows (wnd,@GetWindow, 0);
    for i := 0 to WindowList.Count - 1 do
     begin
      Hnd := HWND (WindowList [i]);
      GetWindowText (Hnd, Buffer, SizeOf (Buffer) - 1);
      getclassname(hnd,buffer,sizeof(buffer));
      If ClassName=LowerCase(String(Buffer)) Then
           GetHandle:=Hnd;
     end;
End;

Function ScrollText: String;
Var
 Tmp: String;
 Tmp_chr: Char;
 N,Len: Integer;
Begin
  tmp:=MyPanel.Caption;
  len:=length(tmp);
  tmp_chr:=tmp[1];
  for n:=1 to len-1 do
     begin
        tmp[n]:=tmp[n+1];
     end;
   tmp[len]:=tmp_chr;
 If Tmp[Len]='@' Then
   Tmp:=DateTimeToStr(Now)+' Swatch Beats: '+IntToStr(Beats)+'@'; //Beats made up :)
  //in order to update it, i thought checking to for the @ at the end would be a good way
  //to update the text in the window
 Result:=Tmp;
End;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  MyPanel.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
Var
 R: Integer;
 Str: String;
begin
 Str:=MyPanel.Caption;
 Str:=ScrollText;
 MyPanel.Caption:=Str;
 Inc(Beats);
end;

procedure TForm1.FormCreate(Sender: TObject);
Var
 wnd: Hwnd;
 T: Trect;
 S: String;
 cx,cy,x,y: Integer;
begin
  Wnd:=GetHandle('Shell_TrayWnd','TrayClockWClass');
  ShowWindow(Wnd,sw_show);
  GetWindowRect(Wnd,T);
  MyPanel:=TPanel.Create(Self);
  MyPanel.Caption:=DateTimeToStr(Now)+' Swatch Beats: '+IntToStr(Beats)+'@'; //Beats made up :)
  MyPanel.Height:=T.Bottom-T.Top;
  MyPanel.Width:=T.Right-T.Left;
  MyPanel.ParentWindow:=Wnd;
  MyPanel.BevelOuter:=BVnone;
  MyPanel.Font.Size:=8;
  MyPanel.Font.Color:=ClBlue;
  Timer1.Enabled:=True;
  Timer1.Interval:=300;
end;

end.

  Tell me what you think :)

- Thanks

Craig C.
0
 
craig_capelCommented:
Hey there  - i got bored so i had a look at the I-Time program and i liked it, so i decided to continue with the routine i wrote and modified it....

unit time;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  WindowList: TList;
  MyPanel: Tpanel;
  Beats: Integer;

implementation

{$R *.dfm}

function GetWindow (Handle: HWND; LParam: longint): bool; stdcall;
begin
  Result := true;
  WindowList.Add (Pointer(Handle));
end;

Function GetHandle(PClass,ClassName: String): Hwnd;
var i: integer;
    wnd,Hnd: HWND;
    Buffer: array [0..255] of char;
begin
  ClassName:=LowerCase(ClassName);
  PClass:=LowerCase(Pclass);
  WindowList := TList.Create;
  Wnd:=Findwindow(Pchar(PClass),nil);
  EnumChildWindows (wnd,@GetWindow, 0);
    for i := 0 to WindowList.Count - 1 do
     begin
      Hnd := HWND (WindowList [i]);
      GetWindowText (Hnd, Buffer, SizeOf (Buffer) - 1);
      getclassname(hnd,buffer,sizeof(buffer));
      If ClassName=LowerCase(String(Buffer)) Then
           GetHandle:=Hnd;
     end;
End;

Function ScrollText: String;
Var
 Tmp: String;
 Tmp_chr: Char;
 N,Len: Integer;
Begin
  tmp:=MyPanel.Caption;
  len:=length(tmp);
  tmp_chr:=tmp[1];
  for n:=1 to len-1 do
     begin
        tmp[n]:=tmp[n+1];
     end;
   tmp[len]:=tmp_chr;
 If Tmp[Len]='@' Then
   Tmp:=DateTimeToStr(Now)+' Swatch Beats: '+IntToStr(Beats)+'@'; //Beats made up :)
  //in order to update it, i thought checking to for the @ at the end would be a good way
  //to update the text in the window
 Result:=Tmp;
End;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  MyPanel.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
Var
 R: Integer;
 Str: String;
begin
 Str:=MyPanel.Caption;
 Str:=ScrollText;
 MyPanel.Caption:=Str;
 Inc(Beats);
end;

procedure TForm1.FormCreate(Sender: TObject);
Var
 wnd: Hwnd;
 T: Trect;
 S: String;
 cx,cy,x,y: Integer;
begin
  Wnd:=GetHandle('Shell_TrayWnd','TrayClockWClass');
  ShowWindow(Wnd,sw_show);
  GetWindowRect(Wnd,T);
  MyPanel:=TPanel.Create(Self);
  MyPanel.Caption:=DateTimeToStr(Now)+' Swatch Beats: '+IntToStr(Beats)+'@'; //Beats made up :)
  MyPanel.Height:=T.Bottom-T.Top;
  MyPanel.Width:=T.Right-T.Left;
  MyPanel.ParentWindow:=Wnd;
  MyPanel.BevelOuter:=BVnone;
  MyPanel.Font.Size:=8;
  MyPanel.Font.Color:=ClBlue;
  Timer1.Enabled:=True;
  Timer1.Interval:=300;
end;

end.

  Tell me what you think :)

- Thanks

Craig C.
0
 
skynergyAuthor Commented:
Hi Craig! Thanx for your extra effort. I showed the code to LAD and he wants to stick with the existing way. Again thanx for your input and helping me.

Regards
Magnus Kruger
0
 
Alien3Commented:
I need MFC source code for changing clock format and colors
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.