1 Основная особенность: все объекты размещаются в динамической памяти. Описание класса: Type = class ( ) private protected public published automated end; Если имя родителя не указано, то им считается класс TObject. Глава 9 Объектная модель Delphi Pascal 9.1 Описание класса Delphi

2 Переменные класса являются ссылками. В отличие от указателей операция разыменования при работе с ними не используется. Конструктор Create и деструктор Destroy класса должны содержать вызов конструктора и деструктора TObject, которые обеспечивают выделение и освобождение памяти: Constructor.Create; begin inherited Create;... end; Destructor Destroy; override;{деструктор виртуальный!} Destructor.Destroy; begin... inherited Destroy; end; Конструктор и деструктор

3 Type pTNum = ^TNum; TNum = Object n: integer; procedure Init (an:integer); end; Procedure TNum.Init; begin n:=an; end;... Var p:pTNum; Begin New(p, Init(5)); WriteLn(p^.n); Dispose(p); End. Сравнение объектных моделей Type TNum = class public n:integer; constructor Create (an:integer); end; Constructor TNum.Create; begin inherited Create; n:=an; end;... Var A:TNum;... A:=TNum.Create(5); WriteLn(A.n); A.Destroy;... Простая модель Модель VCL

4 Var A, B:TNum; A:=TNum.Create; B:=A; B.Destroy; A.n:=3; {!!!} Особенности работы с объектами

5 1) виртуальные методы: procedure Print;virtual; { в базовом класса } procedure Print;override; { в производном классе } 2) динамические – вызываются через таблицу динамических методов, которая в отличие от ТВМ содержит только адреса методов, переопределенных в данном классе: procedure Print;dynamic; { в базовом класса } procedure Print;override; { в производном классе } 3) абстрактные методы: procedure Print;virtual;abstract; { в базовом класса } procedure Print;override; { в производном классе } Класс, содержащий абстрактные методы, называется абстрактным. Объекты абстрактного класса создавать не разрешается. 9.2 Особенности переопределения методов

6 Отличие динамических методов от виртуальных

7 Три составляющих движения объекта на плоскости 1 Перемещение x1 = x + dx, y1 = y + dy 2 Масштабирование относительно точки C (xc, yc): x1 = (x - xc)*Mx +xc, y1 = (y - yc)*My +yc 3 Поворот относительно точки С(xc, yc): x1 = (x - xc)cos + + (y - yc)sin + xc, y1 = (y - yc)cos - - (x - xc)sin + yc

8 Вращение фигур (Ex9_01)

9 Объектная декомпозиция h*sin h h*cos (x,y) dx = h*cos dy = h*sin Главное окно Активизировать Линия Создать Перерисовать Квадрат Создать Перерисовать Шарик Создать Перерисовать

10 Диаграмма классов предметной области TObject TFigure -x,y,halflen, -dx,dy, -Image -Draw() -Rel() +Create() +Move() TLine -Draw() TSquare -Draw() TCircle - r +Create() -Draw()

11 Модуль Figure Unit Figure; Interface Uses graphics,ExtCtrls; Type TFigure=Class x,y, halflen,dx,dy:integer; Image:TImage; constructor Create(ax,ay,ah:integer;aImage:TImage); procedure Move(t:single); procedure Draw;virtual;abstract; procedure Rel(t:real); end; TLine=Class(TFigure) procedure Draw;override; end; TSquare=Class(TFigure) procedure Draw;override; end; TCircle=Class(TFigure) r:integer; constructor Create(ax,ay,ah,ar:integer; aImage:TImage); procedure DRAW;override; end;

12 Модуль Figure (2) Implementation Constructor TFigure.Create; Begin inherited Create; x:=ax; y:=ay; halflen:=ah; Image:=aImage; End; Procedure TFigure.Rel; Begin dx:=round(halflen*cos(t)); dy:=round(halflen*sin(t)); End; Procedure TFigure.Move; Begin Image.Canvas.Pen.Color:=clWhite; Draw; Image.Canvas.Pen.Color:=clBlack; Rel(t); Draw; End;

13 Модуль Figure (3) Procedure TLine.Draw; Begin Image.Canvas.MoveTo(x+dx,y+dy); Image.Canvas.LineTo(x-dx,y-dy); End; Procedure TSquare.Draw; Begin Image.Canvas.MoveTo(x+dx,y+dy); Image.Canvas.LineTo(x-dy,y+dx); Image.Canvas.LineTo(x-dx,y-dy); Image.Canvas.LineTo(x+dy,y-dx); Image.Canvas.LineTo(x+dx,y+dy); End; Constructor TCircle.Create; Begin inherited Create(ax,ay,ah,aImage); r:=ar; End; Procedure TCircle.Draw; Begin Image.Canvas.Ellipse(x+dx+r,y+dy+r,x+dx-r,y+dy-r); End; end. (x,y) (x+dx,y+dy) (x-dx,y-dy) (x,y) (x+dx,y+dy) (x-dx,y-dy) (x-dy,y+dx) (x+dy, y-dx)

14 Процедура организации движения procedure TMainForm.BeginButtonClick(Sender: TObject); begin L:=TLine.Create(60,100,50,Image); S:=TSquare.Create(180,100,50,Image); C:=TCircle.Create(300,100,50,10,Image); repeat L.Move(t); S.Move(-0.2*t); C.Move(0.5*t); t:=t+0.01; Application.ProcessMessages;{ проверить очередь! } until not Moving; Close; end; procedure TMainForm.EndButtonClick(Sender: TObject); begin Moving:=false; end;

15 Свойство - это средство Pascal Delphi, позволяющее определять интерфейс доступа к полям и методам класса. В Delphi различают: простые или скалярные свойства; свойства-массивы; индексируемые свойства или свойства со спецификацией index; процедурные свойства. 9.3 Свойства

16 Используются для ограничения доступа к полю и при необходимости выполнения дополнительных действий при чтении и записи. Property : [read ] [write ] [stored ] [default ]; read - если метод чтения не определен, то свойство не доступно для чтения; write - если метод записи не определен, то свойство не доступно для записи; stored – для опубликованных свойств – хранить ли значение в файле формы.dfm; default - – для опубликованных свойств – значение по умолчанию. Простые свойства

