Link to home
Start Free TrialLog in
Avatar of skynergy
skynergy

asked on

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!
Avatar of kretzschmar
kretzschmar
Flag of Germany image

you have to change the shorttimeformat systemwide for this,
is not recommended to do this
Avatar of skynergy
skynergy

ASKER

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?
hmm,
thats not so easy,
maybe impossible,
never tried this.

maybe some other
expert may have a suggestion

meikl ;-)
ASKER CERTIFIED SOLUTION
Avatar of craig_capel
craig_capel

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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
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.
listening
SkyEnergy - Try the source code i wrote, let me know if this is what you mean?
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
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.
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.
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.
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.
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
I need MFC source code for changing clock format and colors