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.