17 Пример: private FValue:integer; procedure SetValue(AValue:integer); function StoreValue:boolean; published property Value:integer read FValue write SetValue stored StoreValue default 10;... Обращение в программе: A.Value := n; {A.SetValue(n);} K := A.Value; {K := A.FValue;} Простые свойства (2)

18 Примитивный графический редактор

19 Объектная декомпозиция Активизировать

20 Диаграмма классов предметной области

21 Unit Figure; Interface Uses extctrls,Graphics; Type TMyFigure=class private x,y,FRadius:Word; FColor:TColor; Image:TImage; procedure Clear; procedure SetSize(ar:word); procedure SetColor(aColor:TColor); public Constructor Create(aImage:TImage; ax,ay,ar:Word;aColor:TColor); Procedure Draw; virtual; abstract; Property Radius:Word write SetSize; Property Color:TColor write SetColor; end; Модуль Figure

22 TMyCircle=class(TMyFigure) public Procedure Draw; override; end; TMySquare=class(TMyFigure) public Procedure Draw; override; end; Implementation Constructor TMyFigure.Create; Begin inherited Create; Image:=aImage; x:=ax; y:=ay; FRadius:=ar; FColor:=aColor; Draw; End; Модуль Figure (2)

23 Procedure TMyFigure.Clear; Var TempColor:TColor; Begin TempColor:=FColor; FColor:=Image.Canvas.Brush.Color; Draw; FColor:=TempColor; End; Procedure TMyFigure.SetSize; Begin Clear; FRadius:=ar; Draw; End; Procedure TMyFigure.SetColor; Begin Clear; FColor:=aColor; Draw; End; Модуль Figure (3)

24 Procedure TMyCircle.Draw; Begin Image.Canvas.Pen.Color:=FColor; Image.Canvas.Ellipse(x-FRadius,y-FRadius, x+FRadius,y+FRadius); End; Procedure TMySquare.Draw; Begin Image.Canvas.Pen.Color:=FColor; Image.Canvas.Rectangle(x-FRadius, y-FRadius, x+FRadius,y+FRadius); End; End. Модуль Figure (4)

25 unit Main; interface uses Windows,Messages,SysUtils,Variants,Classes,Graphics, Controls,Forms,Dialogs,ComCtrls, StdCtrls, ExtCtrls; type TMainForm = class(TForm) Image: TImage; ColorButton: TButton; ExitButton: TButton; RadioGroup: TRadioGroup; rLabel: TLabel; rEdit: TEdit; UpDown: TUpDown; ColorDialog: TColorDialog; Модуль Main

26 procedure FormActivate(Sender: TObject); procedure ImageMouseDown(Sender: TObject;… ); procedure UpDownClick(Sender: TObject; …); procedure ColorButtonClick(Sender: TObject); procedure ExitButtonClick(Sender: TObject); end; var MainForm: TMainForm; implementation uses Figure; Var C:TMyFigure; {$R *.dfm} procedure TMainForm.FormActivate(Sender: TObject); begin Image.Canvas.Brush.Color:=clWhite; Image.Canvas.Pen.Color:=clBlack; end; Модуль Main (2)

27 procedure TMainForm.ImageMouseDown(Sender: TObject; Button:TMouseButton;Shift:TShiftState;X,Y:Integer); begin if Button=mbLeft then case RadioGroup.ItemIndex of 0: begin C.Free; C:=TMyCircle.Create(Image,X,Y, strtoint(rEdit.Text),Image.Canvas.Pen.Color); end; 1: begin C.Free; C:=TMySquare.Create(Image,X,Y, strtoint(rEdit.Text),Image.Canvas.Pen.Color); end; Модуль Main (3)

28 procedure TMainForm.UpDownClick(Sender: TObject; Button: TUDBtnType); begin if C<>nil then C.Radius:=strtoint(rEdit.Text); end; procedure TMainForm.ColorButtonClick(Sender: TObject); begin if ColorDialog.Execute then Image.Canvas.Pen.Color:=ColorDialog.Color; if C<>nil then C.Color:=Image.Canvas.Pen.Color; end; procedure TMainForm.ExitButtonClick(Sender: TObject); begin Close; end; initialization finalization C.Free; end. Модуль Main (4)

29 property : [read ] [write ] [default]; Список параметров методов чтения и записи должен включать все указанные индексные параметры в том же порядке. Параметр- значение в методе записи при этом указывается в конце списка. default – означает, что описанное с ним свойство является свойством «по умолчанию», которое можно не указывать при обращении. Пример: private function GetValMas(I:word;F:double):word; procedure SetValMas(I:word;F:double;AElement:word); public prorerty ValMas[I:word, F:double]:word read GetValMas write SetValMas; default; … A.ValMas[5,3.1] = = A[5,3.1] Свойства-массивы

30 Реализация множества на динамическом массиве с использованием свойства-массива

31 Unit SetofInt; interface uses Dialogs, SysUtils, Grids; Type aset=array[byte] of byte; TSetInt = class(TObject) private ptr_an: ^aset; len:byte; procedure SetEl(Ind:byte;m:byte); function GetEl(Ind:byte):byte; public n:byte; Структура данных динамический массив ptr_n len n TObject TSetInt -ptr_n -len +n +Create() +Destroy() -SetEl() -GetEl() +Add() +Del() +InMas() +InSet() +OutSet() +Union() +Cross() +Addition()

32 constructor Create(an:byte); destructor Destroy;override; function InSet(Grid:TStringGrid;I,J:integer; Nn:byte):boolean; procedure OutSet(Grid:TStringGrid; I,J:integer); procedure Clear; procedure Add(m:byte); procedure Del(m:byte); Function InMas(m:byte):boolean; procedure Union(b:TSetInt); {объединение} procedure Cross(b:TSetInt); {пересечение} procedure Addition(b:TsetInt); {дополнение} property Mas[Ind: byte]:byte read GetEl write SetEl;default; end; Динамический массив (2)

33 Динамический массив (3) Function Union(a,b:TSetInt):TSetInt; Function Cross(a,b:TSetInt):TSetInt; Function Addition(a,b:TSetInt):TSetInt;

34 implementation Constructor TSetInt.Create; begin inherited Create; GetMem(ptr_an,an); len:=an; n:=0; end; Destructor TSetInt.Destroy; begin FreeMem(ptr_an); inherited Destroy; end; Динамический массив (4)

35 procedure TSetInt.SetEl(Ind:byte;m:byte); Begin if Ind<=len then ptr_an^[Ind]:=m else Begin MessageDlg('Не хватает места для элемента.',...); Halt(1); End; function TSetInt.GetEl(Ind:byte):byte; Begin if Ind<=n then Result:=ptr_an^[Ind] else begin MessageDlg('Индекс выходит за границы множества.',...); Halt(1); end; End; Динамический массив (5)

36 procedure TSetInt.Add(m:byte); begin if not InMas(m) then if n<len then begin n:=n+1; mas[n]:=m; end; Function TSetInt.InMas(m:byte):boolean; Var i:byte; begin i:=1; while(i mas[i]) do i:=i+1; if i<=n then Result:=true else Result:=false; end;... Динамический массив (6)

37 Динамический массив (7) procedure TSetInt.Del(m:byte); Var i:byte; h:boolean; Begin if InMas(m) then begin h:=false; for i:=1 to n do if h then Mas[i-1]:=Mas[i] else if m=Mas[i] then h:=true; n:=n-1; end; End;

38 Динамический массив (8) function TSetInt.InSet(Grid:TStringGrid;I,J:integer; Nn:byte):boolean; Var k:byte; s:string; x,er_code:integer; begin k:=0; Result:=true; while (Grid.Cells[k+I,J]<>'')and Result do begin s:=Grid.Cells[k+I,J]; Val(s,x,er_code); if er_code=0 then if x<=Nn then if not InMas(x) then Add(x) else begin MessageDlg(В строке обнаружено дублирование.', mtInformation, [mbOk], 0); Result:=false; end

39 Динамический массив (9) else begin MessageDlg('Значение превышает максимальное.', mtInformation, [mbOk], 0); Result:=false; end else begin MessageDlg('В строке недопустимые символы.', mtInformation, [mbOk], 0); Result:=false; end; k:=k+1; end; if (n=0) and Result then begin MessageDlg('Вводимое множество пусто.', mtInformation, [mbOk], 0); Result:=false; end; if Result then OutSet(Grid,I,J,c); end;

40 Динамический массив (10) procedure TSetInt.OutSet(Grid:TStringGrid;I,J:integer); Var k:byte; Begin with Grid do begin if n > ColCount-I then ColCount:=n+I; for k:=1 to ColCount do if k<=n then Cells[I+k-1,J]:=c+inttostr(mas[k]) else Cells[I+k-1,J]:=''; end; End; procedure TSetInt.Clear; Begin n:=0; End;

41 Динамический массив (11) Procedure TSetInt.Union(b:TSetInt); Var i:byte; Begin for i:=1 to b.n do Add(b.mas[i]); End; Procedure TSetInt.Cross(b:TSetInt); Var i:byte; Begin for i:=1 to n do if not b.InMas(mas[i]) then Del(mas[i]); End; Procedure TSetInt.Addition(b:TsetInt); Var i:byte; Begin for i:=1 to n do if b.InMas(mas[i]) then Del(mas[i]); End;

42 Динамический массив (12) Function Union(a,b:TSetInt):TSetInt; Var i:byte; Begin Result:=TSetInt.Create(a.len+b.len); for i:=1 to b.n do Result.Add(b.mas[i]); for i:=1 to a.n do Result.Add(a.mas[i]); End; Function Cross(a,b:TSetInt):TSetInt; Var i:byte; Begin if a.len>b.len then Result:=TSetInt.Create(b.len) else Result:=TSetInt.Create(a.len); for i:=1 to a.n do if b.InMas(a.mas[i]) then Result.Add(a.mas[i]); End;

43 Динамический массив (13) Function Addition(a,b:TSetInt):TSetInt; Var i:byte; Begin Result:=TSetInt.Create(a.len); for i:=1 to a.n do begin if not b.InMas(a.mas[i]) then Result.Add(a.mas[i]); end; End; end.

44 Динамический массив. Main unit MainForm; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, ExtCtrls; type TForm1 = class(TForm) StringGrid1: TStringGrid; Comment: TLabel; ExitButton: TButton; RadioGroup1: TRadioGroup; DataButton: TButton; procedure FormActivate(Sender: TObject); procedure StringGrid1KeyPress(Sender:TObject; var Key:Char); procedure RadioGroup1Click(Sender: TObject); procedure DataButtonClick(Sender: TObject); procedure ExitButtonClick(Sender: TObject); end; var Form1: TForm1;

45 Динамический массив. Main (2) implementation {$R *.DFM} uses SetOfInt; var a,b,c:TSetInt; procedure TForm1.FormActivate(Sender: TObject); begin StringGrid1.Cells[0,0]:='A'; StringGrid1.Cells[0,1]:='B'; StringGrid1.Cells[0,2]:=Итого'; StringGrid1.Enabled:=true; StringGrid1.SetFocus; Comment.Caption:=Введите A и B. Завершение ввода - Enter'; DataButton.Enabled:=false; RadioGroup1.Enabled:=false; RadioGroup1.ItemIndex:=-1; end;

46 Динамический массив. Main (3) procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char); begin if Key=#13 then begin a.Clear; b.Clear; if a.InSet(StringGrid1,1,0,100) And b.InSet(StringGrid1,1,1,100) then begin Key:=#0; StringGrid1.Enabled:=false; DataButton.Enabled:=true; RadioGroup1.Enabled:=true; RadioGroup1.SetFocus; end end;

47 Динамический массив. Main (4) procedure TForm1.RadioGroup1Click(Sender: TObject); begin case RadioGroup1. ItemIndex of 0: begin Comment.Caption:=RadioGroup1.Items[0]+' A и B'; c.Free; c:=Union(a,b); c.OutSet(StringGrid1,1,2); end; 1: begin Comment.Caption:=RadioGroup1.Items[1]+' A и B'; c.Free; c:=Cross(b,a); c.OutSet(StringGrid1,1,2); end; 2: begin Comment.Caption:=RadioGroup1.Items[2]+' B до A'; c.Free; c:=addition(a,b); c.OutSet(StringGrid1,1,2); end;

