transparenten Text auf Desktop
hab das hier getestet.
http://www.entwickler-ecke.de/topic_..._107786,0.html http://delphi.about.com/cs/adptips20...ltip0104_5.htm Text wird gezeichnet allerdings nicht transparent: (Win 8.1)
Delphi-Quellcode:
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(100, 500, TextToDraw) ; finally ReleaseDC(Handle, ACanvas.Handle) ; ACanvas.Free; end; end; |
AW: transparenten Text auf Desktop
Eine Variante die auf jeden Fall geht (..unter Windows 7):
Delphi-Quellcode:
procedure DrawTextOnDesktop(TextToDraw: string) ;
var Handle: HWND; Dc: HDC; ACanvas: TCanvas; bmp: TBitmap; iSz: TSize; begin Handle := GetDesktopWindow; Dc := GetWindowDC(Handle) ; ACanvas := TCanvas.Create; bmp := TBitmap.Create; try ACanvas.Handle := DC; bmp.Canvas.Font.Color := clRed; bmp.Canvas.Font.Name := 'Tahoma'; bmp.Canvas.Font.Size := 30; bmp.Canvas.Brush.Style := bsClear; iSz := bmp.Canvas.TextExtent(TextToDraw); bmp.SetSize(iSz.cx, iSz.cy); bmp.Canvas.CopyRect(Rect(0,0, iSz.cx, iSz.cy), ACanvas, Rect(10,10,10+iSz.cx, 10+iSz.cy) ); bmp.Canvas.TextOut(0, 0, TextToDraw) ; ACanvas.Draw(10,10, bmp); finally bmp.Free; ReleaseDC(Handle, ACanvas.Handle) ; ACanvas.Free; end; end; |
AW: transparenten Text auf Desktop
Und unter 8.1 ebenso :)
|
AW: transparenten Text auf Desktop
ok, erst kopieren, dann schreiben.
danke. |
AW: transparenten Text auf Desktop
Kleiner Verbesserungsvorschlag:
Delphi-Quellcode:
procedure DrawTextOnDesktop(TextToDraw: string) ;
var Handle: HWnd; Dc: HDC; ACanvas: TCanvas; bmp: TBitmap; iSz: TSize; begin bmp := nil; Handle := GetDesktopWindow; Dc := GetWindowDC(Handle); if Dc <> 0 then try ACanvas := TCanvas.Create; ACanvas.Handle := DC; bmp := TBitmap.Create; bmp.Canvas.Font.Color := clRed; bmp.Canvas.Font.Name := 'Tahoma'; bmp.Canvas.Font.Size := 30; bmp.Canvas.Brush.Style := bsClear; iSz := bmp.Canvas.TextExtent(TextToDraw); bmp.SetSize(iSz.cx, iSz.cy); bmp.Canvas.CopyRect(Rect(0,0, iSz.cx, iSz.cy), ACanvas, Rect(10,10,10+iSz.cx, 10+iSz.cy) ); bmp.Canvas.TextOut(0, 0, TextToDraw) ; ACanvas.Draw(10,10, bmp); finally bmp.Free; ReleaseDC(Handle, Dc) ; ACanvas.Free; end; end; |
AW: transparenten Text auf Desktop
Liste der Anhänge anzeigen (Anzahl: 1)
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. |
AW: transparenten Text auf Desktop
Danke hathor,
das ist genau das Richtige man muss in ein eigenes Fenster zeichnen. |
AW: transparenten Text auf Desktop
nur leider werden kleine Schriften unscharf :(
|
AW: transparenten Text auf Desktop
Du kannst es ja mal so versuchen, wenn Du noch glattere Schriften brauchst kannst Du statt per Canvasroutinen per hier im Formum unbeliebten GDI+ Routinen den Text auf das Bitmap aufbringen.
Delphi-Quellcode:
type
TForm5 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private-Deklarationen } public { Public-Deklarationen } end; var Form5: TForm5; implementation {$R *.dfm} var Bitmap: TBitmap; procedure TForm5.FormCreate(Sender: TObject); var BlendFunction: TBlendFunction; BitmapPos: TPoint; BitmapSize: TSize; exStyle: DWORD; begin BorderStyle := bsNone; Left := 0; Top := 0; Width := Screen.Width; Height := Screen.Height; // Enable window layering exStyle := GetWindowLongA(Handle, GWL_EXSTYLE); if (exStyle and WS_EX_LAYERED = 0) then SetWindowLong(Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED); Bitmap := TBitmap.Create; Bitmap.Canvas.Brush.Color := clBlack; Bitmap.Width := Width; Bitmap.Height := height; Bitmap.Canvas.Font.Color := clWhite; Bitmap.Canvas.Font.Size := 10; Bitmap.Canvas.TextOut(10,10,'Hallo die ist ein Test'); BitmapPos := Point(0, 0); BitmapSize.cx := Bitmap.Width; BitmapSize.cy := Bitmap.Height; BlendFunction.BlendOp := AC_SRC_OVER; BlendFunction.BlendFlags := 0; BlendFunction.SourceConstantAlpha := 255; BlendFunction.AlphaFormat := AC_SRC_ALPHA; // ... and action! UpdateLayeredWindow(Handle, 0, nil, @BitmapSize, Bitmap.Canvas.Handle, @BitmapPos, 0, @BlendFunction, ULW_ALPHA); end; procedure TForm5.FormDestroy(Sender: TObject); begin Bitmap.Free; end; |
AW: transparenten Text auf Desktop
Zitat:
Delphi-Quellcode:
...
Canvas.Font.Name := 'Tahoma'; // Comic Sans MS Canvas.Font.Size := 20; //kleiner macht wenig Sinn... // Canvas.Font.Style := [fsBold]; //ersatzlos entfernen self.width:=Canvas.TextWidth(TextToDraw)+60; self.height:= 2*Canvas.Font.Size; //Canvas.TextHeight('X'); ... |
Alle Zeitangaben in WEZ +1. Es ist jetzt 09:27 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz