tslediter/funcext/tvclib/tgraphiccontrol.tsf

type tgraphiccontrol = class(TControl)
    uses utslvclauxiliary,utslvclgdi;
    {**
    @explan(说明) 自绘制控件 %%
    **}
    private
    //FCanvas: TCanvas;
    [weakref]FOnPaint:TNotifyEvent;
    protected
    procedure ChangeBounds(ALeft,ATop,AWidth,AHeight:integer;KeepBase:boolean);override; //type_tcontrol
    begin
        rect1 := array(FLeft,FTop,FLeft+FWidth,FTop+FHeight);
        rect2 := array(ALeft,ATop,ALeft+AWidth,ATop+AHeight);
        inherited;
        if rect1 <> rect2 then
        begin
            if Parent then
            begin
                //Parent.InvalidateRect(nil,false);
                Parent.InvalidateRect(rect1,false);
                Parent.InvalidateRect(rect2,false);
                //Parent.updateWindow();
            end
        end
    end
    function RealSetText(s);override;
    begin
        {**
        @explan(说明) 修改标题 %%
        **}
        if ifstring(s)and caption <> s then
        begin
            inherited;
            InvalidateRect(rec,true);
        end
    end
    procedure Paint();virtual;
    begin
        {**
        @explan(说明)控件绘制调用 ,使用Canvas属性和PAINTSTRUCT结构体 绘制控件 %%
        **}
        if(not iffuncptr(FOnPaint))or(not call(FOnPaint,self(true)))then
        begin
            canvas.Font := font;
            Canvas.DrawText(self.caption,self.ClientRect,DT_VCENTER .| DT_SINGLELINE .| DT_CENTER .| DT_NOPREFIX);
        end
        //_wapi.DrawFrameControl(Canvas.handle,const ClientRect,DFC_BUTTON,DFCS_BUTTONCHECK);
        //_wapi.DrawEdge(Canvas.handle,const ClientRect,EDGE_ETCHED,BF_RECT);
        //_wapi.DrawFocusRect(Canvas.Handle,const ClientRect);
    end
    //procedure DoOnChangeBounds();override;
    //begin
    //end
    //procedure DoOnParentHandleDestruction;override;
    //begin
    //end
    function InvalidateRectForce();
    begin
        if Parent then
        begin
            nrec := array(FLeft,FTop,FLeft+FWidth,FTop+FHeight);
            //return Parent.InvalidateRect(nrec,true);
            return Parent.InvalidateRect(nrec,false);
        end
    end
    public
    procedure SetVisible(Value);virtual;
    begin
        nv := Value?true:false;
        if nv <> Visible then
        begin
            inherited;
            //////添加visible的位置调整处理///////////
            p := Parent;
            if(p is class(TWinControl))and p.HandleAllocated()then
            begin
                if Align <> alNone then return p.DoControlAlign();
            end
            //////////////////
            InvalidateRectForce();
        end
    end
    function GetPreferredSize(w,h);override;
    begin
        ft := Font;
        if not ft then return ;
        if ongetpreferredsize then 
        begin    
            return inherited;
        end 
        c := caption;
        w := ft.Width*(max(length(c),1))+2;
        h := ft.Height+3; 
    end 
    function InvalidateRect(rec,f);
    begin
        {**
        @explan(说明)设置窗口区域无效 %%
        @param(rec)(array) 无效区域,nil表示窗口整体无效,array(左上右下) %%
        @param(f)(bool) 是否重画 %%
        **}
        if Visible {and Parent}then
        begin
            if not ifarray(rec)then return InvalidateRectForce();
            nrec := array(FLeft+rec[0],FTop+rec[1],FLeft+rec[2],FTop+rec[3]);
            p := Parent;
            if p then 
                return Parent.InvalidateRect(nrec,false);
        end
    end
    function WMPaint(o,Message:TLMPaint):LM_PAINT;override;
    begin
        //if  csCustomPaint in ControlState  then if Message.lparam<>2 then return ;
        dc := Message.wparam;
        if dc then
        begin
            Canvas.Handle := dc;
            try
                WMERASEBKGND(self(true),messagecreater(nil,WM_ERASEBKGND,dc,2));
                Canvas.SaveDC();
                Paint();
                Canvas.RestoreDC();
            finally
                Canvas.Handle := 0;
            end;
        end
    end
    function WMERASEBKGND(o,e):WM_ERASEBKGND;override;
    begin
        if ftransparent then 
        begin
            return 1;
        end 
        if e.wparam and e.lparam then
        begin
            if(BKBitmap is class(tcustombitmap))and BKBitmap.HandleAllocated()then
            begin
                //Canvas.StretchDraw(GetClientRect(),self.BKBitmap);//20210812 修正默认的背景绘图
                Canvas.DrawBitmap(self.BKBitmap,GetClientRect());
            end else
            begin
                if Enabled then 
                    cl := Color;
                else cl := cldisabledbk;
                if ifnumber(cl)then
                begin
                    Canvas.Brush.Color := cl;
                    Canvas.FillRect(GetClientRect());
                end
            end
            e.skip := true;
            return 1;
        end
    end
    function CMCursorChanged(o:tgraphiccontrol;var Message:TLMessage):CM_CURSORCHANGED;override;
    begin
        inherited;
    end
    procedure FontChanged(Sender:TObject);override;
    begin
        inherited;
    end
    function Create(AOwner:TComponent);override;
    begin
        inherited;
        FLeft := 10;
        FTop := 10;
        FWidth := 80;
        FHeight := 25;
        ftransparent := true;
        includestate(FControlState,csCustomPaint);
    end
    function Recycling();override;
    begin
        FOnPaint := nil;
        inherited;
    end
    function SetParent(NewParent);override; //type_tcontrol
    begin
        op := parent;
        if op=NewParent then return;
        inherited;
        if NewParent is class(TWinControl)then
        begin
            InvalidateRect();
        end
    end
    published
    property OnPaint:eventhandler read FOnPaint write FOnPaint;
    property transparent:bool read ftransparent write settransparent;
    {**
    @param(OnPaint)(function[TGraphicControl]:bool) 绘制回调,返回true不执行默认绘制 %%
    **}
    private
    ftransparent;
    function settransparent(v);
    begin
        nv := v?true:false;
        if nv<>ftransparent then 
        begin
            ftransparent := nv;    
        end 
    end 
end;