Question

下面是透明面板vcl

它有效。

但我希望绘制实线边框（其他部分仍然是透明的）

有任何提示吗？

您的评论欢迎

unit aframek;

interface   

uses           
    Windows,   Messages,   SysUtils,   Classes,   Graphics,   Controls,   Forms,   Dialogs,   
    ExtCtrls;

type
    TAframekStyle   =   (
        gsBlackness,   gsDstInvert,   gsMergeCopy,   gsMergePaint,   gsNotSrcCopy,   
        gsNotSrcErase,   gsPatCopy,   gsPatInvert,   gsPatPaint,   gsSrcAnd,   
        gsSrcCopy,   gsSrcErase,   gsSrcInvert,   gsSrcPaint,   gsWhiteness);   

    TAframek   =   class(TCustomControl)
    private   
        FColor:   TColor;   
        FStyle:   TAframekStyle;
        FOnPaint:   TNotifyEvent;


        procedure   SetColor(Value:   TColor);   
        procedure   SetStyle(Value:   TAframekStyle);
        procedure   CMCtl3DChanged(var   Message:   TMessage);   message   CM_CTL3DCHANGED;
        procedure   WMEraseBkgnd(var   Message:   TMessage);   message   WM_ERASEBKGND;   
        procedure   WMWindowPosChanging(var   Message:   TWMWindowPosChanging);   message   WM_WINDOWPOSCHANGING;   
    protected   
        Buffer:   TBitmap;   

        procedure   CreateParams(var   Params:   TCreateParams);   override;   
        procedure   Paint;   override;   
        procedure   Resize;   override;   
    public   
        constructor   Create(AOwner:   TComponent);   override;   
        destructor   Destroy;   override;   
        property   Canvas;   

    published


        property   Align;
        property   Anchors;
        property   AutoSize;   
        property   BiDiMode;   
        property   BorderWidth;   
        property   Color:   TColor   read   FColor   write   SetColor;   
        property   Ctl3D;   
        property   Enabled;   
        property   Style:   TAframekStyle   read   FStyle   write   SetStyle   default   gsSrcAnd;
        property   Visible;   

        property   OnClick;   
        property   OnDblClick;   
        property   OnEnter;
        property   OnExit;   
        property   OnMouseDown;   
        property   OnMouseMove;   
        property   OnMouseUp;   
        property   OnResize;   
        property   OnPaint:   TNotifyEvent   read   FOnPaint   write   FOnPaint;
    end;   

procedure   Register;   

implementation   

procedure   Register;   
begin   
    RegisterComponents('aka',   [TAframek]);
end;   

function   AframekStyleToInt(gs:   TAframekStyle):   LongInt;
begin   
    case   gs   of   
        gsBlackness     :   Result   :=   cmBlackness;
        gsDstInvert     :   Result   :=   cmDstInvert;   
        gsMergeCopy     :   Result   :=   cmMergeCopy;   
        gsMergePaint   :   Result   :=   cmMergePaint;   
        gsNotSrcCopy   :   Result   :=   cmNotSrcCopy;   
        gsNotSrcErase:   Result   :=   cmNotSrcErase;   
        gsPatCopy         :   Result   :=   cmPatCopy;   
        gsPatInvert     :   Result   :=   cmPatInvert;   
        gsPatPaint       :   Result   :=   cmPatPaint;   
        gsSrcAnd           :   Result   :=   cmSrcAnd;   
        gsSrcCopy         :   Result   :=   cmSrcCopy;   
        gsSrcErase       :   Result   :=   cmSrcErase;   
        gsSrcInvert     :   Result   :=   cmSrcInvert;   
        gsSrcPaint       :   Result   :=   cmSrcPaint;   
        gsWhiteness     :   Result   :=   cmWhiteness;   
        else                       Assert(True,   'Error   parameter   in   function   AframeStyleToInt');
    end;   
end;   

constructor   TAframek.Create(AOwner:   TComponent);
var

    FMarkBrush: LOGBRUSH;
    FMarkPen: HPEN;
    FPenStyle: array[0..1] of Integer;
    FStartAngle: Single;

begin   
    inherited   Create(AOwner);   
    Buffer   :=   TBitmap.Create;
    ControlStyle   :=   [csAcceptsControls,   csCaptureMouse,   csClickEvents,   
        csDoubleClicks,   csReplicatable];   
    Width   :=   100;   
    Height   :=   100;   
    FStyle   :=   gsSrcAnd;   
    ParentCtl3d   :=   False;   
    Ctl3D   :=   False;   
    ParentColor   :=   False;   
    FColor   :=   clWhite;



end;   

destructor   TAframek.Destroy;
begin   
    Buffer.Free;   
    inherited   Destroy;   
end;   

procedure   TAframek.Paint;
var   
    R:   TRect;   
    rop:   LongInt;   
begin   
    R   :=   Rect(0,   0,   Width,   Height);   
    Buffer.Width   :=   Width;   
    Buffer.Height   :=   Height;   
    Buffer.Canvas.Brush.Style   :=   bsSolid;   
    Buffer.Canvas.Brush.Color   :=   FColor;   
    Buffer.Canvas.FillRect(Rect(0,   0,   Width,   Height));   
    rop   :=   AframekStyleToInt(FStyle);
    StretchBlt(Buffer.Canvas.Handle,   0,   0,   Width,   Height,   
                          Canvas.Handle,   0,   0,   Width,   Height,   rop);   
    if   Ctl3D   then   DrawEdge(Buffer.Canvas.Handle,   R,   BDR_RAISEDINNER,   BF_RECT);   
    Buffer.Canvas.Pen.Mode   :=   pmCopy;   
    Buffer.Canvas.Pen.Style   :=   psSolid;   
    Canvas.Draw(0,   0,   Buffer);   
    if   Assigned(FOnPaint)   then   FOnPaint(Self);   
end;   


procedure   TAframek.SetColor(Value:   TColor);
begin   
    if   Value   <>   FColor   then   
    begin   
        FColor   :=   Value;   
        RecreateWnd;   
    end;   
end;   

procedure   TAframek.CreateParams(var   Params:   TCreateParams);
begin   
    inherited   CreateParams(Params);   

    Params.ExStyle   :=   Params.ExStyle   +   WS_EX_TRANSPARENT;   
end;   

procedure   TAframek.WMWindowPosChanging(var   Message:   TWMWindowPosChanging);
begin   
    Invalidate;   

    inherited;   
end;   

procedure   TAframek.WMEraseBkgnd(var   Message:   TMessage);
begin   
    Message.Result   :=   0;   
end;   

procedure   TAframek.Resize;
begin   
    Invalidate;   

    inherited;   
end;   

procedure   TAframek.CMCtl3DChanged(var   Message:   TMessage);
begin   
    inherited;   

    RecreateWnd;   
end;   

procedure   TAframek.SetStyle(Value:   TAframekStyle);
begin   
    if   Value   <>   FStyle   then   
    begin   
        FStyle   :=   Value;   
        RecreateWnd;   
    end;   
end;   

end.

Answer 1

看起来你没有绘制边框，除了Ctrl3D属性为True的情况。但它在构造函数中得到假:) 如果要以自己的方式绘制边框，请尝试在TCanvas.FillRect之后在Paint方法中调用TCanvas.Rectangle或TCanvas.FrameRect。

透明面板，边框实心

1 个答案: