Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Change format of Tray Clock

Posted on 2002-03-07
15
Medium Priority
?
557 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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
LVL 2

Accepted Solution

by:
craig_capel earned 800 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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Exchange organizations may use the Journaling Agent of the Transport Service to archive messages going through Exchange. However, if the Transport Service is integrated with some email content management application (such as an anti-spam), the admin…
In a question here at Experts Exchange (https://www.experts-exchange.com/questions/29062564/Adobe-acrobat-reader-DC.html), a member asked how to create a signature in Adobe Acrobat Reader DC (the free Reader product, not the paid, full Acrobat produ…
Suggested Courses

971 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