Solved

Change format of Tray Clock

Posted on 2002-03-07
15
543 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
ID: 6846706
you have to change the shorttimeformat systemwide for this,
is not recommended to do this
0
 

Author Comment

by:skynergy
ID: 6846717
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
ID: 6846843
hmm,
thats not so easy,
maybe impossible,
never tried this.

maybe some other
expert may have a suggestion

meikl ;-)
0
Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

 
LVL 2

Accepted Solution

by:
craig_capel earned 200 total points
ID: 6847226
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
ID: 6847655
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
ID: 6849670
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
ID: 6849717
listening
0
 
LVL 2

Expert Comment

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

Author Comment

by:skynergy
ID: 6850161
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
ID: 6852543
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
ID: 6852549
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
ID: 6852562
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
ID: 6852577
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
ID: 6856418
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
ID: 12508427
I need MFC source code for changing clock format and colors
0

Featured Post

Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
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…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This video shows how to use Hyena, from SystemTools Software, to bulk import 100 user accounts from an external text file. View in 1080p for best video quality.

776 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