DrawPanel.pas
上传用户:mjqmds
上传日期:2022-05-05
资源大小:2827k
文件大小:4k
源码类别:

DirextX编程

开发平台:

Delphi

  1. unit DrawPanel;
  2. interface
  3. uses
  4.   Windows, SysUtils, Messages, Classes, Controls, ExtCtrls;
  5. type
  6.   TMsgProc=procedure (var Msg:TMessage; DefaultProcess:Boolean) of Object;
  7.   TDrawPanel = class(TCustomPanel)
  8.   private
  9.     FOnPaint: TNotifyEvent;
  10.     FEraseBackground: Boolean;
  11.     FOnBeforeMsg: TMsgProc;
  12.     FOnAfterMsg: TMsgProc;
  13.     procedure SetOnPaint(const Value: TNotifyEvent);
  14.     procedure WMERASEBKGND(var Msg:TWMERASEBKGND); Message WM_ERASEBKGND;
  15.     procedure SetEraseBackground(const Value: Boolean);
  16.     procedure SetOnAfterMsg(const Value: TMsgProc);
  17.     procedure SetOnBeforeMsg(const Value: TMsgProc);
  18.     { Private declarations }
  19.   protected
  20.     procedure Paint;override;
  21.     procedure WndProc(var Msg:TMessage); override;
  22.     { Protected declarations }
  23.   public
  24.     Constructor Create(Owner:TComponent);override;
  25.     property DockManager;
  26.     property Canvas;
  27.   published
  28.     property EraseBackground:Boolean read FEraseBackground write SetEraseBackground;
  29.     property OnPaint:TNotifyEvent read FOnPaint write SetOnPaint;
  30.     property Align;
  31.     property Alignment;
  32.     property Anchors;
  33.     property AutoSize;
  34.     property BevelInner;
  35.     property BevelOuter;
  36.     property BevelWidth;
  37.     property BiDiMode;
  38.     property BorderWidth;
  39.     property BorderStyle;
  40.     property Caption;
  41.     property Color;
  42.     property Constraints;
  43.     property Ctl3D;
  44.     property UseDockManager default True;
  45.     property DockSite;
  46.     property DragCursor;
  47.     property DragKind;
  48.     property DragMode;
  49.     property Enabled;
  50.     property FullRepaint;
  51.     property Font;
  52.     property Locked;
  53.     property ParentBiDiMode;
  54.     property ParentBackground;
  55.     property ParentColor;
  56.     property ParentCtl3D;
  57.     property ParentFont;
  58.     property ParentShowHint;
  59.     property PopupMenu;
  60.     property ShowHint;
  61.     property TabOrder;
  62.     property TabStop;
  63.     property Visible;
  64.     property OnCanResize;
  65.     property OnClick;
  66.     property OnConstrainedResize;
  67.     property OnContextPopup;
  68.     property OnDockDrop;
  69.     property OnDockOver;
  70.     property OnDblClick;
  71.     property OnDragDrop;
  72.     property OnDragOver;
  73.     property OnEndDock;
  74.     property OnEndDrag;
  75.     property OnEnter;
  76.     property OnExit;
  77.     property OnGetSiteInfo;
  78.     property OnMouseDown;
  79.     property OnMouseMove;
  80.     property OnMouseUp;
  81.     property OnResize;
  82.     property OnStartDock;
  83.     property OnStartDrag;
  84.     property OnUnDock;
  85.     property OnBeforeMsg:TMsgProc read FOnBeforeMsg write SetOnBeforeMsg;
  86.     property OnAfterMsg:TMsgProc read FOnAfterMsg write SetOnAfterMsg;
  87.   end;
  88. procedure Register;
  89. implementation
  90. procedure Register;
  91. begin
  92.   RegisterComponents('WH', [TDrawPanel]);
  93. end;
  94. { TDrawPanel }
  95. constructor TDrawPanel.Create(Owner: TComponent);
  96. begin
  97.     inherited;
  98.     FEraseBackground:=true;
  99. end;
  100. procedure TDrawPanel.Paint;
  101. begin
  102.     inherited;
  103.     
  104.     if Assigned(FOnPaint) then
  105.         FOnPaint(Self);
  106. end;
  107. procedure TDrawPanel.SetEraseBackground(const Value: Boolean);
  108. begin
  109.     FEraseBackground := Value;
  110. end;
  111. procedure TDrawPanel.SetOnAfterMsg(const Value: TMsgProc);
  112. begin
  113.     FOnAfterMsg := Value;
  114. end;
  115. procedure TDrawPanel.SetOnBeforeMsg(const Value: TMsgProc);
  116. begin
  117.     FOnBeforeMsg := Value;
  118. end;
  119. procedure TDrawPanel.SetOnPaint(const Value: TNotifyEvent);
  120. begin
  121.     FOnPaint := Value;
  122. end;
  123. procedure TDrawPanel.WMERASEBKGND(var Msg: TWMERASEBKGND);
  124. Var
  125.     Rec:TRect;
  126. begin
  127.     if FEraseBackground then
  128.     begin
  129.         Inherited;
  130.     end
  131.     else
  132.     begin
  133.         Rec:=Self.GetClientRect();
  134.         ValidateRect(Handle,@Rec);
  135.     end;
  136. end;
  137. procedure TDrawPanel.WndProc(var Msg: TMessage);
  138. Var
  139.     b:Boolean;
  140. begin
  141.     b:=true;
  142.     if Assigned(FOnBeforeMsg) then
  143.     begin
  144.         FOnBeforeMsg(Msg,b);
  145.         if Not b then
  146.             Exit;
  147.     end;
  148.     inherited;
  149.     b:=true;
  150.     if Assigned(FOnAfterMsg) then
  151.     begin
  152.         FOnAfterMsg(Msg,b);
  153.     end;
  154. end;
  155. end.