zoukankan      html  css  js  c++  java
  • TGraphicControl(自绘就2步,直接自绘自己,不需要调用VCL框架提供的函数重绘所有子控件,也不需要自己来提供PaintWindow函数让管理框架来调用)与TControl关键属性方法速记(Repaint要求父控件执行详细代码来重绘自己,还是直接要求Invalidate无效后Update刷新父控件,就看透明不透明这个属性,因为计算显示的区域有所不同)

    TGraphicControl = class(TControl)
      private
        FCanvas: TCanvas;
        procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
      protected
        procedure Paint; virtual;
        property Canvas: TCanvas read FCanvas; // 到这步才有
      public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
      end;
    
    constructor TGraphicControl.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner);
      FCanvas := TControlCanvas.Create; // 相互捆绑
      TControlCanvas(FCanvas).Control := Self;
    end;
    
    destructor TGraphicControl.Destroy;
    begin
      if CaptureControl = Self then SetCaptureControl(nil);
      FCanvas.Free;
      inherited Destroy;
    end;
    
    procedure TGraphicControl.WMPaint(var Message: TWMPaint); // 第一步,收到WM_PAINT消息
    begin
      if (Message.DC <> 0) and not (csDestroying in ComponentState) then
      begin
        Canvas.Lock;
        try
          Canvas.Handle := Message.DC;
          try
            Paint; // 第二步,调用自己的Paint虚函数
          finally
            Canvas.Handle := 0;
          end;
        finally
          Canvas.Unlock;
        end;
      end;
    end;
    
    procedure TGraphicControl.Paint; // 提前准备:提前由程序员覆盖(目前是空函数)
    begin
    end;

    TControl处理所有鼠标消息 + 位置,字体,对齐,Enable等等 + 部分消息处理。感觉内容比较简单,精华不在这里。

      TControl = class(TComponent)
        FParent: TWinControl;
        FWindowProc: TWndMethod;
        FControlStyle: TControlStyle;
        FControlState: TControlState;
        FParentFont: Boolean;
        FParentColor: Boolean;
    
        FLeft: Integer;
        FTop: Integer;
        FWidth: Integer;
        FHeight: Integer;
        FVisible: Boolean;
        FEnabled: Boolean;
        FIsControl: Boolean;
        FFont: TFont;
        FColor: TColor;
        FHint: string;
        FText: PChar;
    
        FOnClick: TNotifyEvent;
        FOnDblClick: TNotifyEvent;
        procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
        procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
        procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
        procedure WMMButtonDown(var Message: TWMMButtonDown); message WM_MBUTTONDOWN;
        procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
        procedure WMRButtonDblClk(var Message: TWMRButtonDblClk); message WM_RBUTTONDBLCLK;
        procedure WMMButtonDblClk(var Message: TWMMButtonDblClk); message WM_MBUTTONDBLCLK;
        procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
        procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
        procedure WMMButtonUp(var Message: TWMMButtonUp); message WM_MBUTTONUP;
        procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
        procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
    
        procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE;
        procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
        procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
    
        procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
        procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
        procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
        procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
        procedure CMMouseActivate(var Message: TCMMouseActivate); message CM_MOUSEACTIVATE;
        procedure CMParentFontChanged(var Message: TCMParentFontChanged); message CM_PARENTFONTCHANGED;
        procedure CMSysFontChanged(var Message: TMessage); message CM_SYSFONTCHANGED;
        procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
        procedure CMParentShowHintChanged(var Message: TMessage); message CM_PARENTSHOWHINTCHANGED;
        procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
        procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
        procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
        procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
        procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
        procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
        procedure CMParentBiDiModeChanged(var Message: TMessage); message CM_PARENTBIDIMODECHANGED;
        procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL;
        procedure CMGesture(var Message: TCMGesture); message CM_GESTURE;
        procedure CMParentTabletOptionsChanged(var Message: TMessage); message CM_PARENTTABLETOPTIONSCHANGED;
    
    
        procedure Click; dynamic;
        procedure DblClick; dynamic;
        function GetClientRect: TRect; virtual;
        procedure Loaded; override;
    
    
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        procedure BringToFront;
        function GetParentComponent: TComponent; override;
        function HasParent: Boolean; override;
        procedure SetTextBuf(Buffer: PChar);
    
        function ClientToScreen(const Point: TPoint): TPoint;
        function ClientToParent(const Point: TPoint; AParent: TWinControl = nil): TPoint;
        procedure Hide;
    
        procedure Refresh;
        procedure Repaint; virtual;
        procedure Show;
        procedure Update; virtual;
    
        function DesignWndProc(var Message: TMessage): Boolean; dynamic;
        procedure WndProc(var Message: TMessage); virtual; // 处理了不少消息
        procedure DefaultHandler(var Message); override;
        function Perform(Msg: Cardinal; WParam: WPARAM; LParam: PChar): LRESULT; overload;
        function Perform(Msg: Cardinal; WParam: WPARAM; var LParam: TRect): LRESULT; overload;
    
        property WindowProc: TWndMethod read FWindowProc write FWindowProc;
        property Parent: TWinControl read FParent write SetParent;
    procedure TControl.Invalidate;
    begin
      InvalidateControl(Visible, csOpaque in ControlStyle);
    end;
    
    procedure TControl.InvalidateControl(IsVisible, IsOpaque: Boolean);
    begin
      if (IsVisible) and (Parent <> nil) and
        Parent.HandleAllocated then
      begin
        Rect := BoundsRect;
        InvalidateRect(Parent.Handle, Rect, not (IsOpaque or
          (csOpaque in Parent.ControlStyle) or BackgroundClipped)); // API 使得父控件的部分区域失效
      end;
    end;
    
    // (非重载)显示自己
    procedure TControl.Show;
    begin
      if Parent <> nil then Parent.ShowControl(Self);
      if not (csDesigning in ComponentState) or
        (csNoDesignVisible in ControlStyle) then Visible := True;
    end;
    
    // (重载)通知父控件刷新(注意,它的父类是一个TWinControl)
    // 貌似挺巧妙,因为重载,所以先调用了TWinControl.Update 后面就不是当前类管的事情了。 
    // 但是单独的TWinControl子控件重载了Update消息,所以不会用到它。
    // 也许TGraphicControl 才会用到TControl.Update; ?
    procedure TControl.Update;
    begin
      if Parent <> nil then Parent.Update;
    end;
    
    
    // (非重载)表面上看多此一举,但它其实可以调用子类的Repaint(通用方法)
    procedure TControl.Refresh;
    begin
      Repaint;
    end;
    
    // (重载)计算剪裁区域以后,还是发给了父类去重绘。父类的PaintControls会给每一个子控件发WM_PAINT消息。
    // 每个子控件都用Handle区分。而消息队列是线程为载体的,所以不矛盾
    // 所以调用TControl.Repaint;来刷新也没有问题。单独的TWinControl子控件重载了Repaint消息,所以不会用到它。
    // 也许TGraphicControl 才会用到TControl.Repaint; ?
    procedure TControl.Repaint;
    var
      DC: HDC;
    begin
      if (Visible) and (Parent <> nil) and // 当前控件可显示
        Parent.HandleAllocated then
        if csOpaque in ControlStyle then // 当前控件不透明(即需要显示)
        begin
          DC := GetDC(Parent.Handle); // 取得父类的句柄(注意,它的父类是一个TWinControl)
          try
            IntersectClipRect(DC, Left, Top, Left + Width, Top + Height); // API 给父类的句柄创建剪裁区
            Parent.PaintControls(DC, Self); // 父类再去画剩余部分,相当于调用 TWinControl.PaintControls(DC: HDC; First: TControl);
          finally
            ReleaseDC(Parent.Handle, DC);
          end;
        end else // 如果当前控件透明,就是失效后立刻刷新显示(即当前控件的图形没有变化,只是需要重新刷新显示的问题)
        begin
          Invalidate; // 存在要求显示(透明的情况下)
          Update;
        end;
    end;

     对比一下TWinControl.Repaint函数,思考为什么不透明的时候,会多了一段详细的自绘代码?

    procedure TWinControl.Repaint;
    begin
      Invalidate;
      Update;
    end;

    说白了就是重新裁剪,而且是对父控件的DC进行重新剪裁。我估计,这里的代码怕的是,图形控件既显示(visible),又不透明(csOpaque)的情况下,图形本身的大小随时可能会变,所以每次都需要重新剪裁。而不透明的情况下,不存在这个问题,所以直接刷新就行了。

    但是新问题又来了,剪裁以后,居然没有要求使无效和刷新,为什么呢?通过查询TWinControl.PaintControls的代码得知:

    procedure TWinControl.PaintControls(DC: HDC; First: TControl);
    var
      I, Count, SaveIndex: Integer;
      FrameBrush: HBRUSH;
    begin
      if DockSite and UseDockManager and (DockManager <> nil) then
        DockManager.PaintSite(DC);
      if FControls <> nil then
      begin
        I := 0;
        if First <> nil then
        begin
          I := FControls.IndexOf(First);
          if I < 0 then I := 0;
        end;
        Count := FControls.Count;
        while I < Count do
        begin
          with TControl(FControls[I]) do
            if (Visible or (csDesigning in ComponentState) and
              not (csNoDesignVisible in ControlStyle)) and
              RectVisible(DC, Rect(Left, Top, Left + Width, Top + Height)) then
            begin
              if csPaintCopy in Self.ControlState then
                Include(FControlState, csPaintCopy);
              SaveIndex := SaveDC(DC);
              MoveWindowOrg(DC, Left, Top);
              IntersectClipRect(DC, 0, 0, Width, Height);
              Perform(WM_PAINT, DC, 0);
              RestoreDC(DC, SaveIndex);
              Exclude(FControlState, csPaintCopy);
            end;
          Inc(I);
        end;
      end;
      if FWinControls <> nil then
        for I := 0 to FWinControls.Count - 1 do
          with TWinControl(FWinControls[I]) do
            if FCtl3D and (csFramed in ControlStyle) and
              (Visible or (csDesigning in ComponentState) and
              not (csNoDesignVisible in ControlStyle)) then
            begin
              FrameBrush := CreateSolidBrush(ColorToRGB(clBtnShadow));
              FrameRect(DC, Rect(Left - 1, Top - 1, Left + Width, Top + Height),
                FrameBrush);
              DeleteObject(FrameBrush);
              FrameBrush := CreateSolidBrush(ColorToRGB(clBtnHighlight));
              FrameRect(DC, Rect(Left, Top, Left + Width + 1, Top + Height + 1),
                FrameBrush);
              DeleteObject(FrameBrush);
            end;
    end;

    当场就要求所有图形子控件执行WM_PAINT,即模拟图形控件收到WM_PAINT,即立刻要求全部重绘,所以也就不必使无效和刷新了。

    做个实验测试一下,看是不是图形控件剪裁区域变化以后的问题(确实当场起作用了):

    procedure TForm1.Button2Click(Sender: TObject);
    begin
      image1.Width :=100;
    end;
    
    property Width: Integer read FWidth write SetWidth;
    
    procedure TControl.SetWidth(Value: Integer);
    begin
      SetBounds(FLeft, FTop, Value, FHeight);
      Include(FScalingFlags, sfWidth);
    end;
    
    procedure TControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
    begin
      if CheckNewSize(AWidth, AHeight) and
        ((ALeft <> FLeft) or (ATop <> FTop) or
        (AWidth <> FWidth) or (AHeight <> FHeight)) then
      begin
        InvalidateControl(Visible, False); // TControl的函数,注意这里的osPraque是false,即当前控件处于透明状态。
        FLeft := ALeft;
        FTop := ATop;
        FWidth := AWidth;
        FHeight := AHeight;
        UpdateAnchorRules;
        Invalidate; // TControl的函数,为什么要失效两遍?因为长宽高可能变化了。
        Perform(WM_WINDOWPOSCHANGED, 0, 0);
        RequestAlign;
        if not (csLoading in ComponentState) then Resize;
      end;
    end;
    
    procedure TControl.WMWindowPosChanged(var Message: TWMWindowPosChanged);
    begin
      inherited;
      { Update min/max width/height to actual extents control will allow }
      if ComponentState * [csReading, csLoading] = [] then
      begin
        with Constraints do
        begin
          if (MaxWidth > 0) and (Width > MaxWidth) then
            FMaxWidth := Width
          else if (MinWidth > 0) and (Width < MinWidth) then
            FMinWidth := Width;
          if (MaxHeight > 0) and (Height > MaxHeight) then
            FMaxHeight := Height
          else if (MinHeight > 0) and (Height < MinHeight) then
            FMinHeight := Height;
        end;
        if Message.WindowPos <> nil then
          with Message.WindowPos^ do
            if (FHostDockSite <> nil) and not (csDocking in ControlState)  and
              (Flags and SWP_NOSIZE = 0) and (cx <> 0) and (cy <> 0) then
              CalcDockSizes;
      end;
    end;

    问题:我不明白,Form1是什么收到的WM_PAINT消息,使得Image1被重绘的?

    回答:系统空闲时候探测无效区域,发现有,就立刻发送WM_PAINT消息。

    Invalidate 发起消息, 在下一个消息循环就会知道要 paint

    Invalidate之后,系统会选择一个时间发送WM_PAINT消息。

    系统会在需要重绘的时候计算需要重绘的Region,然后发送WM_PAINT给相应窗口

    我刚才没想起来 一头钻到updateWindow这种直接调用的思维里去了

    -------------------------------------------------------------

    最后:Reflesh是通用方法,但其实扰乱思路,不用管

  • 相关阅读:
    第十周进度条
    冲刺阶段第十天
    冲刺阶段第九天
    冲刺阶段第八天
    冲刺阶段第七天
    冲刺阶段第六天
    第一次冲刺阶段(十一)
    第一次冲刺阶段(十)
    第一次冲刺阶段(九)
    第一次冲刺阶段(八)
  • 原文地址:https://www.cnblogs.com/findumars/p/3239749.html
Copyright © 2011-2022 走看看