Entwickler-Ecke :: Thema anzeigen - TransparentColor und Win XP

Stread - Di 20.12.11 00:40
Titel: TransparentColor und Win XP

Hi,
in meinem Programm (Screenshot) benötige ich ein Formular welches den ganzen Bildschirm bedeckt durchsichtig aber anklickbar ist.
Beim MouseDown Ereignis der Form wird ein Timer gestartet der mir mit Canvas ein blaues Rechteck zeichnet wo gerade mein Mauscursor ist.

Der (Teil) Code hat bisher unter Windows 7 funktioniert * Allerdings funktioniert er nicht unter Windows XP

Zum Test habe ich ein Shape das per Button transparent wird. Im MouseUp Event wird einfach ein Label verändert.
Unter Win 7 ist das Shape transparent und man kann es sowohl im normalen wie auch im transparenten Modus anklicken, Label verändert sich.
Unter XP wird das Shape auch transparent aber man kann es dann nicht mehr anklicken, man klickt quasi "durch" also auf das dahinterliegende Fenster.
Nur zur Erwähnung: Mit der ganzen Form verhält es sich wie mit dem Shape.

Ich muss aber irgendwie an das MouseUP und Down Ereignis der Form kommen.
AlphaBlend ist nutzlos, da man das blaue Auswahlrechteck (das man wie bei Windows mit der Maus so aufziehen kann) noch gut erkennen muss.

Laut Hilfe wird die Transparenz Funktion doch ab Win 200 unterstützt?

*

Delphi-Quelltext

1:
2:
3:
4:
5:
6:

   self.WindowState:=wsMaximized;
   self.BorderStyle:=bsNone;
   self.FormStyle:=fsStayOnTop;
   self.TransparentColor := true ;
   self.Color := clOlive ;
   self.TransparentColorValue := clOlive ;

bummi - Di 20.12.11 13:56

das Geheimnis steckt hier, WS_EX_Layered, UpdateLayeredWindow und aus einem Bitmap malen, für die Alphafuktionalität benötigst Du eine eine GDI - Api, GDI+ von http://www.progdigy.com/ ist frei, habe ich hier verwendet, steht im uses.
Der Rest sind nur noch Mouseroutinen ....

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:

uses GDIPAPI,GDIPOBJ;

procedure TForm2.FormPaint(Sender: TObject);
const
   C_Alpha=1;
var
   DestPoint, srcPoint:TPoint;
   winSize:TSize;
   DC         : HDC;
   blendfunc  : BLENDFUNCTION;
   Owner : HWnd;
   curWinStyle:Integer;
   exStyle:Dword;
   BackImage:TBitMap;
   Graphics :  TGPGraphics;
   Brush:TGPSolidBrush;
   Pen:TGPPen;
   xx,yy:Integer;
begin

  DC := GetDC(0);
  BackImage:=TBitMap.Create;
  BackImage.PixelFormat := pf32Bit;
  BackImage.Width := Width;
  BackImage.Height := Height;
  BackImage.Canvas.Brush.Color := clBlack;
  BackImage.Canvas.FillRect(Rect(0,0,Width,Height));

  Graphics :=  TGPGraphics.Create(BackImage.Canvas.Handle);
  Brush:=TGPSolidBrush.Create(ColorToTGPColor(clblack,1));
  Graphics.FillRectangle(Brush,0,0,Width,Height);
  pen:=TGPPen.Create(ColorToTGPColor(clred,200));
  pen.SetWidth(2);
  Graphics.DrawRectangle(pen,0,0,Width-1,Height-1);
  pen.SetWidth(1);
  if FDown then
    begin
    Pen.SetColor(ColorToTGPColor(clblue,255));
    if FStartX > FendX then xx := FendX else xx := FStartX;
    if FStartY > FendY then yy := FendY else yy := FStartY;
    Graphics.DrawRectangle(pen,xx,yy,Abs(FStartX - FendX),Abs(FStartY - FEndY));
    end;
   try
   winSize.cx := width;
   winSize.cy := Height;
   srcPoint.x := 0;
   srcPoint.y := 0;

   DestPoint := BoundsRect.TopLeft;
   exStyle := GetWindowLongA(handle, GWL_EXSTYLE);
   if (exStyle and WS_EX_LAYERED = 0) then SetWindowLong(handle, GWL_EXSTYLE, (exStyle or WS_EX_LAYERED) );

   With blendFunc do
   begin
     AlphaFormat := 1;
     BlendFlags := 0;
     BlendOp := AC_SRC_OVER;
     SourceConstantAlpha := 255 - C_Alpha;
   end;

   UpdateLayeredWindow(Handle, DC, @DestPoint, @winSize, BackImage.Canvas.Handle,  @srcPoint,clBlack, @blendFunc, 2);

   finally
   ReleaseDC(0, DC);
   BackImage.Free;
   Graphics.Free;
   Brush.Free;
   pen.Free;
   end;

end;

Stread - Mi 21.12.11 02:50

Ich muss die Dateien im GDI+ pas Ordner nur in meinen Programm-Ordner verschieben wo meine .pas ist und wie von dir geschrieben die Sachen in die Uses eintragen?

Alle TGP Sachen (Bsp. Linie 15-17) sind Undeklarierte Bezeichner, aber komischer ist beim Kompilieren stopp er hier:

Quelltext

1:	[DCC Fehler] DirectDraw.pas(836): E2154 Typ 'IDirectDrawSurface' benötigt Finalization - nicht im varianten Record erlaubt

Es stimmt also was in der DirectDraw.pas nicht?

bummi - Mi 21.12.11 12:28

Kann er die Uses nicht auflösen?
gegf. Suchpfad anpassen, oder die Units mal in den Projektordner packen, STRG und auf den Unitnamen klicken sollte die Unit öffnen.
ich habe vergessen eine Funktion beizulegen

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:

 Function ColorToTGPColor (c : Tcolor; trans : Byte = 255):TGPColor;
Type
 TBarry=Array[0..3] of Byte;
Var
 Barry:TBarry;
 R:Byte;
begin
  move(C,Barry,4);
  R:=Barry[2];
  Barry[2]:=Barry[0];
  Barry[0]:=R;
  Barry[3]:=trans;
  move(Barry,Result,4);
end;

Stread - Sa 14.01.12 13:36

Ich drücke auf der Main-Form auf einen Button, daraufhin ruft er diese GDI-Form auf und zeichnet bei gedrückter Linken Maustaste das blaue Quadrat und die Form wird dann wieder geschlossen.

Wenn ich nun das nächste mal auf den Button drücke, sehe ich noch das blaue Quadrat vom letzten mal. Erst wenn ich ein neues aufziehe verschwindet es. (Logisch, da ich ja ein neues zeichen)

Wie kann ich es denn nun erreichen, dass das blaue Quadrat am Anfang nie sichtbar ist?

FDown:=False setzen bewirkt nur, dass man erneuten Zeichnen kein blaues Quadrat kommt, das alte bleibt bestehen.
Muss man das Graphics irgendwie Nil setzen?

Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2026 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!