transparenten Text auf Desktop

[hathor]

Vorschlag: Programm mit ParamStr und RunOnce:
Anmerkung: Batchfile-Beispiel:
osd.exe Das.wird.ein.Spass
(ParamStr ohne Leerzeichen oder mehrere ParamStrings zusammenführen)

Delphi-Quellcode:

program Osd;

uses
  Vcl.Forms,
  Winapi.Windows,
  Winapi.Messages,
  uOSD in 'uOSD.pas' {Form1};

{$R *.RES}

const
  UM_ACTIVATE = WM_USER + 1;
var
  HndMyWindow : cardinal;
begin
  HndMyWindow := FindWindow( Nil, PWIDECHAR('OSD-2014'));
  If HndMyWindow <> 0 Then
  Begin
    PostMessage( HndMyWindow,UM_ACTIVATE, 0, 0);
    ShowWindow(HndMyWindow, SW_Normal);
    UpdateWindow(HndMyWindow);
    SetForeGroundWindow(HndMyWindow);
    Exit;
  End;

  Application.Initialize;
  Application.Title := 'OSD-2014';
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
//--------------------------------------------
unit uOSD;   //20140902

interface

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

type
  TForm1 = class(TForm)
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure DrawTextOnDesktop(TextToDraw: string) ;
    procedure FormShow(Sender: TObject);

  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  HRgn: THandle;

implementation

{$R *.DFM}

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DeleteObject(HRgn);
end;

procedure TForm1.DrawTextOnDesktop(TextToDraw: string) ;
begin
    Color := clLime;
    DeleteObject(HRgn);

    Canvas.Font.Name  := 'Arial black';  // Comic Sans MS
    Canvas.Font.Size  := 50;//32;
    Canvas.Font.Style := [fsBold];

    self.width:=Canvas.TextWidth(TextToDraw)+60;
    self.height:=Canvas.TextHeight('▐');

    BeginPath(Canvas.Handle);
    SetBkMode( Canvas.Handle, TRANSPARENT );
    Canvas.TextOut(5, 0, ' '+ TextToDraw +' ');  //' Das ist ein Test ');

    Canvas.Rectangle(0,0,width,height);
    Canvas.Rectangle(5,5,width-5,height-5);

    EndPath(Canvas.Handle);
    HRgn := PathToRegion(Canvas.Handle);
    SetWindowRgn(Handle, HRgn, True);
    SetWindowPos(Handle,HWND_TOPMOST, 0, 0, 0, 0,SWP_NOMOVE + SWP_NOSIZE);
end;

procedure TForm1.FormCreate(Sender: TObject);
var MyText : String;
    j : Integer;
begin
  ShowMessage('Use RightClick to close the OSD.');
//  if ParamStr(1)<>'' then MyText:= ParamStr(1) else MyText:= 'HATHOR-2014';

  for j := 1 to ParamCount do
  MyText:= MyText + ' ' + ParamStr(j);

  If MyText='' then MyText:= 'HATHOR-2014';

  Application.ShowMainForm := TRUE;
  DrawTextOnDesktop(MyText);
end;


procedure TForm1.FormShow(Sender: TObject);
begin
//Caption:= 'OSD-1';
end;

end.