COMPOSANT TDESKTOP
Bacterius
Messages postés
3792
Date d'inscription
samedi 22 décembre 2007
Statut
Membre
Dernière intervention
3 juin 2016
-
18 sept. 2008 à 21:34
blueperfect Messages postés 234 Date d'inscription mardi 13 novembre 2007 Statut Membre Dernière intervention 21 novembre 2013 - 20 sept. 2008 à 18:28
blueperfect Messages postés 234 Date d'inscription mardi 13 novembre 2007 Statut Membre Dernière intervention 21 novembre 2013 - 20 sept. 2008 à 18:28
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/47995-composant-tdesktop
https://codes-sources.commentcamarche.net/source/47995-composant-tdesktop
20 sept. 2008 à 18:28
19 sept. 2008 à 19:22
Pourquoi pas essayer de récupérer le Handle de Explorer.exe, et puis un EnumWindows pour récuperer le handle du canevas de fond d'écran ... Et on agit pareil qu'avec les handles de "DesktopWindow" ??
J'essayerai dès que possible.
Cordialement, Bacterius !
19 sept. 2008 à 19:07
Un live wallpaper !
19 sept. 2008 à 18:55
Cordialement, Bacterius !
19 sept. 2008 à 18:53
19 sept. 2008 à 18:52
Si tu as une idée pour considérer le Desktop comme un WallPaper, ce serait pas plus mal...
19 sept. 2008 à 17:10
Je cherche ...
Cordialement, Bacterius !
19 sept. 2008 à 17:05
tout d'abord merci pour vos commentaires.
@Cirec : oui maintenant que je m'en rends compte il est vrai que c'est un peu léger pour une source ... j'aurai pu au moins mettre un exemple ... quelle honte :'(
Tu pourras quand même me laisser mettre le singleton (et eventuellement la démo) avant de faire disparaître la source :} ?
Cordialement, Bacterius !
19 sept. 2008 à 15:07
j'ai réinstallé mon OS et pas encore lissé les polices d'écran ce qui m'a fait prendre une parenthèse "()" pour une accolade "{}" .. ceci et ce que JulioDelphi a dit a fait que j'ai pris ce code pour autre chose que du Delphi ... bouhouououuuu.
Désolé BluePerfect .. ton code a donc bien sa place ici ;)
19 sept. 2008 à 13:21
Voilà : et ???? ;P
améliorations : Voir commentaires de Cirec
bugs : En si peu de lignes, ça m'étonnerait quand même ;)
conseils : Fournit au moins un programme qui l'utilise ton composant.
optimisations : Pas la peine de perdre du temps dans ce cas précis.
remarques : Nécéssité d'un tel composant ???
Cordialement.
19 sept. 2008 à 13:11
on passe de TComponent a TCanvas, car inutile d'avoir TComponent.
{$DEFINE DESKTOPCANVAS_USEGDIPLUS} // active la GDI+
{$DEFINE DESKTOPCANVAS_ASSINGLETON} // active le mode Singleton
{$IFDEF DESKTOPCANVAS_USEGDIPLUS}
uses GdipApi, GdipClass;
{$ENDIF}
type
TDesktopCanvas = class(TCanvas)
private
fDesktopHandle: HWND;
fDesktopHDC : HDC;
{$IFDEF DESKTOPCANVAS_USEGDIPLUS}
fGPGraphics : TGPGraphics;
fGPPen : TGPPen;
fGPBrush : TGPSolidBrush;
{$ENDIF}
protected
procedure CreateHandle; override;
public
{$IFDEF DESKTOPCANVAS_USEGDIPLUS}
property GPGraphics : TGPGraphics read fGPGraphics;
property GPPen : TGPPen read fGPPen;
property GPSolidBrush: TGPSolidBrush read fGPBrush;
{$ENDIF}
property DesktopHandle: HWND read FDesktopHandle;
public
{$IFDEF DESKTOPCANVAS_USEGDIPLUS}
constructor Create(const Compositing: CompositingQuality = CompositingQualityDefault;
const Smooth : SmoothingMode = SmoothingModeAntiAlias); reintroduce;
{$ELSE}
constructor Create; reintroduce;
{$ENDIF}
destructor Destroy; override;
{$IFDEF DESKTOPCANVAS_ASSINGLETON}
class function NewInstance: TObject; override;
procedure FreeInstance; override;
{$ENDIF}
end;
TDesktop = class(TComponent)
private
fDesktopCanvas : TDesktopCanvas;
public
property DesktopCanvas : TDesktopCanvas read fDesktopCanvas;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
{$IFDEF DESKTOPCANVAS_ASSINGLETON}
var
__DesktopCanvasSingleInstance : TObject = nil;
{$ENDIF}
{$IFDEF DESKTOPCANVAS_USEGDIPLUS}
constructor TDesktopCanvas.Create(const Compositing: CompositingQuality = CompositingQualityDefault;
const Smooth : SmoothingMode = SmoothingModeAntiAlias);
begin
inherited Create;
fDesktopHandle := GetDesktopWindow;
fDesktopHDC := GetWindowDC(fDesktopHandle);
Handle := fDesktopHDC;
fGPGraphics := TGPGraphics.Create(Handle);
fGPGraphics.SetCompositingQuality(Compositing);
fGPGraphics.SetSmoothingMode(Smooth);
fGPPen := TGPPen.Create(aclBlack);
fGPBrush := TGPSolidBrush.Create(aclWhite);
end;
{$ELSE}
constructor TDesktopCanvas.Create;
begin
inherited Create;
fDesktopHandle := GetDesktopWindow;
fDesktopHDC := GetWindowDC(fDesktopHandle);
Handle := fDesktopHDC;
end;
{$ENDIF}
procedure TDesktopCanvas.CreateHandle;
begin
if Handle <> fDesktopHDC then
Handle := fDesktopHDC;
end;
destructor TDesktopCanvas.Destroy;
begin
{$IFDEF DESKTOPCANVAS_USEGDIPLUS}
fGPBrush.Free;
fGPPen.Free;
fGPGraphics.Free;
{$ENDIF}
ReleaseDC(fDesktopHandle, Handle);
inherited Destroy;
end;
{$IFDEF DESKTOPCANVAS_ASSINGLETON}
procedure TDesktopCanvas.FreeInstance;
begin
inherited FreeInstance;
__DesktopCanvasSingleInstance := Nil;
end;
class function TDesktopCanvas.NewInstance: TObject;
begin
if __DesktopCanvasSingleInstance = Nil then
begin
__DesktopCanvasSingleInstance := TDesktopCanvas(inherited NewInstance);
Result := __DesktopCanvasSingleInstance;
end
else
raise Exception.Create(ClassName + ' : This object is used at singleton.');
end;
{$ENDIF}
{ TDesktop }
constructor TDesktop.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fDesktopCanvas := TDesktopCanvas.Create;
end;
destructor TDesktop.Destroy;
begin
fDesktopCanvas.Free;
inherited Destroy;
end;
19 sept. 2008 à 11:38
Ceci dit, l'approche singleton n'et pas mauvaise non-plus, mais C du Windows, alors que ma fonction s'appuie sur la VCL...
DH
19 sept. 2008 à 09:09
19 sept. 2008 à 01:47
Pourtant mon code, c'est du Pascal....
18 sept. 2008 à 23:40
class function TAbstract.IsUniqueOfThisClass( _universe:TComponent;
_class:TClass
):Boolean;
var _each:Integer;
_stack:TComponent;
begin
Result := True;
if Assigned(_universe)
then begin
_stack := _universe;
while not( _stack.InheritsFrom(TForm)
or _stack.InheritsFrom(TDataModule)
)
and Assigned(_stack.Owner)
do _stack := _stack.Owner;
_each := 0;
while not(Result)
and (_each < _stack.ComponentCount)
do if _stack.Components[_each].InheritsFrom(_class)
then Result := False
else _each := _each + 1;
end;
end;
18 sept. 2008 à 21:34
Cordialement, Bacterius !