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;