Solved

Change format of Tray Clock

Posted on 2002-03-07
15
541 Views
Last Modified: 2010-04-04
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!
0
Comment
Question by:skynergy
  • 6
  • 4
  • 2
  • +3
15 Comments
 
LVL 27

Expert Comment

by:kretzschmar
Comment Utility
you have to change the shorttimeformat systemwide for this,
is not recommended to do this
0
 

Author Comment

by:skynergy
Comment Utility
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
 
LVL 27

Expert Comment

by:kretzschmar
Comment Utility
hmm,
thats not so easy,
maybe impossible,
never tried this.

maybe some other
expert may have a suggestion

meikl ;-)
0
 
LVL 2

Accepted Solution

by:
craig_capel earned 200 total points
Comment Utility
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
 
LVL 1

Expert Comment

by:malsoft
Comment Utility
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
 

Author Comment

by:skynergy
Comment Utility
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
 
LVL 9

Expert Comment

by:ginsonic
Comment Utility
listening
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 2

Expert Comment

by:craig_capel
Comment Utility
SkyEnergy - Try the source code i wrote, let me know if this is what you mean?
0
 

Author Comment

by:skynergy
Comment Utility
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
 
LVL 2

Expert Comment

by:craig_capel
Comment Utility
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
 
LVL 2

Expert Comment

by:craig_capel
Comment Utility
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
 
LVL 2

Expert Comment

by:craig_capel
Comment Utility
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
 
LVL 2

Expert Comment

by:craig_capel
Comment Utility
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
 

Author Comment

by:skynergy
Comment Utility
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
 
LVL 1

Expert Comment

by:Alien3
Comment Utility
I need MFC source code for changing clock format and colors
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…
This demo shows you how to set up the containerized NetScaler CPX with NetScaler Management and Analytics System in a non-routable Mesos/Marathon environment for use with Micro-Services applications.

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now