DoubleBuffered Sorunu

[anonymousdelphicoder]

Saygı değer forum üyeleri sorunum çok gıcık bir sorun ne yaptıysam çözemedim
aşağıdaki bileşen kodu tek sorun hariç sorunsuz bir transparent panel fakat parentini doublebuffered := true yaptığım zaman doğru çalışmıyor sim siyah oluyor doublebuffered olduğunda arka planı alamıyorum. Bu sorunu çözecek hocalarımdan rica ediyorum düzeltebilir lermi ?

veya önemli bir çözüm yolu ise doublebuffered kullanmadan twincontrol (tpanel) içindekileri flickeri engelleyecek sekilde nasıl çizdirebiliriz. bu daha olurlu geldi ama işin kod kısmı malesef bende yok....

Kod: Tümünü seç

unit TransparentPanel;

interface

uses
  windows, graphics, classes, ExtCtrls, messages;

type
  TTransparentPanel = class(TPanel)
  protected
    procedure Paint; override;
  private
    fAlphaVal : Byte;
    fBmpParent: TBitmap;
    fBmpOwn : TBitmap;
    procedure FSetAlphaVal(AValue: Byte);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AlphaBlendValue: Byte read fAlphaVal write FSetAlphaVal default 255;
  end;

procedure Register;

implementation

procedure Register;
begin
     RegisterComponents('Standard', [TTransparentPanel]);
end;

constructor TTransparentPanel.Create(AOwner: TComponent);
begin
  fAlphaVal := 255;
  fBmpParent := TBitmap.Create;
  fBmpOwn := TBitmap.Create;
  inherited Create(AOwner);
end;

destructor TTransparentPanel.Destroy;
begin
  inherited Destroy;
  fBmpOwn.Free;
  fBmpParent.Free;
end;

procedure TTransparentPanel.FSetAlphaVal(AValue: Byte);
begin
  if (AValue <> fAlphaVal) then
  begin
    fAlphaVal := AValue;
    Invalidate;
  end;
end;

procedure TTransparentPanel.Paint;
var LOldCanvas: TCanvas;
    LBlendFunc: TBlendFunction;
begin
  if (fAlphaVal < 255) and HandleAllocated and Assigned(Parent) then
  begin
    fBmpOwn.Width := Width;
    fBmpOwn.Height := Height;
    LOldCanvas := Canvas;
    PPointer(@Canvas)^ := fBmpOwn.Canvas;
    inherited Paint;
    PPointer(@Canvas)^ := LOldCanvas;

    fBmpParent.Width := Parent.Width;
    fBmpParent.Height := Parent.Height;
    Parent.Perform(WM_ERASEBKGND, fBmpParent.Canvas.Handle, 0);
    Parent.Perform(WM_PAINT, fBmpParent.Canvas.Handle, 0);

    LBlendFunc.BlendOp := AC_SRC_OVER;
    LBlendFunc.BlendFlags := 0;
    LBlendFunc.SourceConstantAlpha := not(fAlphaVal);
    LBlendFunc.AlphaFormat := 0;

    AlphaBlend(fBmpOwn.Canvas.Handle, 0, 0, Width, Height,
               fBmpParent.Canvas.Handle, Left, Top, Width, Height, LBlendFunc);

    BitBlt(Canvas.Handle, 0, 0, Width, Height, fBmpOwn.Canvas.Handle, 0, 0, SRCCOPY);
  end else
    inherited;
end;

end.

[anonymousdelphicoder]

Cevap verecek kimsecikler yokmu

[mrmarman]

Verdiğin örnek bir vcl uniti.
Benzerini kurup denemeden cevap vermek zor çünkü söylediğin şey ben yıllardır yapıyorum, böyle problem çıkmadı.

Kod içerisinde doublebuffered olayını nasıl kullandığını bilmiyorum. Formun mu yoksa başka birşey mi doublebuffered. Patentin nedir, flicker sebebi ne? Paneli mi taşıyorsun, üzerinde çizim vs işlem mi var? vs.

Boş bir proje kur örnek hazırla buradan paylaş ki sorunun ne olduğunu herkes anlasın