48 Динамический массив. Main (5) procedure TForm1.DataButtonClick(Sender: TObject); var i:word; begin c.Free; c:=nil; for i:=1 to StringGrid1.ColCount-1 do StringGrid1.Cells[i,2]:=''; FormActivate(DataButton); end; procedure TForm1.ExitButtonClick(Sender: TObject); begin Close; end; initialization a:=TSetInt.Create(10); b:=TSetInt.Create(10); finalization a.Destroy; b.Destroy; c.Free; end.

49 property : index read write ; где - целое число типа ShortInt. Type CMas=class private FMasEl:array[1..3] of word; function GetEl(Ind:byte):word; procedure SetEl(Ind:byte;AElement:word); public property Element1:word index 1 read GetEl write SetEl; property Element2:word index 2 read GetEl write SetEl; property Element3:word index 3 read GetEl write SetEl; end; Function CMas. GetEl; Begin Result:=FMasEl[Ind]; End; Procedure CMas. SetEl; Begin FMasEl[Ind]:=AElement; End; Индексируемые свойства

50 Метакласс – тип, значением переменных которого являются классы, принадлежащие определенной иерархии. Type = class of ; В Delphi стандартно определен метакласс TClass : Type TClass = class of TObject; Пример: Var c:TClass; d:TObject;... c := TButton; d := c.Create(...); 9.4 Метаклассы

51 Операция is используется для проверки принадлежности объекта заданной иерархии классов. is - возвращает true, если объект принадлежит классу, и false - в противном случае. Примеры: if Sender is TEdit then... if A is TMas then TMas(A).Run; Операция as используется для безопасного нисходящего преобразования типа объекта. Если тип объекта не совпадает формируется исключение. Пример: (A as TMas).Run; Операции is и as

52 Контейнер

53 Диаграмма классов основы контейнера

54 Unit Spisok; Interface Type TElement=Class(TObject) public pre,suc:TElement; end; TSpisok=Class(TObject) public first,last,cur:TElement; destructor Destroy;override; procedure Add(e:TElement); function Del:TElement; end; Модуль основы контейнера

55 Implementation Procedure TSpisok.Add; Begin if first=nil then begin first:=e; last:=e; end else begin e.suc:=first; first.pre:=e; first:=e; end; End; Модуль основы контейнера (2)

56 Function TSpisok.Del; Begin Del:=last; if last<>nil then begin last:=last.pre; if last<>nil then last.suc:=nil; end; if last=nil then first:=nil; End; Destructor TSpisok.Destroy; var v:TElement; Begin v:=Del; while v<>nil do begin v.Destroy; v:=Del; end; inherited Destroy; End; End. Модуль основы контейнера (3)

57 Построение контейнера

58 unit Cont; interface uses Spisok; Type TNumber=Class(TElement) public Num:integer; constructor Create(aNum:integer); end; TStr=Class(TElement) public MyString:shortstring; constructor Create(aMyString:string); end; TMySpisok=Class(TSpisok) public Function Summ:Integer; end; Модуль контейнера

59 implementation Constructor TNumber.Create; begin inherited Create; Num:=aNum; end; Constructor TStr.Create; begin inherited Create; MyString:=aMyString; end; Function TMySpisok.Summ; Begin cur:=first; Result:=0; while cur<>nil do begin if cur is TNumber then Result:=Result+(cur as TNumber).Num; cur:=cur.suc end; End; end. Модуль контейнера (2)

60 Модуль формы. Секция реализации implementation uses Cont, Spisok; var S:TMySpisok; {$R *.DFM} procedure TMainForm.FormActivate(Sender: TObject); begin IOLabel.Visible:=false; IOEdit.Visible:=false; end; procedure TMainForm.AddButtonClick(Sender: TObject); begin IOLabel.Visible:=true; IOEdit.Visible:=true; IOEdit.SetFocus; end;

61 procedure TMainForm.IOEditKeyPress(Sender: TObject; var Key: Char); var I, Code: Integer; v:TElement; begin if Key=#13 then begin Key:=#0; Listbox1.Items.Add(IOEdit.Text); Val(IOEdit.Text, I, Code); if Code = 0 then v:=TNumber.Create(I) else v:=TStr.Create(IOEdit.Text); S.Add(v); AddButton.SetFocus; IOLabel.Visible:=false; IOEdit.Visible:=false; end; Создание и добавление элементов

62 Удаление и уничтожение элементов procedure TMainForm.DelButtonClick(Sender: TObject); var v:TElement; begin IOLabel.Visible:=true; IOEdit.Visible:=true; v:=S.Del; if v<>nil then begin ListBox1.Items.Delete(0); if v is TNumber then IOEdit.Text:=inttoStr((v as TNumber).num) else IOEdit.Text:=(v as TStr).MyString; v.Destroy; end else IOEdit.Text:=Список пуст.'; end;

63 Суммирование и завершение procedure TMainForm.SumButtonClick(Sender: TObject); begin IOLabel.Visible:=false; IOEdit.Visible:=false; Application.MessageBox(Pchar(IntToStr(S.Summ)), Сумма чисел:',MB_OK); end; procedure TMainForm.ExitButtonClick(Sender: TObject); begin Close; end; initialization S:=TMySpisok.Create; finalization S.Destroy; end.

64 Методы класса – методы, которые не получают указателя на поля объекта Self и потому могут быть вызваны с указанием имени класса вместо имени объекта. Type MyClass=class(TObject) public class procedure ( );... end; Методы класса используют для обращения к RTTI (Run Time Type Information – Информация о типе времени выполнения). 9.5 Методы класса. RT T I

65 class function ClassName: ShortString - возвращает имя класса; class function ClassNameIs(const Name: string): Boolean - возвращает true, если имя класса совпадает с указанным в параметре; class function ClassParent: TClass - возвращает объектную ссылку на предка; class function ClassInfo: Pointer - возвращает указатель на таблицу RTTI класса; class function InstanceSize: Longint - возвращает размер экземпляра объекта; class function InheritsFrom(AClass: TClass): Boolean - проверяет, наследуется ли данный класс от указанного; class function MethodAddress(const Name: ShortString): Pointer - возвращает адрес метода по его имени; class function MethodName(Address: Pointer): ShortString - возвращает имя метода по его адресу. Методы класса для класса TObject

Процедурные свойства. Делегирование методов Type TMyMetod = function(ax:integer):word of object; TMyClass=class private FMetod:TMyMetod; public property Metod:TMyMetod read FMetod write FMetod; end; Процедурные свойства используют для организации делегирования методов – подключение методов этого или других классов. Различают: а) статическое делегирование – подключение выполняется на этапе компиляции; б) динамическое делегирование – подключение выполняется во время выполнения программы – реализуется изменение поведения объекта.

67 Примитивный графический редактор ( 2-й вариант )

68 Unit Figure; interface Uses extctrls,Graphics; Type TDProc=procedure of object; TMyFigure=class private x,y,FRadius:word; FColor:TColor; Image:TImage; FDraw:TDProc; procedure SetSize(ar:word); procedure SetColor(aColor:TColor); public Constructor Create(aImage:TImage; ax,ay,ar:Word;aColor:TColor); property Draw:TDProc read FDraw write FDraw; Property Radius:Word write SetSize; Property Color:TColor write SetColor; Procedure Clear; Procedure DrawCircul; Procedure DrawSquare; end; Модуль Figure

69 Implementation... Procedure TMyFigure.Clear; Begin Image.Canvas.Pen.Color:=clWhite; Draw; Image.Canvas.Pen.Color:=FColor; End; Procedure TMyFigure.DrawCircul; Begin Image.Canvas.Ellipse(x-FRadius,y-FRadius, x+FRadius,y+FRadius); End; Procedure TMyFigure.DrawSquare; Begin Image.Canvas.Rectangle(x-FRadius,y-FRadius, x+FRadius,y+FRadius); End;... End. Модуль Figure (2)

70 procedure TMainForm.ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,Y: Integer); begin C.Free; C:=TMyFigure.Create(Image,X,Y, strtoint(rEdit.Text),Image.Canvas.Pen.Color); if Button=mbLeft then case RadioGroup.ItemIndex of 0: C.Draw:=C.DrawCircul; 1: C.Draw:=C.DrawSquare; end; C.Draw; end; Рисование фигуры

Исключения Механизм исключений предполагает автоматическое формирование специального блока информации при обнаружении аварийной ситуации. Достоинства позволяет группировать обработку ошибок в том месте, где возможно принятие решения об ее устранении: Традиционный подход: if n<>0 then x:=A/n else <Действие по устранению ошибки> Механизм исключений: try x:=A/n; except on EDivbyZero do <Действие по устранению ошибки> end; try... except ? Объект A Объект B

72 Исключение – класс, объект которого создается при возникновении исключительной ситуации. Все классы исключений наследуются от класса Exception: Type Exception = class(TObject) private FMessage: string; FHelpContext: Integer; public Constructor Create(const Msg: string); Constructor CreateFmt(const Msg: string; const Args: array of const);... property HelpContext: Integer read FHelpContext write FHelpContext; property Message: string read FMessage write FMessage; {строка сообщения} end; Классы исключений

73 Основное назначение класса исключения - идентификация групп ошибок, например: EDivByZero = class(EIntError); {деление на ноль в целочисленной арифметике} ERangeError = class(EIntError); {обращение элементам массива по несуществующим индексам} EIntOverflow = class(EIntError); {переполнение в целочисленной арифметике} EMathError = class(EExternal); {ошибки арифметики с плавающей точкой} EInvalidOp = class(EMathError); {неверный операнд) EZeroDivide = class(EMathError); {деление на ноль в арифметике с плавающей точкой} EOverflow = class(EMathError); {переполнение в арифметике с плавающей точкой} EUnderflow = class(EMathError); {исчезновение порядка в арифметике с плавающей точкой} Классы исключений (2)

74 Генерация и обработка исключений Исключения могут генерироваться автоматически (при обнаружении той или иной аварийной ситуации операционной системой) и программно (по мере надобности): if n=0 then raise EDivByZero.Create('Количество отрезков = 0.'); Оператор обработки исключений: try except on do ;... on do ; else end;

75 Класс «Динамический массив» type TMas=array[1..255] of byte; TMasByte = class(TObject) private ptr_an: ^TMas; len:byte; Name:string; procedure SetEl(Ind:byte;m:byte); function GetEl(Ind:byte):byte; public n:Byte; constructor Create(an:byte;aName:string); destructor Destroy;override; property Mas[Ind: byte]:byte read GetEl write SetEl;default; procedure Modify(Ind:byte;Value:byte); procedure Insert(Ind:byte;Value:byte); function Delete(Ind:byte):byte; function InputMas(Grid:TStringGrid; I,J:integer):boolean; procedure OutputMas(Grid:TStringGrid;I,J:integer); end; EInputError=class(Exception);

76 Методы чтения и записи procedure TMasByte.SetEl(Ind:byte;m:byte); Begin if Ind<=len then if Ind<=n then ptr_an^[Ind]:=m else raise ERangeError.CreateFmt (В массиве %s нет %d-го элемента.',[Name,Ind]) else raise ERangeError.CreateFmt (В массиве %s не более %d элементов.',Name,Len]); End; function TMasByte.GetEl(Ind:byte):byte; Begin if Ind<=n then Result:=ptr_an^[Ind] else raise ERangeError.CreateFmt (В массиве %s нет %d-го элемента.',[Name,Len]); End;

77 Метод ввода множества из таблицы function TMasByte.InputMas(Grid:TStringGrid; I,J:integer):boolean; Var k:byte; x,er_code:integer; begin k:=0; Result:=true; while (Grid.Cells[k+I,J]<>'')and Result do begin Val(Grid.Cells[k+I,J],x,er_code); if er_code=0 then if x<=255 then Insert(k+1,x) else begin raise EInputError.Create (Значение не должно превыщать 255.'); end else begin raise EInputError.Create (В строке обнаружены недопустимые символы.'); end; k:=k+1; end; OutputMas(Grid,I,J); end;

78 Создание и ввод массива procedure TMainForm.StringGridKeyPress(Sender: TObject; var Key: Char); begin if Key=#13 then begin Key:=#0; A.Free; A:=TMasByte.Create(10,'A'); try A.InputMas(StringGrid,0,0); StringGrid.Options:= [goFixedVertLine,goFixedHorzLine, goVertLine,goHorzLine]; Comment.Caption:=''; except on E:EInputError do MessageDlg(E.Message,mtInformation,[mbOk],0); end; end end;

79 Функция проверки введенных значений var A:TMasByte; function InputByte(Str:string; Mes:string; Var Value:byte):boolean; var Code:integer; begin Result:=false; Val(str,Value,Code); if Code=0 then Result:=true else MessageDlg(Значение введено неверно'+Mes, mtInformation, [mbOk], 0); end;

80 Модификация значений procedure TMainForm.ModefyButtonClick(Sender: TObject); var Ind,Value:byte; begin If InputByte(IndexEdit.Text,' индекса',Ind) and InputByte(ValueEdit.Text,' элемента',Value) then try A[Ind]:=Value; except on E:ERangeError do MessageDlg(E.Message,mtInformation, [mbOk], 0); end; A.OutputMas(StringGrid,0,0); end;

81 Завершающая обработка исключений try finally end ;

Организация VCL Обеспечивает корректную работу инспектора объектов Обеспечивает отношение «основной-вспомогательный» Обеспечивает обработку сообщений мыши Могут получать фокус ввода, обеспечивают отношение «старший- младший» Не могут получать фокус ввода, используются для отображения информации

83 Отношения «основной-вспомогательный» Основной компонент отвечает за управление памятью: выделение памяти для размещения вспомогательных компонентов при его создании и освобождение – при его уничтожении. Это отношение «контейнер-элемент». Оно реализуется свойствами: 1) Owner – содержит указатель на основной компонент для каждого вспомогательного компонента; 2) ComponentIndex – содержит номер вспомогательного компонента в массиве Components (начиная с 0) и определяет порядок создания и отображения компонентов; 3) Components[Index]- свойство-массив типа TComponent, которое содержит указатели на все вспомогательные компоненты; 4) ComponentCount – содержит количество вспомогательных компонентов.

84 Отношение «старший-младший» Отношение определяет подчиненность изображений оконных компонентов: если старший компонент становится невидимым, то становятся невидимыми и все его младшие компоненты. Отношение реализуется свойствами: 1) Parent – содержит указатель на старший элемент управления; 2) ControlIndex – содержит номер текущего элемента управления в массиве, который определяет порядок передачи фокуса по Tab; 3) Controls[Index] – свойство-массив типа TControl, которое содержит указатели на все младшие элементы управления; 4) ControlCount – содержит количество младших элементов управления для текущего старшего. Для управления единообразием используются: 1) ParentColor:boolean – будут ли использоваться цвета старшего компонента или элемент сам определит свои цвета; 2) ParentFont -... шрифт.. и т.д.

85 Отношение «старший-младший» (2) Методы и свойства управления фокусом ввода: 1) TabOrder – определяет порядок передачи фокуса ввода при нажатии клавиши Tab ; 2) SetFocus – устанавливает фокус ввода на компонент; 3) FindNextControl – возвращает следующий элемент в цепочке, установленной TabOrder; 4) Enable – определяет может ли данный элемент принимать фокус ввода; 5) ActiveControl – в родительском компоненте определяет компонент, который в настоящий момент имеет фокус ввода.

86 Пример Ex_9_8. Использование отношения «старший-младший»

87 Диаграмма состояний интерфейса Ввод данных Вывод результата Ошибка! Нормальный процесс С0 С5[ошибка ввода] С2 С1[ошибок нет] С3 С4 С0 – активация формы ( FormActivate ); С1 – нажатие кнопки ExButton(ExButtonClick) ; С2 – нажатие кнопки Следующий ( NextButtonClick ) C3 – нажатие кнопки Ok сообщения об ошибке; С4 – нажатие кнопки Выход ( ExitButtonClick ); С5 – нажатие клавиши Enter ( AllEditKeyPress ). С5 [ошибок нет]

88 Диаграмма классов интерфейса TForm TMainForm FormActivate() AllEditKeyPress() ExButtonClick() NextButtonClick() ExitButtonClick() TLabel TEdit TBevel TButton

89 Модуль MainUnit unit MainUnit; interface uses Windows, Messages, SysUtils, Classes,... type TMainForm = class(TForm) Bevel1: TBevel; InputLabel: TLabel; ALabel: TLabel; BLabel: TLabel; CLabel: TLabel; DLabel: TLabel; AxEdit: TEdit; AyEdit: TEdit; BxEdit: TEdit; ByEdit: TEdit; CxEdit: TEdit; CyEdit: TEdit; DxEdit: TEdit; DyEdit: TEdit; NextButton: TButton; ExitButton: TButton; ExButton: TButton; ResLabel: TLabel; ResultLabel: TLabel;x1Label:TLabel;y1Label:TLabel; x2Label: TLabel; y2Label: TLabel; procedure AllEditKeyPress(Sender: TObject; var Key: Char); procedure FormActivate(Sender: TObject); procedure ExButtonClick(Sender: TObject); procedure NextButtonClick(Sender: TObject); procedure ExitButtonClick(Sender: TObject); end; var MainForm: TMainForm;

90 Модуль MainUnit (2) implementation Var K:array[1..8] of Double; {$R *.DFM} procedure TMainForm.FormActivate(Sender: TObject); Var i:integer; begin for i:=0 to ControlCount-1 do if Controls[i] is TEdit then begin Controls[i].Enabled:=true; (Controls[i] as TEdit).ReadOnly:=false; end; ExButton.Visible:=true; NextButton.Enabled:=false; ResLabel.Visible:=false; ResultLabel.Visible:=false; AxEdit.SetFocus; end;

91 Модуль MainUnit (3) procedure TMainForm.AllEditKeyPress(Sender: TObject; var Key: Char); Var Code:integer; S:string; begin if Key=#13 then begin Key:=#0; Val((ActiveControl as Tedit).Text, K[(ActiveControl as Tedit).Tag],Code); if Code<>0 then begin S:=chr(ord('A')+ActiveControl.TabOrder div 2); MessageDlg(Координаты '+S+' введены неверно.', mtError,[mbOk], 0); exit; end; FindNextControl(ActiveControl,true,false,false). SetFocus; end end;

92 Модуль MainUnit (4) procedure TMainForm.ExButtonClick(Sender: TObject); Var Code,i,j:integer; PP:TEdit; S,S1:string; l,q:array[1..4] of double; tr:array[1..4] of boolean; t:double; begin for i:=0 to ControlCount-1 do if Controls[i] is TEdit then Controls[i].Enabled:=true; PP:=AxEdit; for i:=1 to 8 do begin Val(PP.Text,K[PP.Tag],Code); if Code<>0 then begin S:=chr(ord('A')+PP.TabOrder div 2); PP.SetFocus; MessageDlg(Координаты '+S+' введены неверно.', mtError,[mbOk], 0); exit; end; if i<>8 then PP:=FindNextControl( PP,true,false,true ) as TEdit; end;

93 Модуль MainUnit (5) for i:=1 to 3 do for j:=i+1 to 4 do if (K[2*i-1]=K[2*j-1])and(K[2*i]=K[2*j]) then begin S:=chr(ord('A')+i-1); S1:=chr(ord('A')+j-1); MessageDlg('Координаты '+S+' совпадают с координатами '+S1+'.', mtError,[mbOk], 0); exit; end; PP:=AxEdit; for i:=1 to 8 do begin PP.Enabled:=false; PP.ReadOnly:=true; if i<>8 then PP:=FindNextControl(PP,true,false,true) as TEdit; end;

94 Модуль MainUnit (6) ResLabel.Visible:=true; ResultLabel.Visible:=true; ExButton.Visible:=false; NextButton.Enabled:=true; for i:=1 to 4 do begin if i<>4 then begin l[i]:=sqrt(sqr(k[2*(i+1)-1]-k[2*i-1])+ sqr(k[2*(i+1)]-k[2*i])); t:=(k[2*(i+1)-1]-k[2*i-1]); if t<>0 then begin q[i]:=-(k[2*(i+1)]-k[2*i])/t; tr[i]:=true; end else begin q[i]:=0; tr[i]:=false; end end

95 Модуль MainUnit (7) else begin l[4]:=sqrt(sqr(k[1]-k[7])+sqr(k[2]-k[8])); t:=(k[1]-k[7]); if t<>0 then begin q[4]:=-(k[2]-k[8])/t; tr[4]:=true; end else begin q[4]:=0; tr[4]:=false; end end;

96 Модуль MainUnit (8) if ((q[1]=q[3])and(tr[1]=tr[3]))or ((q[2]=q[4])and(tr[2]=tr[4])) then if (q[1]=q[3])and(tr[1]=tr[3])and (q[2]=q[4])and(tr[2]=tr[4]) then if (q[1]*q[2]=-1.0)or((q[1]=0)and (q[2]=0)and(tr[1]or tr[2])) then if l[1]=l[2] then ResultLabel.Caption:=квадрат' else ResultLabel.Caption:=прямоугольник' else if l[1]=l[2] then ResultLabel.Caption:=ромб' else ResultLabel.Caption:=параллелограмм'

97 Модуль MainUnit (9) else if (l[1]=l[3])or(l[2]=l[4])then ResultLabel.Caption:=равнобедренная трапеция' else if (q[1]*q[2]=-1.0)or(q[1]*q[3]=-1.0)or ((q[1]=0)and(q[2]=0)and (tr[1]or tr[2]))or((q[2]=0)and(q[3]=0)and (tr[2]or tr[3])) then ResultLabel.Caption:=Прямоугольная трапеция' else ResultLabel.Caption:=трапеция общего вида' else ResultLabel.Caption:=общего вида'; NextButton.SetFocus; end;

98 Модуль MainUnit (10) procedure TMainForm.NextButtonClick(Sender: TObject); begin FormActivate(NextButton); end; procedure TMainForm.ExitButtonClick(Sender: TObject); begin Close; end; end.

Управление циклом обработки сообщений Цикл обработки сообщений выглядит следующим образом:... repeat HandleMessege until Terminated; Если сообщение инициирует длительную обработку, то процесс извлечения сообщений из очереди блокируется до ее завершения! Для того, чтобы во время обработки длительного сообщения приложение могло обрабатывать другие сообщения, в цикле длительной обработки необходимо периодически вызывать метод ProcessMessage класса TAplication.

100 Пример Ex_9_8. Прерывание длительной обработки

101 Диаграмма состояний интерфейса Ожидание Результат Ожидание С0 С2 С4 С0 – активация формы ( FormActivate ); С1 – нажатие кнопки StartButton(StartButtonClick) ; С2 – нажатие кнопки Button ( ButtonClick ) C3 – завершение обработки; С4 – нажатие кнопки Выход ( ExitButtonClick ). Вывод чисел С1С1 С3

102 Модуль MainUnit unit MainUnit; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls; type TForm1 = class(TForm) StartButton: TButton; ExitButton: TButton; procedure StartButtonClick(Sender: TObject); procedure ExitButtonClick(Sender: TObject); procedure ButtonClick(Sender: TObject); private Cancel:Boolean; end; var Form1: TForm1;

103 Модуль MainUnit (2) implementation {$R *.DFM} procedure TForm1.StartButtonClick(Sender: TObject); Var i,j:integer; ProgressBar: TProgressBar; Button:TButton; begin ProgressBar := TProgressBar.Create(Self); Button:=TButton.Create(Self); try ProgressBar.Parent := Self; ProgressBar.Left:=30; ProgressBar.Top:=45; Button.Parent:=Self; Button.Caption:='Прервать'; Button.Left:=60; Button.Top:=65; Button.OnClick:=ButtonClick;

104 Модуль MainUnit (3) for j:=0 to 10 do begin for i:=1 to do begin Canvas.TextOut(90,20,IntToStr(i)); Application.ProcessMessages; if Cancel then break; end; ProgressBar.StepIt; if Cancel then break; end; finally ProgressBar.Free; Button.Free; end; Canvas.TextOut(70,20,'Вывод завершен'); end;

105 Модуль MainUnit (4) Procedure TForm1.ButtonClick; begin Cancel:=true; end; procedure TForm1.ExitButtonClick(Sender: TObject); begin Close; end; end.

Обработка сообщений и событий При создании нового сообщения необходимо выполнить следующие действия: описать тип сообщения; объявить номер (или индекс) сообщения; объявить метод обработки нового сообщения в классе, который должен его обрабатывать; инициализировать (передать) сообщение.

107 Структура сообщения Сообщение состоит из номера (индекса) и полей значений: Type TMessage=record Msg:Cardinal; {индекс сообщения} case Integer of 0: (WParam:LongInt; LParam:LongInt; Result:LongInt); 1: (WParamLo:Word; WParamHi:Word; LParamLo:Word; LParamHi:Word; ResultLo:Word; ResultHi:Word); end; Номера с 0 до $399 зарезервированы за системой. Первый свободный номер обозначен константой WM_USER = $400, относительно которой обычно и определяются номера пользовательских сообщений: Const Mes1 = WM_USER; Mes2 = WM_USER+1;

108 Методы обработки сообщений Метод обработки сообщения по умолчанию является динамическим, причем спецификаторы dynamic или override при его описании опускаются: Имена методов обработки некоторого сообщения, переопределяемых в иерархии классов, могут не совпадать: переопределяемый метод идентифицируется по совпадающему номеру сообщения, указываемому после специальной директивы message. Номер сообщения обычно задается в виде символического имени, но может указываться и целой положительной константой. type = class public Procedure wm (Var Message: ); message ;... end;

109 Переопределение метода обработки сообщений Если метод обработки сообщения переопределяет уже существовавший в классе-родителе, то обычно в нем программируют только специфические действия по обработке сообщения, а затем вызывают наследуемый метод для выполнения дообработки сообщения. procedure. wm ; begin inherited; end;

110 Генерация сообщений 1. Для передачи сообщения оконному элементу управления через очередь сообщений с ожиданием завершения его обработки используется функция: function SendMessage (hWnd:Integer, Mes:Cardinal; WParam, LParam:LongInt):LongInt; Она возвращает результат обработки сообщения. Параметр hWnd определяет номер, под которым окно - адресат сообщения - зарегистрировано в Windows (дескриптор окна). Для каждого оконного элемента управления этот номер хранится в свойстве Handle, определенном в классе TWinControl.

111 Генерация сообщений (2) 2. Для передачи сообщения оконному элементу управления через очередь сообщений без ожидания завершения его обработки используется функция: function PostMessage(hWnd:Integer,Mes:Cardinal; WParam,Param:LongInt):LongBool; Список параметров функции совпадает со списком SendMessage, но в отличие от SendMessage PostMessage ставит сообщение в очередь сообщений и возвращает управление, не ожидая завершения обработки сообщения. Функция возвращает True, если сообщение поставлено в очередь, и False - в противном случае.

112 Генерация сообщений (3) 3. Для передачи сообщения элементу управления минуя очередь используется специальный метод этого элемента, определенный в классе TСontrol : procedure Perform (Mes:Cardinal; WParam, LParam:LongInt); Данный метод передает сообщение элементу управления непосредственно, поэтому указывать дескриптор окна не надо, и список параметров содержит только параметры, относящиеся к самому сообщению.

113 Пример Ex_9_09. Передача/прием сообщения

114 Модуль MainUnit unit MainUnit; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type MyMessage=Record Msg:Cardinal; {номер сообщения} Symb:PChar; {адрес строки} Result:LongInt; {результат} End; Const WM_MYMESSAGE = WM_USER+0;

115 Модуль MainUnit (2) type TMainForm = class(TForm) MessageLabel:TLabel; MessageEdit:TEdit; SendButton:TButton; NextButton:TButton; ExitButton:TButton; procedure SendButtonClick(Sender:TObject); procedure ExitButtonClick(Sender:TObject); procedure NextButtonClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure MessageEditKeyPress(Sender: TObject; var Key: Char); public SecondHandle:Integer; end; var MainForm: TMainForm;

116 Модуль MainUnit (3) implementation {$R *.DFM} procedure TMainForm.SendButtonClick(Sender: TObject); begin SendMessage(SecondHandle,WM_MYMESSAGE, Longint(MessageEdit.Text),0); NextButton.SetFocus; end; procedure TMainForm.FormActivate(Sender: TObject); begin MessageEdit.Clear; MessageEdit.SetFocus; end;

117 Модуль MainUnit (4) procedure TMainForm.MessageEditKeyPress(Sender: TObject; var Key: Char); begin if Key=#13 then begin Key:=#0; SendButton.SetFocus; end; procedure TMainForm.NextButtonClick(Sender: TObject); begin FormActivate(NextButton); end; procedure TMainForm.ExitButtonClick(Sender: TObject); begin Close; end; end.

118 Модуль Unit2 unit Unit2; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, MainUnit; type TForm2 = class(TForm) MessageEdit: TEdit; procedure FormCreate(Sender: TObject); public Procedure WMMyMessage(var Msg:MyMessage); MESSAGE WM_MYMESSAGE; end; var Form2: TForm2;

119 Модуль Unit2 (2) implementation {$R *.DFM} procedure TForm2.FormCreate(Sender: TObject); begin MainForm.SecondHandle:=Handle; end; procedure TForm2.WMMyMessage(var Msg:MYMESSAGE); begin MessageEdit.Text:=Msg.Symb; inherited; end; end.

120 Использование других функций Аналогично для передачи сообщения можно было бы использовать функцию PostMessage : PostMessage(SecondHandle,WM_MYMESSAGE, Longint(MessageEdit.Text),0); Если с той же целью использовать метод Perform, то необходимо 1) в секции реализации модуля MainUnit разрешить использование модуля Unit2 : Uses Unit2; 2) для передачи сообщения использовать метод объекта Form2: Form2. Perform (WM_MYMESSAGE, Longint(MessageEdit.Text),0);

121 Пример Ex_9_10. Создание события Delphi unit Unit2; interface uses Windows,..., MainUnit; type TPCharEvent=procedure (Sender: TObject;MyString:PChar)of object; TForm2 = class(TForm) MessageEdit: TEdit; procedure FormCreate(Sender: TObject); private FOnMessage:TPCharEvent; public property OnMessage:TPCharEvent read FOnMessage write FOnMessage; procedure MessageProc(Sender:TObject;MyString:PChar); Procedure WMMyMessage(var Msg:MyMessage); MESSAGE WM_MYMESSAGE; end; var Form2: TForm2; MainUnit – без изменений

122 Создание события Delphi (2) implementation {$R *.DFM} procedure TForm2.FormCreate(Sender: TObject); begin Form1.SecondHandle:=Handle; OnMessage:=MessageProc; end; procedure TForm2.WMMyMessage(var Msg:MyMessage); begin if Assigned(OnMessage) then OnMessage(Self,Msg.PString); {inherited; указывается при переопределении метода} end; procedure TForm2.MessageProc; begin MessageEdit.Text:=MyString; end; end.

123