程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> delphi 事件和屬性的綁定,delphi事件綁定

delphi 事件和屬性的綁定,delphi事件綁定

編輯:Delphi

delphi 事件和屬性的綁定,delphi事件綁定


TWindowState = (wsNormal, wsMinimized, wsMaximized);  
  
TScrollingWinControl = class(TWinControl)  
private  
  FHorzScrollBar: TControlScrollBar;  
  FVertScrollBar: TControlScrollBar;  
  FAutoScroll: Boolean;  
  FAutoRangeCount: Integer;  
  FUpdatingScrollBars: Boolean;  
  procedure CalcAutoRange;  
  procedure ScaleScrollBars(M, D: Integer);  
  procedure SetAutoScroll(Value: Boolean);  
  procedure SetHorzScrollBar(Value: TControlScrollBar);  
  procedure SetVertScrollBar(Value: TControlScrollBar);  
  procedure UpdateScrollBars;  
  procedure WMSize(var Message: TWMSize); message WM_SIZE;  
  procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;  
  procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;  
  procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;  
protected  
  procedure AdjustClientRect(var Rect: TRect); override;  
  procedure AlignControls(AControl: TControl; var ARect: TRect); override;  
  function AutoScrollEnabled: Boolean; virtual;  
  procedure AutoScrollInView(AControl: TControl); virtual;  
  procedure ChangeScale(M, D: Integer); override;  
  procedure CreateParams(var Params: TCreateParams); override;  
  procedure CreateWnd; override;  
  procedure DoFlipChildren; override;

 

//此處所定義的就是 delphi 中object inspector 中的對象屬性所顯示的內容  TControlScrollBar類型, 讀取FHorzScrollBar 通過SetHorzScrollBar寫入  
 property HorzScrollBar: TControlScrollBar read FHorzScrollBar write SetHorzScrollBar;  
  property VertScrollBar: TControlScrollBar read FVertScrollBar write SetVertScrollBar;  
end;

上面是系統定義的,比較枯燥,下面是自己寫的代碼:

unit Unit1;  
  
interface  
  
uses  
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
  Dialogs, StdCtrls;  
  
type  
  TForm1 = class(TForm)  
    btn1: TButton;  
    edt1: TEdit;  
    procedure FormCreate(Sender: TObject);    //窗體創建事件  
    procedure btn1Click(Sender: TObject);     //butten 點擊事件  
  private  
  public  
    //自己寫的過程 顯示位置  
    procedure OnTestPostionChange(Sender: TObject; Positon: Integer);  
  end;  
  
   // 類似於函數指針 of object 它必須指向某個對象的方法(即成員函數).  
  TTestEvent = procedure (Sender: TObject; Positon: Integer) of Object;  
  
  TTestClass = class(TObject)  
  private  
    FPosition: Integer;      // Position 屬性用的  
    FOnPositionChange: TTestEvent; // OnPositionChange 屬性  
    procedure SetPosition(const Value: Integer);  
  protected  
    procedure DoPositonChange;  
   // procedure doaaa: dynamic;  
  public  
    //屬性 position 讀取FPosition 寫到SetPosition   integer 類型  
    property Position: Integer read FPosition write SetPosition;  
    //屬性 onPositionChange  對象過程函數指針類型 讀取FOnposition  寫入 FOnPositionChange  
    property OnPositionChange: TTestEvent read FOnPositionChange write FOnPositionChange;  
  end;  
  
var  
  Form1: TForm1;  
  test1: TTestClass;  
  
implementation  
  
{$R *.dfm}  
  
procedure TForm1.FormCreate(Sender: TObject);  
begin  
  test1 := TTestClass.Create;  
  test1.OnPositionChange := OnTestPostionChange;  
end;  
  
{ TTestClass }  
  
procedure TTestClass.DoPositonChange;  
begin  
  if Assigned(FOnPositionChange) then  
    FOnPositionChange(Self,FPosition);  
end;  
  
  
procedure TTestClass.SetPosition(const Value: Integer);  
begin  
  if Value <> FPosition then  
  begin  
    FPosition := Value;  
    DoPositonChange;  
  end;  
end;  
  
procedure TForm1.btn1Click(Sender: TObject);  
begin  
  test1.Position := StrToInt(edt1.Text);  
end;  
  
procedure TForm1.OnTestPostionChange(Sender: TObject; Positon: Integer);  
begin  
  showmessage('Postion = '+IntToStr(Positon));  
end;  
  
end.  

執行過程就是:窗體創建(給OnPositionChange賦值)--點擊button(讀取edt1中的值)---之後調用setposition(也許這就是綁定好的了吧)----DOPositionchange----執行FOnPositionChange(也就是OnTestPostionChange)。。。

 

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved