Thema: Delphi Auf Desktop zeichnen

Einzelnen Beitrag anzeigen

Benutzerbild von turboPASCAL
turboPASCAL

Registriert seit: 8. Mai 2005
Ort: Sondershausen
4.274 Beiträge
 
Delphi 6 Personal
 
#14

AW: Auf Desktop zeichnen

  Alt 28. Jun 2010, 16:32
Delphi-Quellcode:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private-Deklarationen }
    Timetimer: TTimer;
    procedure OnTimeTimer(Sender: TObject);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.ExStyle := WS_EX_TRANSPARENT or WS_EX_LAYERED or WS_EX_NOACTIVATE;
  Params.Style := WS_POPUP or WS_CLIPCHILDREN;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // the Form Style
  Self.BorderStyle := bsNone;
  Self.Color := clFuchsia;

  Self.AlphaBlend := True;
  Self.AlphaBlendValue := 220;

  Self.TransparentColor := True;
  Self.TransparentColorValue := clFuchsia;

  Self.Left := 0;
  Self.Top := 0;
  Self.Width := Screen.Monitors[0].Width;
  Self.Height := Screen.Monitors[0].Height;

  // set Form as Parent of Desktop
  Windows.SetParent(Self.Handle, Windows.GetDesktopWindow);

  // Setup the Canvas
  Self.Canvas.Font.Name := 'arial';
  Self.Canvas.Font.Style := [fsBold];
  Self.Canvas.Font.Size := 64;
  Self.Canvas.Font.Color := clWhite;

  // set the Z-Order
  Windows.SetWindowPos(Self.Handle, HWND_BOTTOM, 0,0,0,0,
    SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);

  // Timer setup
  Timetimer := TTimer.Create(Self);
  try
    Timetimer.Interval := 500;
    Timetimer.OnTimer := OnTimeTimer;
  except
    raise; // do to...
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(Timetimer) then
    Timetimer.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  s: string;
begin
  Self.Canvas.Brush.Color := clWhite;

  s := SysUtils.TimeToStr(now);

  Windows.BeginPath(Self.Canvas.Handle);

  Self.Canvas.Brush.Style := bsClear;

  Self.Canvas.TextOut((Self.ClientWidth div 2) - (Self.Canvas.TextWidth(s) div 2),
    (Self.ClientHeight div 2) - (Self.Canvas.TextHeight(s) div 2),
    SysUtils.TimeToStr(now));


  Windows.EndPath(Self.Canvas.Handle);
  Self.Canvas.Brush.Style := bsSolid;
  Windows.FillPath(Self.Canvas.Handle);
end;

procedure TForm1.OnTimeTimer(Sender: TObject);
begin
  Self.invalidate;
end;

end.
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat