![]() |
TEdit Transperenz?
Guten Tag liebe leute,
ich bin auf der suchen nach einer möglichkeit ein Tedit transperent zu machen das man es über ein bild legen kann und man das bild halt durchs edit sieht. Dabei bin ich auf die TZ9Edit komponente gestoßen die komponente funzt so wunderbar das problem ist aber wenn man was hinein schreibt frisst sich der speicher voll O.o das ist die komponente:
Delphi-Quellcode:
Ich hab nach einer kleinen fehler suche festgestellt das es an der procedure liegt:unit Z9Edit; interface uses Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Graphics; type TZ9Edit = class(TEdit) private { Private declarations } FAlignText: TAlignment; FTransparent: Boolean; FPainting: Boolean; procedure SetAlignText(Value: TAlignment); procedure SetTransparent(Value: Boolean); protected { Protected declarations } procedure RepaintWindow; procedure CreateParams(var Params: TCreateParams); override; procedure Change; override; procedure SetParent(AParent: TWinControl); override; procedure WMPaint(var Message: TWMPaint); message WM_PAINT; procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT; procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND; procedure CNCtlColorEdit(var Message: TWMCtlColorEdit); message CN_CTLCOLOREDIT; procedure CNCtlColorStatic(var Message: TWMCtlColorStatic); message CN_CTLCOLORSTATIC; procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED; procedure WMSize(var Message: TWMSize); message WM_SIZE; procedure WMMove(var Message: TWMMove); message WM_MOVE; procedure PaintParent(ACanvas: TCanvas); public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; published { Published declarations } property Align; property AlignText: TAlignment read FAlignText write SetAlignText default taLeftJustify; property Transparent: Boolean read FTransparent write SetTransparent default false; end; implementation { TZ9Edit } uses Forms; type TParentControl = class(TWinControl); const BorderRec: array[TBorderStyle] of Integer = (1, -1); constructor TZ9Edit.Create(AOwner: TComponent); begin inherited Create(AOwner); FAlignText := taLeftJustify; FTransparent := false; FPainting := false; end; destructor TZ9Edit.Destroy; begin inherited Destroy; end; procedure TZ9Edit.SetAlignText(Value: TAlignment); begin if FAlignText <> Value then begin FAlignText := Value; RecreateWnd; Invalidate; end; end; procedure TZ9Edit.SetTransparent(Value: Boolean); begin if FTransparent <> Value then begin FTransparent := Value; Invalidate; end; end; procedure TZ9Edit.WMEraseBkGnd(var Message: TWMEraseBkGnd); var DC: hDC; i: integer; p: TPoint; canvas : TCanvas; begin if FTransparent and not(csDesigning in componentstate) then begin canvas := TCanvas.create; try canvas.handle := message.dc; PaintParent(Canvas); finally canvas.free; end; end else begin canvas := TCanvas.create; try canvas.handle := message.dc; canvas.brush.color := Color; canvas.brush.style := bsSolid; canvas.fillrect(clientrect); finally canvas.free; end; end; end; procedure TZ9Edit.WMPaint(var Message: TWMPaint); begin inherited; if FTransparent then if not FPainting then RepaintWindow; end; procedure TZ9Edit.WMNCPaint(var Message: TMessage); begin inherited; end; procedure TZ9Edit.CNCtlColorEdit(var Message: TWMCtlColorEdit); begin inherited; if FTransparent then SetBkMode(Message.ChildDC, 1); end; procedure TZ9Edit.CNCtlColorStatic(var Message: TWMCtlColorStatic); begin inherited; if FTransparent then SetBkMode(Message.ChildDC, 1); end; procedure TZ9Edit.CMParentColorChanged(var Message: TMessage); begin inherited; if FTransparent then Invalidate; end; procedure TZ9Edit.WMSize(var Message: TWMSize); var r : TRect; begin inherited; r := ClientRect; InvalidateRect(handle,@r,false); end; procedure TZ9Edit.WMMove(var Message: TWMMove); var r : TRect; begin inherited; Invalidate; r := ClientRect; InvalidateRect(handle,@r,false); end; procedure TZ9Edit.RepaintWindow; var DC: hDC; TmpBitmap, Bitmap: hBitmap; begin if FTransparent then begin FPainting := true; HideCaret(Handle); DC := CreateCompatibleDC(GetDC(Handle)); TmpBitmap := CreateCompatibleBitmap(GetDC(Handle), Succ(ClientWidth), Succ(ClientHeight)); Bitmap := SelectObject(DC, TmpBitmap); PaintTo(DC, 0, 0); BitBlt(GetDC(Handle), BorderRec[BorderStyle] + BorderWidth, BorderRec[BorderStyle] + BorderWidth, ClientWidth, ClientHeight, DC, 1, 1, SRCCOPY); SelectObject(DC, Bitmap); DeleteDC(DC); ReleaseDC(Handle, GetDC(Handle)); DeleteObject(TmpBitmap); ShowCaret(Handle); FPainting := false; end; end; procedure TZ9Edit.CreateParams(var Params: TCreateParams); const Alignments: array [TAlignment] of DWord = (ES_LEFT, ES_RIGHT, ES_CENTER); begin inherited CreateParams(Params); Params.Style := Params.Style or ES_MULTILINE or Alignments[FAlignText]; end; procedure TZ9Edit.Change; begin RepaintWindow; inherited Change; end; procedure TZ9Edit.SetParent(AParent: TWinControl); begin inherited SetParent(AParent); end; procedure TZ9Edit.PaintParent(ACanvas: TCanvas); var I, Count, X, Y, SaveIndex: integer; DC: cardinal; R, SelfR, CtlR: TRect; Control : TControl; begin Control := Self; if Control.Parent = nil then Exit; Count := Control.Parent.ControlCount; DC := ACanvas.Handle; SelfR := Bounds(Control.Left, Control.Top, Control.Width, Control.Height); X := -Control.Left; Y := -Control.Top; // Copy parent control image SaveIndex := SaveDC(DC); SetViewportOrgEx(DC, X, Y, nil); IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight); TParentControl(Control.Parent).Perform(WM_ERASEBKGND,DC,0); TParentControl(Control.Parent).PaintWindow(DC); RestoreDC(DC, SaveIndex); //Copy images of graphic controls for I := 0 to Count - 1 do begin if (Control.Parent.Controls[I] <> nil) then begin if Control.Parent.Controls[I] = Control then break; with Control.Parent.Controls[I] do begin CtlR := Bounds(Left, Top, Width, Height); if Bool(IntersectRect(R, SelfR, CtlR)) and Visible then begin SaveIndex := SaveDC(DC); SetViewportOrgEx(DC, Left + X, Top + Y, nil); IntersectClipRect(DC, 0, 0, Width, Height); Perform(WM_ERASEBKGND,DC,0); Perform(WM_PAINT, integer(DC), 0); RestoreDC(DC, SaveIndex); end; end; end; end; end; end.
Delphi-Quellcode:
kommentiert man diese aus tritt kein speicher leak auf
procedure TZ9Edit.RepaintWindow;
var DC: hDC; TmpBitmap, Bitmap: hBitmap; begin if FTransparent then begin FPainting := true; HideCaret(Handle); DC := CreateCompatibleDC(GetDC(Handle)); TmpBitmap := CreateCompatibleBitmap(GetDC(Handle), Succ(ClientWidth), Succ(ClientHeight)); Bitmap := SelectObject(DC, TmpBitmap); PaintTo(DC, 0, 0); BitBlt(GetDC(Handle), BorderRec[BorderStyle] + BorderWidth, BorderRec[BorderStyle] + BorderWidth, ClientWidth, ClientHeight, DC, 1, 1, SRCCOPY); SelectObject(DC, Bitmap); DeleteDC(DC); ReleaseDC(Handle, GetDC(Handle)); DeleteObject(TmpBitmap); ShowCaret(Handle); FPainting := false; end; end; es ist kein leak in dem sinne das ein objekt nicht freigeben wird und das über delphi angezeigt wird man bemerkt es nur über den taskmanager mein delphi wissen ist noch nicht so weit das ich mit der obrigen procedure etwas anfangen kann dh ich weiß nicht was daran falsch ist. Ich hoffe ihr könnt mir helfen den bug zu beheben oder kennt jemand eine andere möglichkeit ? schonmal danke im vorraus MFG Sportkeks |
Re: TEdit Transperenz?
Ich glaube da fehlt noch in der RepaintWindow-Procedure ein :
Delphi-Quellcode:
So beim schnellen drübergucken.
//...
DeleteObject(TmpBitmap); DeleteObject(Bitmap); // <--<< ShowCaret(Handle); |
Re: TEdit Transperenz?
Liste der Anhänge anzeigen (Anzahl: 1)
Zitat:
ich hab mal ein kleines testprogramm gemacht: |
Re: TEdit Transperenz?
Hat den sonst keine eine idee wo der fehler liegen könnte ?
Das ist meine einzigste möglichkeit... :wall: |
Re: TEdit Transperenz?
Zitat:
|
Re: TEdit Transperenz?
naja ich hab das mal getestet ist nicht wirklich toll ist ziehmlich umständlich gemacht
![]() aber danke für den tipp, findet sich den keiner der den fehler im quelltext findet ? |
Re: TEdit Transperenz?
Der Fehler ist ganz simpel, hab ich nach 2 Minuten gehabt. ;-)
In der RepaintWindow wird GetDC aufgerufen, aber der erzeugte DC nirgends gespeichert. Im Gegenteil: In der Zeile, die zum Freigeben gedacht war, wird extra ein weiterer erzeugt und der dann freigegeben. :mrgreen: Dadurch kann der SPeicher auch nicht wieder freigegeben werden. Korrekt sieht das so aus:
Delphi-Quellcode:
procedure TZ9Edit.RepaintWindow;
var DC, MyDC: hDC; TmpBitmap, Bitmap: hBitmap; begin if FTransparent then begin MyDC := GetDC(Handle); FPainting := true; HideCaret(Handle); DC := CreateCompatibleDC(MyDC); TmpBitmap := CreateCompatibleBitmap(MyDC, Succ(ClientWidth), Succ(ClientHeight)); Bitmap := SelectObject(DC, TmpBitmap); PaintTo(DC, 0, 0); BitBlt(MyDC, BorderRec[BorderStyle] + BorderWidth, BorderRec[BorderStyle] + BorderWidth, ClientWidth, ClientHeight, DC, 1, 1, SRCCOPY); SelectObject(DC, Bitmap); DeleteDC(DC); ReleaseDC(Handle, MyDC); DeleteObject(TmpBitmap); ShowCaret(Handle); FPainting := false; end; end; |
Alle Zeitangaben in WEZ +1. Es ist jetzt 12:38 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz