Databases
StackOverflow2013
Postsdbo
PODelphi Component Not Painted
Body
 

Note that there are some explanatory texts on larger screens.

plurals
  1. PODelphi Component Not Painted
    text
    copied!<p>I have component (descendat of TPanel) where I implemented Transparency and BrushStyle (using TImage) properties.</p> <p>All it's ok when I have one component of this type on the form. Bun when I pun on the form more components of this type only first visible component is painted. When form is moved and first component is under other window or outside desktop next component is painted.</p> <pre><code>unit TransparentPanel; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, stdctrls; type TTransparentPanel = class(TPanel) private FTransparent: Boolean; FBrushStyle: TBrushStyle; FImage: TImage; procedure SetTransparent(const Value: Boolean); procedure SetBrushStyle(const Value: TBrushStyle); protected procedure CreateParams(var Params: TCreateParams); override; procedure Paint; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Transparent: Boolean read FTransparent write SetTransparent default True; property BrushStyle: TBrushStyle read FBrushStyle write SetBrushStyle default bsBDiagonal; end; procedure Register; implementation procedure Register; begin RegisterComponents('TransparentPanel', [TTransparentPanel]); end; constructor TTransparentPanel.Create(AOwner: TComponent); begin inherited Create(AOwner); FTransparent := True; FBrushStyle := bsBDiagonal; FImage := TImage.Create(Self); FImage.Align := alClient; FImage.Parent := Self; FImage.Transparent := FTransparent; end; procedure TTransparentPanel.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); if ((not (csDesigning in ComponentState)) and FTransparent) then Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT; end; destructor TTransparentPanel.Destroy; begin if Assigned(FImage) then FreeAndNil(FImage); inherited Destroy; end; procedure TTransparentPanel.Paint; var XBitMap, BitmapBrush: TBitmap; XOldDC: HDC; XRect: TRect; ParentCanvas: TCanvas; begin {This panel will be transparent only in Run Time} if (csDesigning in ComponentState) or (not FTransparent) or (FBrushStyle in [bsClear, bsSolid]) then inherited Paint else begin XRect := ClientRect; XOldDC := Canvas.Handle; XBitMap := TBitmap.Create; BitmapBrush := TBitmap.Create; try XBitMap.Height := Height; XBitMap.Width := Width; Canvas.Handle := XBitMap.Canvas.Handle; inherited Paint; RedrawWindow(Parent.Handle, @XRect, 0, RDW_ERASE or RDW_INVALIDATE or RDW_NOCHILDREN or RDW_UPDATENOW); BitmapBrush.Width := FImage.Width; BitmapBrush.Height := FImage.Height; BitmapBrush.Canvas.Brush.Color := clBlack; BitmapBrush.Canvas.Brush.Style := FBrushStyle; SetBkColor(BitmapBrush.Canvas.Handle, clWhite); BitmapBrush.Canvas.FillRect(BitmapBrush.Canvas.ClipRect); FImage.Canvas.Draw(0, 0, BitmapBrush); finally Canvas.Handle := XOldDC; Canvas.BrushCopy(XRect, XBitMap, XRect, Color); XBitMap.Free; BitmapBrush.Free; end; end; end; procedure TTransparentPanel.SetBrushStyle(const Value: TBrushStyle); begin if (FBrushStyle &lt;&gt; Value) then begin FBrushStyle := Value; Invalidate; end end; procedure TTransparentPanel.SetTransparent(const Value: Boolean); begin if (FTransparent &lt;&gt; Value) then begin FTransparent := Value; FImage.Transparent := Value; Invalidate; end; end; end. </code></pre> <p>What is wrong?</p>
 

Querying!

 
Guidance
An individual column

Larger individual text columns get their own page to allow for proper reading.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload