万一 - 博客园

[置顶]博客导读(09.5.15)

博客总目录(2007.11.12 - 2010.4.25)

posted @ 2009-05-15 22:39 万一阅读(6330) 评论(226) 编辑

2012年1月5日

当我把一个"结构体"在类中当做属性后, 在实用中可以直接读取结构体成员, 但不能直接写入...

下面是由此引发的小练习:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  end;

  TMyClass = class
  strict private
    FPos: TPoint;
    procedure SetPos(const Value: TPoint);
  public
    property Pos: TPoint read FPos write SetPos; //属性 Pos 对应一个点结构
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TMyClass }

procedure TMyClass.SetPos(const Value: TPoint);
begin
  FPos := Value;
end;


{测试}

procedure TForm1.Button1Click(Sender: TObject);
var
  obj: TMyClass;
begin
  obj := TMyClass.Create;
  ShowMessageFmt('%d, %d', [obj.Pos.X, obj.Pos.Y]); //可以直接访问结构中的元素
//  obj.Pos.X := 11;  //但不能直接给结构中的元素赋值
//  obj.Pos.Y := 22;
  obj.Free;
end;

//变通一
procedure TForm1.Button2Click(Sender: TObject);
var
  obj: TMyClass;
begin
  obj := TMyClass.Create;
  obj.Pos := Point(22,33); //
  ShowMessageFmt('%d, %d', [obj.Pos.X, obj.Pos.Y]);
  obj.Free;
end;

//变通二
procedure TForm1.Button3Click(Sender: TObject);
var
  obj: TMyClass;
  pt: TPoint;
begin
  obj := TMyClass.Create;
  pt.X := 33;
  pt.Y := 44;
  obj.Pos := pt;
  ShowMessageFmt('%d, %d', [obj.Pos.X, obj.Pos.Y]);
  obj.Free;
end;

//变通三(假如属性的 get 不是方法)
procedure TForm1.Button4Click(Sender: TObject);
var
  obj: TMyClass;
  p: PPoint;
begin
  obj := TMyClass.Create;
  p := Addr(obj.Pos);
  p.X := 44;
  p.Y := 55;
  ShowMessageFmt('%d, %d', [obj.Pos.X, obj.Pos.Y]);
  obj.Free;
end;

//变通四(假如属性的 get 不是方法)
procedure TForm1.Button5Click(Sender: TObject);
var
  obj: TMyClass;
begin
  obj := TMyClass.Create;
  PPoint(Addr(obj.Pos)).X := 55;
  PPoint(Addr(obj.Pos)).Y := 66;
  ShowMessageFmt('%d, %d', [obj.Pos.X, obj.Pos.Y]);
  obj.Free;
end;

end.

练习二:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  end;

  TMyClass = class
  private
    FPos: TPoint;
    function GetPos: TPoint;
    procedure SetPos(const Value: TPoint);
    function GetXY(const Index: Integer): Integer;
    procedure SetXY(const Index, Value: Integer);
  public
    property Pos: TPoint read GetPos write SetPos;
    property X: Integer index 0 read GetXY write SetXY;
    property Y: Integer index 1 read GetXY write SetXY;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TMyClass }

function TMyClass.GetPos: TPoint;
begin
  Result := FPos;
end;

procedure TMyClass.SetPos(const Value: TPoint);
begin
  FPos := Value;
end;

function TMyClass.GetXY(const Index: Integer): Integer;
begin
  Result := 0;
  case Index of
    0: Result := FPos.X;
    1: Result := FPos.Y;
  end;
end;

procedure TMyClass.SetXY(const Index, Value: Integer);
begin
  case Index of
    0: FPos.X := Value;
    1: FPos.Y := Value;
  end;
end;

{测试}
procedure TForm1.FormCreate(Sender: TObject);
var
  obj: TMyClass;
begin
  obj := TMyClass.Create;
  obj.X := 11;
  obj.Y := 22;
  ShowMessageFmt('%d, %d', [obj.Pos.X, obj.Pos.Y]);
  obj.Free;
end;

end.

posted @ 2012-01-05 16:56 万一阅读(427) 评论(1) 编辑

2012年1月3日

覆盖、再覆盖

在实践中真的会发现更多问题.

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  end;

  IA = Interface
    function GetName: string;
    property Name: string read GetName;
  end;

  TC1 = class(TInterfacedObject, IA)
    function GetName: string; virtual;
  end;

  TC2 = class(TC1)
    function GetName: string; override; //覆盖
  end;

  TC3 = class(TC2)
    function GetName: string; override; //再覆盖
  end;

  TC4 = class(TC3)
    function GetName: string; override; //再覆盖
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TC1 }

function TC1.GetName: string;
begin
  Result := 'C1';
end;

{ TC2 }

function TC2.GetName: string;
begin
  Result := 'C2';
end;

{ TC3 }

function TC3.GetName: string;
begin
  Result := 'C3';
end;

{ TC4 }

function TC4.GetName: string;
begin
  Result := inherited + '0';
end;


{测试}
procedure TForm1.FormCreate(Sender: TObject);
var
  v1,v2,v3,v4: IA;
begin
  v1 := TC1.Create;
  v2 := TC2.Create;
  v3 := TC3.Create;
  v4 := TC4.Create;
  ShowMessageFmt('%s, %s, %s, %s', [v1.Name, v2.Name, v3.Name, v4.Name]); //C1, C2, C3, C30
end;

end.

posted @ 2012-01-03 22:09 万一阅读(381) 评论(2) 编辑

以接口为主导的设计中, 我在使用的框架模式

在今后的 Delphi 中, 以接口、结构为主的设计应该会越来越多, 因为这样太方便了.

System.RegularExpressions 就是以结构为主体设计的非常好的示范; 但更多东西使用接口会更合适.

有见过他人早就使用接口写程序, 从手头的这个程序开始我才开始使用.

现在基本总结出四种框架模式: 1、直接实现; 2、间接实现(或叫继承实现); 3、覆盖实现; 4、委托实现.

一、直接实现:

下例中虽有 TMy1、TMy2, 但在具体应用中使用的应是 IMy1、IMy2, 这就是我所谓的以接口为主导.
TMy1、TMy2 直接实现了所属接口的所有方法, 这是我所谓的直接实现.
这样可能会有代码重复, 但如果程序很小, 还是挺实用的.

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  end;

  IA = Interface
    procedure Method_A;
  end;

  IB = Interface(IA)
    procedure Method_B;
  end;

  IMy1 = Interface(IB)
    procedure Method_My1;
  end;

  IMy2 = Interface(IB)
    procedure Method_My2;
  end;

  TMy1 = class(TInterfacedObject, IMy1)
    procedure Method_A;
    procedure Method_B;
    procedure Method_My1;
  end;

  TMy2 = class(TInterfacedObject, IMy2)
    procedure Method_A;
    procedure Method_B;
    procedure Method_My2;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TMy1 }

procedure TMy1.Method_A;
begin
  ShowMessage('A');
end;

procedure TMy1.Method_B;
begin
  ShowMessage('B');
end;

procedure TMy1.Method_My1;
begin
  ShowMessage('My1');
end;

{ TMy2 }

procedure TMy2.Method_A;
begin
  ShowMessage('A');
end;

procedure TMy2.Method_B;
begin
  ShowMessage('B');
end;

procedure TMy2.Method_My2;
begin
  ShowMessage('My2');
end;

{测试}
procedure TForm1.FormCreate(Sender: TObject);
var
  v1: IMy1;
  v2: IMy2;
begin
  v1 := TMy1.Create;
  v1.Method_A;
  v1.Method_B;
  v1.Method_My1;

  v2 := TMy2.Create;
  v2.Method_A;
  v2.Method_B;
  v2.Method_My2;
end;

end.

二、间接实现:

下面例子通过一个间接的 TB 类, 避免了 TMy1、TMy2 中可能会重复的代码.

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  end;

  IA = Interface
    procedure Method_A;
  end;

  IB = Interface(IA)
    procedure Method_B;
  end;

  TB = class(TInterfacedObject, IB)
    procedure Method_A;
    procedure Method_B;
  end;

  IMy1 = Interface(IB)
    procedure Method_My1;
  end;

  IMy2 = Interface(IB)
    procedure Method_My2;
  end;

  TMy1 = class(TB, IMy1)
    procedure Method_My1;
  end;

  TMy2 = class(TB, IMy2)
    procedure Method_My2;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TB }

procedure TB.Method_A;
begin
  ShowMessage('A');
end;

procedure TB.Method_B;
begin
  ShowMessage('B');
end;

{ TMy1 }

procedure TMy1.Method_My1;
begin
  ShowMessage('My1');
end;

{ TMy2 }

procedure TMy2.Method_My2;
begin
  ShowMessage('My2');
end;

{测试}
procedure TForm1.FormCreate(Sender: TObject);
var
  v1: IMy1;
  v2: IMy2;
begin
  v1 := TMy1.Create;
  v1.Method_A;
  v1.Method_B;
  v1.Method_My1;

  v2 := TMy2.Create;
  v2.Method_A;
  v2.Method_B;
  v2.Method_My2;
end;

end.

三、覆盖实现:

从 TB 继承的过程中当然也可以通过覆盖虚函数而实现多态, 下面的 TMy2 就这么做了.

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  end;

  IA = Interface
    procedure Method_A;
  end;

  IB = Interface(IA)
    procedure Method_B;
  end;

  TB = class(TInterfacedObject, IB)
    procedure Method_A; virtual;
    procedure Method_B; virtual;
  end;

  IMy1 = Interface(IB)
    procedure Method_My1;
  end;

  IMy2 = Interface(IB)
    procedure Method_My2;
  end;

  TMy1 = class(TB, IMy1)
    procedure Method_My1;
  end;

  TMy2 = class(TB, IMy2)
    procedure Method_A; override;
    procedure Method_B; override;
    procedure Method_My2;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TB }

procedure TB.Method_A;
begin
  ShowMessage('A');
end;

procedure TB.Method_B;
begin
  ShowMessage('B');
end;

{ TMy1 }

procedure TMy1.Method_My1;
begin
  ShowMessage('My1');
end;

{ TMy2 }

procedure TMy2.Method_A;
begin
  ShowMessage('A_My2');
end;

procedure TMy2.Method_B;
begin
  ShowMessage('B_My2');
end;

procedure TMy2.Method_My2;
begin
  ShowMessage('My2');
end;

{测试}
procedure TForm1.FormCreate(Sender: TObject);
var
  v1: IMy1;
  v2: IMy2;
begin
  v1 := TMy1.Create;
  v1.Method_A;
  v1.Method_B;
  v1.Method_My1;

  v2 := TMy2.Create;
  v2.Method_A;
  v2.Method_B;
  v2.Method_My2;
end;

end.

四、委托实现:

接口中的方法是肯定要实现的, 但也可以通过 implements 关键字借用(或叫委托)其它的实现;
但, 官方文档说这只适用于 Win32. 就是说这种方法在 Win64 和其它系统都不行, 还学它干嘛?

posted @ 2012-01-03 18:01 万一阅读(513) 评论(1) 编辑

2011年12月31日

混合排序小练习

2011 年的最后一天了...

混合排序 -> 搅乱、重新洗牌; 以 Integer 动态数组为例.

//两个辅助函数 Swap、ToStr, 分别用于交换数组元素和呈现为字符串
procedure Swap(var Arr: TArray<Integer>; a,b: Cardinal);
var
  tmp: Integer;
begin
  if (a >= Length(Arr)) or (b >= Length(Arr)) or (a = b) then Exit;
  tmp := Arr[a];
  Arr[a] := Arr[b];
  Arr[b] := tmp;
end;

function ToStr(const Arr: TArray<Integer>): string;
var
  n: Integer;
begin
  for n in Arr do
    Result := Result + IntToStr(n) + sLineBreak;
end;
//-----------------------------------------------------------------

{1、简单反排序}
procedure SimpleShuffle(var Arr: TArray<Integer>);
var
  r,i: Integer; //分别用作随机索引、遍历索引
begin
  for i := 0 to Length(Arr) - 1 do
  begin
    r := Random(Length(Arr));
    Swap(Arr, i, r);
  end;
end;

{2、好的反排序}
procedure GoodShuffle(var Arr: TArray<Integer>);
var
  r,i: Integer;
begin
  for i := Length(Arr) - 1 downto 0 do
  begin
    r := Random(i + 1);
    if r <> i then Swap(Arr, i, r);
  end;
end;

{测试}
procedure TForm1.Button1Click(Sender: TObject);
var
  arr1,arr2: TArray<Integer>;
begin
  arr1 := TArray<Integer>.Create(0, 1, 2, 3, 4, 5, 6, 7, 8, 9); //
  arr2 := Copy(arr1);                                           //

//  SimpleShuffle(arr2);
  GoodShuffle(arr2);

  Memo1.Text := ToStr(arr1);
  Memo2.Text := ToStr(arr2);
end;

posted @ 2011-12-31 13:30 万一阅读(359) 评论(1) 编辑

2011年12月30日

使用 idHTTP 获取 UTF-8 编码的中文网页 - 回复同学 "Delphi学习者" 的问题

uses IdHTTP;

const Url = 'http://del.cnblogs.com';

procedure TForm1.Button1Click(Sender: TObject);
var
  stream: TStringStream;
  idHttpObj: TIdHTTP;
begin
  stream := TStringStream.Create('', TEncoding.UTF8); //

  idHttpObj := TIdHTTP.Create(nil);
  idHttpObj.Get(Url, stream);
  idHttpObj.Free;

  Memo1.Text := stream.DataString;
  stream.Free;
end;

posted @ 2011-12-30 20:54 万一阅读(391) 评论(4) 编辑

仅列出标题下一页

随笔分类(2496)

随笔档案(2049)

积分与排名

最新评论