AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

TEdit Transperenz?

Ein Thema von sportkeks · begonnen am 20. Feb 2010 · letzter Beitrag vom 20. Feb 2010
Antwort Antwort
sportkeks

Registriert seit: 29. Apr 2009
73 Beiträge
 
#1

TEdit Transperenz?

  Alt 20. Feb 2010, 14:24
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:

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.
Ich hab nach einer kleinen fehler suche festgestellt das es an der procedure liegt:

Delphi-Quellcode:
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;
kommentiert man diese aus tritt kein speicher leak auf
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
Now we're taking a break to eat some cake.
  Mit Zitat antworten Zitat
Benutzerbild von turboPASCAL
turboPASCAL

Registriert seit: 8. Mai 2005
Ort: Sondershausen
4.274 Beiträge
 
Delphi 6 Personal
 
#2

Re: TEdit Transperenz?

  Alt 20. Feb 2010, 14:33
Ich glaube da fehlt noch in der RepaintWindow-Procedure ein :
Delphi-Quellcode:
//...
    DeleteObject(TmpBitmap);
    DeleteObject(Bitmap); // <--<<
    ShowCaret(Handle);
So beim schnellen drübergucken.
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat
sportkeks

Registriert seit: 29. Apr 2009
73 Beiträge
 
#3

Re: TEdit Transperenz?

  Alt 20. Feb 2010, 14:47
Zitat von turboPASCAL:
Ich glaube da fehlt noch in der RepaintWindow-Procedure ein :
Delphi-Quellcode:
//...
    DeleteObject(TmpBitmap);
    DeleteObject(Bitmap); // <--<<
    ShowCaret(Handle);
So beim schnellen drübergucken.
Hmm ne das war es leider nicht immer noch dieser bug

ich hab mal ein kleines testprogramm gemacht:
Angehängte Dateien
Dateityp: zip komponenten_test_155.zip (289,7 KB, 17x aufgerufen)
Now we're taking a break to eat some cake.
  Mit Zitat antworten Zitat
sportkeks

Registriert seit: 29. Apr 2009
73 Beiträge
 
#4

Re: TEdit Transperenz?

  Alt 20. Feb 2010, 17:19
Hat den sonst keine eine idee wo der fehler liegen könnte ?
Das ist meine einzigste möglichkeit...
Now we're taking a break to eat some cake.
  Mit Zitat antworten Zitat
ryLIX

Registriert seit: 16. Nov 2008
Ort: Westoverledingen
264 Beiträge
 
RAD-Studio 2009 Pro
 
#5

Re: TEdit Transperenz?

  Alt 20. Feb 2010, 17:36
Zitat von sportkeks:
Hat den sonst keine eine idee wo der fehler liegen könnte ?
Das ist meine einzigste möglichkeit...
Versuch die LMD-Tool SE ist Freeware und Transparenz is auch da
Markus
Hamburflys, Scrubble-Fubble-Puff-Shake, Muffin-Purper-Gurk?
  Mit Zitat antworten Zitat
sportkeks

Registriert seit: 29. Apr 2009
73 Beiträge
 
#6

Re: TEdit Transperenz?

  Alt 20. Feb 2010, 19:31
naja ich hab das mal getestet ist nicht wirklich toll ist ziehmlich umständlich gemacht

http://wiki.lmd.de/index.php/LMD_VCL_-_Transparency

aber danke für den tipp, findet sich den keiner der den fehler im quelltext findet ?
Now we're taking a break to eat some cake.
  Mit Zitat antworten Zitat
Benutzerbild von jaenicke
jaenicke

Registriert seit: 10. Jun 2003
Ort: Berlin
9.288 Beiträge
 
Delphi 11 Alexandria
 
#7

Re: TEdit Transperenz?

  Alt 20. Feb 2010, 21:54
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.
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;
Sebastian Jänicke
Alle eigenen Projekte sind eingestellt, ebenso meine Homepage, Downloadlinks usw. im Forum bleiben aktiv!
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 21:42 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