?
Solved

rest desktop canvass

Posted on 2005-04-08
3
Medium Priority
?
174 Views
Last Modified: 2010-04-05
I am using the code below to print the current time on the desktop.
However the time gets overprinted each second.
I need to wipe the old time from the desktop before i print the new time.
How can this be achieved.

procedure DrawTextOnDesktop(TextToDraw: string) ;
var
   Handle: HWND;
   Dc: HDC;
   ACanvas: TCanvas;
begin
   Handle := GetDesktopWindow;
   Dc := GetWindowDC(Handle) ;
   ACanvas := TCanvas.Create;
   try
     ACanvas.Handle := DC;
     BeginPath(ACanvas.Handle) ;
     ACanvas.Font.Color := clRed;
     ACanvas.Font.Name := 'Tahoma';
     ACanvas.Font.Size := 30;
     SetBkMode(ACanvas.Handle, TRANSPARENT) ;
     EndPath(ACanvas.Handle) ;
     ACanvas.TextOut(0, 0, TextToDraw) ;
   finally
     ReleaseDC(Handle, ACanvas.Handle) ;
     ACanvas.Free;
   end;
end;



TIMER 1

begin
DrawTextOnDesktop(TheCUrrentTime);
end;
0
Comment
Question by:delphinewbie
3 Comments
 
LVL 3

Accepted Solution

by:
Octabun earned 200 total points
ID: 13744049
IMHO, it is a very bad idea to write on the desktop. Just try to move some application behing your current time to see what I mean. Windows has the notion of a window to handle such tasks.

With Delphi 2005, you may create a transparent form and show it instead of writing on the desktop. It will get minimized with the main form (that is, disappear) and stop receive timer messages on modal dialogs, however, but it is a 100% Delphi solution.

Alternatively, on Win2000 or better, you may create a native window as

=== project 1. dpr ===

program Project1;

uses
  Windows,
  Messages,
  Graphics,
  SysUtils,
  Forms,
  WriteToCanvas in 'WriteToCanvas.pas' {Form1};

{$R *.res}

var
  wcex: WNDCLASSEX;
  cst: CREATESTRUCT;
  ovWin: HWnd;

function OverWndProc(HWindow: HWnd; Msg, WParam,
  LParam: Longint): Longint; stdcall;
var
   Dc: HDC;
   ACanvas: TCanvas;
   ps: PAINTSTRUCT;
begin
  case Msg of
    WM_PAINT:
       begin
         BeginPaint(HWindow, ps);
         try
           Dc := GetWindowDC(HWindow) ;
           ACanvas := TCanvas.Create;
           try
             ACanvas.Handle := DC;
             ACanvas.Font.Color := clRed;
             ACanvas.Font.Name := 'Tahoma';
             ACanvas.Font.Size := 20;
             ACanvas.Brush.Color := 1;
             ACanvas.TextOut(0, 0, FormatDateTime('hh:mm:ss', now)) ;
             result := 0;
           finally
             ReleaseDC(HWindow, ACanvas.Handle) ;
             ACanvas.Free;
           end;
         finally
           EndPaint(HWindow, ps);
         end;
         result := 0;
      end;
  else
    result := DefWindowProc(HWindow, Msg, WParam, LParam);
  end;
end;

begin
  wcex.cbSize := sizeof(wcex);
  wcex.style := CS_OWNDC;
  wcex.lpfnWndProc := @OverWndproc;
  wcex.cbClsExtra := 0;
  wcex.cbWndExtra := 0;
  wcex.hInstance := HInstance;
  wcex.hIcon := 0;
  wcex.hCursor := 0;
  wcex.hbrBackground := CreateSolidBrush(1);
  wcex.lpszMenuName := nil;
  wcex.lpszClassName := PChar('OverWindowClass');
  wcex.hIconSm := 0;

  RegisterClassEx(wcex);
  ovWin := CreateWindowEx(WS_EX_TOPMOST or WS_EX_TOOLWINDOW or WS_EX_LAYERED {or WS_EX_TRANSPARENT},
    PChar('OverWindowClass'), PChar('test'),
    WS_VISIBLE or WS_POPUP, 50, 50, 200, 100, 0, 0, HInstance, nil);
  SetLayeredWindowAttributes(ovWin, 1, 255, LWA_COLORKEY);

  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Form1.wh := ovWin;
  Application.Run;
end.

=== WriteToCanvas.pas ===

unit WriteToCanvas;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  public
    wh: HWnd;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  RedrawWindow(wh, nil, 0, RDW_INVALIDATE);
end;

end.

=== WriteTocanvas.dpr ===

object Form1: TForm1
  Left = 487
  Top = 214
  Width = 223
  Height = 129
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Timer1: TTimer
    OnTimer = Timer1Timer
    Left = 45
    Top = 23
  end
end

=== the end ===
0
 
LVL 11

Expert Comment

by:ZhaawZ
ID: 13744504
On W2k and newer you may use transparent windows.

procedure TForm1.FormCreate(Sender: TObject);
begin
BorderStyle := bsNone;
color := $ffff00;
SetWindowLong(handle, gwl_exstyle, GetWindowLong(handle, gwl_exstyle) or ws_ex_layered);
SetLayeredWindowAttributes(handle, $ffff00, 0, lwa_colorkey);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Label1.Caption := TimeToStr(now);
end;
0
 
LVL 1

Author Comment

by:delphinewbie
ID: 13745956
"IMHO, it is a very bad idea to write on the desktop. Just try to move some application behing your current time to see what I mean. Windows has the notion of a window to handle such tasks."

I see what you mean.
I will stay with the transparent window option.
Supplied code is untested as I already have that transparent functionality in the application.

Cheers

Brad
0

Featured Post

Industry Leaders: 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…
This Micro Tutorial will teach you how to add a cinematic look to any film or video out there. There are very few simple steps that you will follow to do so. This will be demonstrated using Adobe Premiere Pro CS6.
Despite its rising prevalence in the business world, "the cloud" is still misunderstood. Some companies still believe common misconceptions about lack of security in cloud solutions and many misuses of cloud storage options still occur every day. …
Suggested Courses
Course of the Month13 days, 12 hours left to enroll

755 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