├── .gitignore ├── AbstractFactory ├── AbstractCarFactory.pas └── Car.pas ├── Adapter ├── AdaptedCustomer.pas ├── NewCustomer.pas └── OldCustomer.pas ├── Bridge ├── Switch.pas ├── SwitchAbstraction.pas └── SwitchInterface.pas ├── Builder ├── Builder.pas ├── BuilderInterfaces.pas ├── Director.pas └── Product.pas ├── ChainOfResponsibility └── Handler.pas ├── Command ├── Command.pas ├── Invoker.pas └── Receiver.pas ├── Composite ├── Component.pas ├── Composite.pas └── Leaf.pas ├── DemoForm.dfm ├── DemoForm.pas ├── despat.dpr ├── despat.dproj └── despat.res /.gitignore: -------------------------------------------------------------------------------- 1 | /Win32/Debug 2 | /*.local 3 | /*.identcache 4 | __history 5 | -------------------------------------------------------------------------------- /AbstractFactory/AbstractCarFactory.pas: -------------------------------------------------------------------------------- 1 | unit AbstractCarFactory; 2 | 3 | interface 4 | 5 | uses 6 | Car; 7 | 8 | type 9 | TAbstractCarFactory = class abstract(TObject) 10 | public 11 | function GetCar: TAbstractCar; virtual; abstract; 12 | end; 13 | 14 | TRenaultFactory = class(TAbstractCarFactory) 15 | public 16 | function GetCar: TAbstractCar; override; 17 | end; 18 | 19 | TVolvoFactory = class(TAbstractCarFactory) 20 | public 21 | function GetCar: TAbstractCar; override; 22 | end; 23 | 24 | TMercedesFactory = class(TAbstractCarFactory) 25 | public 26 | function GetCar: TAbstractCar; override; 27 | end; 28 | 29 | implementation 30 | 31 | { TRenaultFactory } 32 | 33 | function TRenaultFactory.GetCar: TAbstractCar; 34 | begin 35 | Result := TRenaultCar.Create; 36 | end; 37 | 38 | { TVolvoFactory } 39 | 40 | function TVolvoFactory.GetCar: TAbstractCar; 41 | begin 42 | Result := TVolvoCar.Create; 43 | end; 44 | 45 | { TMercedesFactory } 46 | 47 | function TMercedesFactory.GetCar: TAbstractCar; 48 | begin 49 | Result := TMercedesCar.Create; 50 | end; 51 | 52 | end. 53 | -------------------------------------------------------------------------------- /AbstractFactory/Car.pas: -------------------------------------------------------------------------------- 1 | unit Car; 2 | 3 | interface 4 | 5 | type 6 | TAbstractCar = class abstract(TObject) 7 | public 8 | function GetName: string; virtual; abstract; 9 | end; 10 | 11 | TRenaultCar = class(TAbstractCar) 12 | public 13 | function GetName: string; override; 14 | end; 15 | 16 | TVolvoCar = class(TAbstractCar) 17 | public 18 | function GetName: string; override; 19 | end; 20 | 21 | TMercedesCar = class(TAbstractCar) 22 | public 23 | function GetName: string; override; 24 | end; 25 | 26 | implementation 27 | 28 | { TRenaultCar } 29 | 30 | function TRenaultCar.GetName: string; 31 | begin 32 | Result := 'Renault'; 33 | end; 34 | 35 | { TVolvoCar } 36 | 37 | function TVolvoCar.GetName: string; 38 | begin 39 | Result := 'Volvo'; 40 | end; 41 | 42 | { TMercedesCar } 43 | 44 | function TMercedesCar.GetName: string; 45 | begin 46 | Result := 'Mercedes-Benz'; 47 | end; 48 | 49 | end. 50 | -------------------------------------------------------------------------------- /Adapter/AdaptedCustomer.pas: -------------------------------------------------------------------------------- 1 | unit AdaptedCustomer; 2 | 3 | interface 4 | 5 | uses 6 | NewCustomer, 7 | OldCustomer; 8 | 9 | type 10 | TAdaptedCustomer = class(TNewCustomer) 11 | private 12 | FOldCustomer: TOldCustomer; 13 | protected 14 | function GetCustomerID: Integer; override; 15 | function GetFirstName: string; override; 16 | function GetLastName: string; override; 17 | function GetBirthDate: TDateTime; override; 18 | public 19 | constructor Create(aCustomerID: Integer); override; 20 | destructor Destroy; override; 21 | class function GetCustomer(aCustomerID: Integer): TNewCustomer; 22 | end; 23 | 24 | implementation 25 | 26 | uses 27 | System.SysUtils; 28 | 29 | const 30 | LAST_OLDCUSTOMER_AT_YEAR_2000 = 15722; 31 | LAST_OLDCUSTOMER_IN_DATABASE = 30000; 32 | 33 | { TAdaptedCustomer } 34 | 35 | constructor TAdaptedCustomer.Create(aCustomerID: Integer); 36 | begin 37 | inherited Create(aCustomerID); 38 | 39 | FOldCustomer := TOldCustomer.Create(aCustomerID); 40 | end; 41 | 42 | destructor TAdaptedCustomer.Destroy; 43 | begin 44 | FOldCustomer.Free; 45 | 46 | inherited Destroy; 47 | end; 48 | 49 | function TAdaptedCustomer.GetBirthDate: TDateTime; 50 | var 51 | FullYear: Word; 52 | 53 | begin 54 | if FOldCustomer.CustomerID > LAST_OLDCUSTOMER_AT_YEAR_2000 then 55 | FullYear := 2000 + FOldCustomer.BirthDate.Year 56 | else 57 | FullYear := 1900 + FOldCustomer.BirthDate.Year; 58 | 59 | Result := EncodeDate(FullYear, FOldCustomer.BirthDate.Month, FOldCustomer.BirthDate.Day); 60 | end; 61 | 62 | class function TAdaptedCustomer.GetCustomer(aCustomerID: Integer): TNewCustomer; 63 | begin 64 | if aCustomerID > LAST_OLDCUSTOMER_IN_DATABASE then 65 | Result := TNewCustomer.Create(aCustomerID) 66 | else 67 | Result := TAdaptedCustomer.Create(aCustomerID); 68 | end; 69 | 70 | function TAdaptedCustomer.GetCustomerID: Integer; 71 | begin 72 | Result := FOldCustomer.CustomerID; 73 | end; 74 | 75 | function TAdaptedCustomer.GetFirstName: string; 76 | var 77 | splitPos: Integer; 78 | 79 | begin 80 | splitPos := Pos(' ', FOldCustomer.Name); 81 | 82 | if splitPos = 0 then 83 | Result := '' 84 | else 85 | Result := Copy(FOldCustomer.Name, 1, splitPos - 1); 86 | end; 87 | 88 | function TAdaptedCustomer.GetLastName: string; 89 | var 90 | splitPos: Integer; 91 | 92 | begin 93 | splitPos := Pos(' ', FOldCustomer.Name); 94 | 95 | if splitPos = 0 then 96 | Result := FOldCustomer.Name 97 | else 98 | Result := Copy(FOldCustomer.Name, splitPos + 1, Length(FOldCustomer.Name)); 99 | end; 100 | 101 | end. 102 | -------------------------------------------------------------------------------- /Adapter/NewCustomer.pas: -------------------------------------------------------------------------------- 1 | unit NewCustomer; 2 | 3 | interface 4 | 5 | type 6 | TNewCustomer = class(TObject) 7 | private 8 | FCustomerID: Integer; 9 | FFirstName: string; 10 | FLastName: string; 11 | FBirthDate: TDateTime; 12 | protected 13 | function GetCustomerID: Integer; virtual; 14 | function GetFirstName: string; virtual; 15 | function GetLastName: string; virtual; 16 | function GetBirthDate: TDateTime; virtual; 17 | public 18 | constructor Create(aCustomerID: Integer); virtual; 19 | function ToString: string; override; 20 | property CustomerID: Integer read GetCustomerID; 21 | property FirstName: string read GetFirstName; 22 | property LastName: string read GetLastName; 23 | property BirthDate: TDateTime read GetBirthDate; 24 | end; 25 | 26 | implementation 27 | 28 | uses 29 | System.SysUtils; 30 | 31 | { TNewCustomer } 32 | 33 | constructor TNewCustomer.Create(aCustomerID: Integer); 34 | begin 35 | FCustomerID := aCustomerID; 36 | FFirstName := 'A'; 37 | FLastName := 'NewCustomer'; 38 | FBirthDate := Now; 39 | end; 40 | 41 | function TNewCustomer.GetBirthDate: TDateTime; 42 | begin 43 | Result := FBirthDate; 44 | end; 45 | 46 | function TNewCustomer.GetCustomerID: Integer; 47 | begin 48 | Result := FCustomerID; 49 | end; 50 | 51 | function TNewCustomer.GetFirstName: string; 52 | begin 53 | Result := FFirstName; 54 | end; 55 | 56 | function TNewCustomer.GetLastName: string; 57 | begin 58 | Result := FLastName; 59 | end; 60 | 61 | function TNewCustomer.ToString: string; 62 | begin 63 | Result := Format('Class: %s, FirstName: %s, LastName: %s, Birthday: %s', [ClassType.ClassName, GetFirstName, GetLastName, DateToStr(GetBirthDate)]); 64 | end; 65 | 66 | end. 67 | -------------------------------------------------------------------------------- /Adapter/OldCustomer.pas: -------------------------------------------------------------------------------- 1 | unit OldCustomer; 2 | 3 | interface 4 | 5 | type 6 | TOldBirthDate = record 7 | Day: 0..31; 8 | Month: 1..12; 9 | Year: 1..12; 10 | end; 11 | 12 | TOldCustomer = class(TObject) 13 | private 14 | FCustomerID: Integer; 15 | FName: string; 16 | FBirthDate: TOldBirthDate; 17 | public 18 | constructor Create(aCustomerID: Integer); 19 | property CustomerID: Integer read FCustomerID; 20 | property Name: string read FName; 21 | property BirthDate: TOldBirthDate read FBirthDate; 22 | end; 23 | 24 | implementation 25 | 26 | { TOldCustomer } 27 | 28 | constructor TOldCustomer.Create(aCustomerID: Integer); 29 | begin 30 | FCustomerID := aCustomerID; 31 | FName := 'An OldCustomer'; 32 | 33 | with FBirthDate do 34 | begin 35 | Day := 1; 36 | Month := 1; 37 | Year := 1; 38 | end; 39 | end; 40 | 41 | end. 42 | -------------------------------------------------------------------------------- /Bridge/Switch.pas: -------------------------------------------------------------------------------- 1 | unit Switch; 2 | 3 | interface 4 | 5 | uses 6 | SwitchInterface; 7 | 8 | type 9 | TSwitch = class abstract(TInterfacedObject, ISwitch) 10 | public 11 | function TurnOn: string; virtual; abstract; 12 | function TurnOff: string; virtual; abstract; 13 | end; 14 | 15 | TKitchenSwitch = class(TSwitch) 16 | public 17 | function TurnOn: string; override; 18 | function TurnOff: string; override; 19 | end; 20 | 21 | TBathroomSwitch = class(TSwitch) 22 | public 23 | function TurnOn: string; override; 24 | function TurnOff: string; override; 25 | end; 26 | 27 | implementation 28 | 29 | { TKitchenSwitch } 30 | 31 | function TKitchenSwitch.TurnOff: string; 32 | begin 33 | Result := 'Kitchen switch turned off...'; 34 | end; 35 | 36 | function TKitchenSwitch.TurnOn: string; 37 | begin 38 | Result := 'Kitchen switch turned on...'; 39 | end; 40 | 41 | { TBathroomSwitch } 42 | 43 | function TBathroomSwitch.TurnOff: string; 44 | begin 45 | Result := 'Bathroom switch turned off...'; 46 | end; 47 | 48 | function TBathroomSwitch.TurnOn: string; 49 | begin 50 | Result := 'Bathroom switch turned on...'; 51 | end; 52 | 53 | end. 54 | -------------------------------------------------------------------------------- /Bridge/SwitchAbstraction.pas: -------------------------------------------------------------------------------- 1 | unit SwitchAbstraction; 2 | 3 | interface 4 | 5 | uses 6 | SwitchInterface, 7 | Switch; 8 | 9 | type 10 | TSwitchAbstraction = class(TObject) 11 | protected 12 | FSwitch: ISwitch; 13 | public 14 | function TurnOn: string; virtual; 15 | function TurnOff: string; virtual; 16 | property Switch: ISwitch write FSwitch; 17 | end; 18 | 19 | implementation 20 | 21 | { TSwitchAbstraction } 22 | 23 | function TSwitchAbstraction.TurnOff: string; 24 | begin 25 | Result := FSwitch.TurnOff; 26 | end; 27 | 28 | function TSwitchAbstraction.TurnOn: string; 29 | begin 30 | Result := FSwitch.TurnOn; 31 | end; 32 | 33 | end. 34 | -------------------------------------------------------------------------------- /Bridge/SwitchInterface.pas: -------------------------------------------------------------------------------- 1 | unit SwitchInterface; 2 | 3 | interface 4 | 5 | type 6 | ISwitch = interface 7 | ['{A8CBEED0-A5B5-4CC9-95A1-C203826CBCCD}'] 8 | function TurnOn: string; 9 | function TurnOff: string; 10 | end; 11 | 12 | implementation 13 | 14 | end. 15 | -------------------------------------------------------------------------------- /Builder/Builder.pas: -------------------------------------------------------------------------------- 1 | unit Builder; 2 | 3 | interface 4 | 5 | uses 6 | BuilderInterfaces; 7 | 8 | type 9 | TMealBuilder1 = class(TInterfacedObject, IBuilder) 10 | private 11 | FProduct: IProduct; 12 | public 13 | constructor Create; 14 | function BuildPartA: string; 15 | function BuildPartB: string; 16 | function GetResult: IProduct; 17 | end; 18 | 19 | TMealBuilder2 = class(TInterfacedObject, IBuilder) 20 | private 21 | FProduct: IProduct; 22 | public 23 | constructor Create; 24 | function BuildPartA: string; 25 | function BuildPartB: string; 26 | function GetResult: IProduct; 27 | end; 28 | 29 | implementation 30 | 31 | uses 32 | Product; 33 | 34 | { TMealBuilder1 } 35 | 36 | function TMealBuilder1.BuildPartA: string; 37 | begin 38 | FProduct.Add('making burger...'); 39 | end; 40 | 41 | function TMealBuilder1.BuildPartB: string; 42 | begin 43 | FProduct.Add('making drink...'); 44 | end; 45 | 46 | constructor TMealBuilder1.Create; 47 | begin 48 | FProduct := TProduct.Create; 49 | end; 50 | 51 | function TMealBuilder1.GetResult: IProduct; 52 | begin 53 | Result := FProduct; 54 | end; 55 | 56 | { TMealBuilder2 } 57 | 58 | function TMealBuilder2.BuildPartA: string; 59 | begin 60 | FProduct.Add('making donut...'); 61 | end; 62 | 63 | function TMealBuilder2.BuildPartB: string; 64 | begin 65 | FProduct.Add('making toy'); 66 | end; 67 | 68 | constructor TMealBuilder2.Create; 69 | begin 70 | FProduct := TProduct.Create; 71 | end; 72 | 73 | function TMealBuilder2.GetResult: IProduct; 74 | begin 75 | Result := FProduct; 76 | end; 77 | 78 | end. 79 | -------------------------------------------------------------------------------- /Builder/BuilderInterfaces.pas: -------------------------------------------------------------------------------- 1 | unit BuilderInterfaces; 2 | 3 | interface 4 | 5 | type 6 | IProduct = interface 7 | ['{2D82CB6E-2858-4B71-B05D-47EE45AD6869}'] 8 | procedure Add(aPart: string); 9 | function Display: string; 10 | end; 11 | 12 | IBuilder = interface 13 | ['{C9321907-129C-41D8-9421-4176A258CC2E}'] 14 | function BuildPartA: string; 15 | function BuildPartB: string; 16 | function GetResult: IProduct; 17 | end; 18 | 19 | implementation 20 | 21 | end. 22 | -------------------------------------------------------------------------------- /Builder/Director.pas: -------------------------------------------------------------------------------- 1 | unit Director; 2 | 3 | interface 4 | 5 | uses 6 | BuilderInterfaces; 7 | 8 | type 9 | TDirector = class(TObject) 10 | public 11 | procedure Construct(aBuilder: IBuilder); 12 | end; 13 | 14 | implementation 15 | 16 | { TDirector } 17 | 18 | procedure TDirector.Construct(aBuilder: IBuilder); 19 | begin 20 | aBuilder.BuildPartA; 21 | aBuilder.BuildPartB; 22 | end; 23 | 24 | end. 25 | -------------------------------------------------------------------------------- /Builder/Product.pas: -------------------------------------------------------------------------------- 1 | unit Product; 2 | 3 | interface 4 | 5 | uses 6 | BuilderInterfaces, 7 | System.Classes; 8 | 9 | type 10 | TProduct = class(TInterfacedObject, IProduct) 11 | private 12 | FParts: TStringList; 13 | public 14 | constructor Create; 15 | destructor Destroy; override; 16 | procedure Add(aPart: string); 17 | function Display: string; 18 | end; 19 | 20 | implementation 21 | 22 | uses 23 | System.SysUtils; 24 | 25 | { TProduct } 26 | 27 | constructor TProduct.Create; 28 | begin 29 | FParts := TStringList.Create; 30 | end; 31 | 32 | destructor TProduct.Destroy; 33 | begin 34 | FParts.Free; 35 | 36 | inherited; 37 | end; 38 | 39 | function TProduct.Display: string; 40 | var 41 | text: TStringBuilder; 42 | part: string; 43 | 44 | begin 45 | text := TStringBuilder.Create; 46 | 47 | try 48 | text.Append('Making meal'); 49 | text.Append(' --> '); 50 | 51 | for part in FParts do 52 | begin 53 | text.Append(part); 54 | end; 55 | 56 | Result := text.ToString; 57 | finally 58 | text.Free; 59 | end; 60 | end; 61 | 62 | procedure TProduct.Add(aPart: string); 63 | begin 64 | FParts.Add(aPart); 65 | end; 66 | 67 | end. 68 | -------------------------------------------------------------------------------- /ChainOfResponsibility/Handler.pas: -------------------------------------------------------------------------------- 1 | unit Handler; 2 | 3 | interface 4 | 5 | type 6 | THandler = class abstract(TObject) 7 | protected 8 | FSuccessor: THandler; 9 | procedure SetSuccessor(const ASuccessor: THandler); 10 | public 11 | function HandleRequest(ARequest: SmallInt): string; virtual; abstract; 12 | property Successor: THandler write SetSuccessor; 13 | end; 14 | 15 | TConcreteHandler1 = class(THandler) 16 | public 17 | function HandleRequest(ARequest: SmallInt): string; override; 18 | end; 19 | 20 | TConcreteHandler2 = class(THandler) 21 | public 22 | function HandleRequest(ARequest: SmallInt): string; override; 23 | end; 24 | 25 | TConcreteHandler3 = class(THandler) 26 | public 27 | function HandleRequest(ARequest: SmallInt): string; override; 28 | end; 29 | 30 | implementation 31 | 32 | uses 33 | System.SysUtils; 34 | 35 | { THandler } 36 | 37 | procedure THandler.SetSuccessor(const ASuccessor: THandler); 38 | begin 39 | FSuccessor := ASuccessor; 40 | end; 41 | 42 | { TConcreteHandler1 } 43 | 44 | function TConcreteHandler1.HandleRequest(ARequest: SmallInt): string; 45 | begin 46 | if (ARequest >= 0) and (ARequest < 10) then 47 | Result := Format('%s handled request %d', [ClassType.ClassName, ARequest]) 48 | else if FSuccessor <> nil then 49 | Result := FSuccessor.HandleRequest(ARequest); 50 | end; 51 | 52 | { TConcreteHandler2 } 53 | 54 | function TConcreteHandler2.HandleRequest(ARequest: SmallInt): string; 55 | begin 56 | if (ARequest >= 10) and (ARequest < 20) then 57 | Result := Format('%s handled request %d', [ClassType.ClassName, ARequest]) 58 | else if FSuccessor <> nil then 59 | Result := FSuccessor.HandleRequest(ARequest); 60 | end; 61 | 62 | { TConcreteHandler3 } 63 | 64 | function TConcreteHandler3.HandleRequest(ARequest: SmallInt): string; 65 | begin 66 | if (ARequest >= 20) and (ARequest < 30) then 67 | Result := Format('%s handled request %d', [ClassType.ClassName, ARequest]) 68 | else if FSuccessor <> nil then 69 | Result := FSuccessor.HandleRequest(ARequest); 70 | end; 71 | 72 | end. 73 | -------------------------------------------------------------------------------- /Command/Command.pas: -------------------------------------------------------------------------------- 1 | unit Command; 2 | 3 | interface 4 | 5 | uses 6 | Receiver; 7 | 8 | type 9 | TCommand = class abstract(TObject) 10 | protected 11 | FReceiver: TReceiver; 12 | public 13 | constructor Create(AReceiver: TReceiver); 14 | function Execute: string; virtual; abstract; 15 | end; 16 | 17 | TConcreteCommand = class(TCommand) 18 | public 19 | constructor Create(AReceiver: TReceiver); 20 | function Execute: string; override; 21 | end; 22 | 23 | implementation 24 | 25 | { TCommand } 26 | 27 | constructor TCommand.Create(AReceiver: TReceiver); 28 | begin 29 | FReceiver := AReceiver; 30 | end; 31 | 32 | { TConcreteCommand } 33 | 34 | constructor TConcreteCommand.Create(AReceiver: TReceiver); 35 | begin 36 | inherited Create(AReceiver); 37 | end; 38 | 39 | function TConcreteCommand.Execute: string; 40 | begin 41 | Result := FReceiver.Action; 42 | end; 43 | 44 | end. 45 | -------------------------------------------------------------------------------- /Command/Invoker.pas: -------------------------------------------------------------------------------- 1 | unit Invoker; 2 | 3 | interface 4 | 5 | uses 6 | Command; 7 | 8 | type 9 | TInvoker = class(TObject) 10 | private 11 | FCommand: TCommand; 12 | public 13 | procedure SetCommand(ACommand: TCommand); 14 | function ExecuteCommand: string; 15 | end; 16 | 17 | implementation 18 | 19 | { TInvoker } 20 | 21 | function TInvoker.ExecuteCommand: string; 22 | begin 23 | Result := FCommand.Execute; 24 | end; 25 | 26 | procedure TInvoker.SetCommand(ACommand: TCommand); 27 | begin 28 | FCommand := ACommand; 29 | end; 30 | 31 | end. 32 | 33 | -------------------------------------------------------------------------------- /Command/Receiver.pas: -------------------------------------------------------------------------------- 1 | unit Receiver; 2 | 3 | interface 4 | 5 | type 6 | TReceiver = class(TObject) 7 | private 8 | FCommandText: string; 9 | public 10 | constructor Create(ACommandText: string); 11 | function Action: string; 12 | end; 13 | 14 | implementation 15 | 16 | uses 17 | System.SysUtils; 18 | 19 | { TReceiver } 20 | 21 | constructor TReceiver.Create(ACommandText: string); 22 | begin 23 | FCommandText := ACommandText; 24 | end; 25 | 26 | function TReceiver.Action: string; 27 | begin 28 | Result := Format('Receiver received command: %s', [FCommandText]); 29 | end; 30 | 31 | end. 32 | 33 | -------------------------------------------------------------------------------- /Composite/Component.pas: -------------------------------------------------------------------------------- 1 | unit Component; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes; 7 | 8 | type 9 | TComponent = class abstract(TObject) 10 | protected 11 | FName: string; 12 | public 13 | constructor Create(AName: string); 14 | function Add(const AComponent: TComponent): string; virtual; abstract; 15 | function Remove(const AComponent: TCOmponent): string; virtual; abstract; 16 | function Display(ADepth: SmallInt): TStrings; virtual; abstract; 17 | end; 18 | 19 | implementation 20 | 21 | { TComponent } 22 | 23 | constructor TComponent.Create(AName: string); 24 | begin 25 | FName := AName; 26 | end; 27 | 28 | end. 29 | 30 | -------------------------------------------------------------------------------- /Composite/Composite.pas: -------------------------------------------------------------------------------- 1 | unit Composite; 2 | 3 | interface 4 | 5 | uses 6 | System.Generics.Collections, 7 | System.Classes, 8 | Component; 9 | 10 | type 11 | TComposite = class(TComponent) 12 | private 13 | FChildren: TObjectList; 14 | FResultList: TStrings; 15 | public 16 | constructor Create(AName: string); 17 | destructor Destroy; override; 18 | function Add(const AComponent: TComponent): string; override; 19 | function Remove(const AComponent: TComponent): string; override; 20 | function Display(ADepth: SmallInt): TStrings; override; 21 | end; 22 | 23 | implementation 24 | 25 | { TComposite } 26 | 27 | constructor TComposite.Create(AName: string); 28 | begin 29 | inherited Create(AName); 30 | 31 | FChildren := TObjectList.Create(True); 32 | FResultList := TStringList.Create; 33 | end; 34 | 35 | destructor TComposite.Destroy; 36 | begin 37 | FChildren.Free; 38 | FResultList.Free; 39 | 40 | inherited; 41 | end; 42 | 43 | function TComposite.Display(ADepth: SmallInt): TStrings; 44 | var 45 | component: TComponent; 46 | 47 | begin 48 | FResultList.Add(StringOfChar('-', ADepth) + FName); 49 | 50 | for component in FChildren do 51 | FResultList.AddStrings(component.Display(ADepth + 2)); 52 | 53 | Result := FResultList; 54 | end; 55 | 56 | function TComposite.Add(const AComponent: TComponent): string; 57 | begin 58 | FChildren.Add(AComponent); 59 | end; 60 | 61 | function TComposite.Remove(const AComponent: TComponent): string; 62 | begin 63 | FChildren.Remove(AComponent); 64 | end; 65 | 66 | end. 67 | -------------------------------------------------------------------------------- /Composite/Leaf.pas: -------------------------------------------------------------------------------- 1 | unit Leaf; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes, 7 | Component; 8 | 9 | type 10 | TLeaf = class(TComponent) 11 | private 12 | FResultList: TStrings; 13 | public 14 | constructor Create(AName: string); 15 | destructor Destroy; override; 16 | function Add(const AComponent: TComponent): string; override; 17 | function Remove(const AComponent: TComponent): string; override; 18 | function Display(ADepth: SmallInt): TStrings; override; 19 | end; 20 | 21 | implementation 22 | 23 | { TLeaf } 24 | 25 | constructor TLeaf.Create(AName: string); 26 | begin 27 | inherited Create(AName); 28 | 29 | FResultList := TStringList.Create; 30 | end; 31 | 32 | destructor TLeaf.Destroy; 33 | begin 34 | FResultList.Free; 35 | 36 | inherited; 37 | end; 38 | 39 | function TLeaf.Add(const AComponent: TComponent): string; 40 | begin 41 | Result := 'Cannot add to leaf.'; 42 | end; 43 | 44 | function TLeaf.Remove(const AComponent: TComponent): string; 45 | begin 46 | Result := 'Cannot remove from leaf.' 47 | end; 48 | 49 | function TLeaf.Display(ADepth: SmallInt): TStrings; 50 | begin 51 | FResultList.Add(StringOfChar('-', ADepth) + FName); 52 | 53 | Result := FResultList; 54 | end; 55 | 56 | end. 57 | 58 | -------------------------------------------------------------------------------- /DemoForm.dfm: -------------------------------------------------------------------------------- 1 | object frmDemo: TfrmDemo 2 | Left = 0 3 | Top = 0 4 | Caption = 'Design Patterns demo' 5 | ClientHeight = 452 6 | ClientWidth = 751 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | OnDestroy = FormDestroy 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object plPages: TJvPageList 19 | Left = 241 20 | Top = 0 21 | Width = 510 22 | Height = 452 23 | ActivePage = plspComposite 24 | PropagateEnable = False 25 | Align = alClient 26 | object plspAbstractFactory: TJvStandardPage 27 | Left = 0 28 | Top = 0 29 | Width = 510 30 | Height = 452 31 | Caption = 'PageAbstractFactory' 32 | object btnCreateCar: TButton 33 | Left = 282 34 | Top = 314 35 | Width = 114 36 | Height = 28 37 | Caption = 'Create car' 38 | TabOrder = 0 39 | OnClick = btnCreateCarClick 40 | end 41 | object cbbFactorySelect: TComboBox 42 | Left = 115 43 | Top = 111 44 | Width = 281 45 | Height = 21 46 | ParentShowHint = False 47 | ShowHint = True 48 | TabOrder = 1 49 | TextHint = 'select car factory' 50 | Items.Strings = ( 51 | 'Renault factory' 52 | 'Volvo factory' 53 | 'Mercedes-Benz factory') 54 | end 55 | object lstCarsCreated: TListBox 56 | Left = 115 57 | Top = 138 58 | Width = 281 59 | Height = 170 60 | ItemHeight = 13 61 | TabOrder = 2 62 | end 63 | end 64 | object plspAdapter: TJvStandardPage 65 | Left = 0 66 | Top = 0 67 | Width = 510 68 | Height = 452 69 | Caption = 'PageAdapter' 70 | object lblAdapterInfo: TLabel 71 | Left = 48 72 | Top = 40 73 | Width = 221 74 | Height = 26 75 | Caption = 76 | '* Last old customers ID at year 2000 = 15722'#13#10'* Last old custome' + 77 | 'rs ID in database = 30000' 78 | end 79 | object btnAddCustomer: TSpeedButton 80 | Left = 366 81 | Top = 314 82 | Width = 114 83 | Height = 28 84 | Caption = 'Add customer' 85 | OnClick = btnAddCustomerClick 86 | end 87 | object edtCustomerId: TEdit 88 | Left = 318 89 | Top = 111 90 | Width = 161 91 | Height = 21 92 | NumbersOnly = True 93 | ParentShowHint = False 94 | ShowHint = True 95 | TabOrder = 0 96 | TextHint = 'Enter old customers ID' 97 | end 98 | object lstCustomers: TListBox 99 | Left = 30 100 | Top = 138 101 | Width = 449 102 | Height = 170 103 | ItemHeight = 13 104 | TabOrder = 1 105 | end 106 | end 107 | object plspBridge: TJvStandardPage 108 | Left = 0 109 | Top = 0 110 | Width = 510 111 | Height = 452 112 | Caption = 'PageBridge' 113 | object lblKitchenSwitch: TLabel 114 | Left = 114 115 | Top = 297 116 | Width = 68 117 | Height = 13 118 | Caption = 'Kitchen switch' 119 | end 120 | object lblBathroomSwitch: TLabel 121 | Left = 314 122 | Top = 297 123 | Width = 79 124 | Height = 13 125 | Caption = 'Bathroom switch' 126 | end 127 | object lstSwitchInfo: TListBox 128 | Left = 87 129 | Top = 77 130 | Width = 337 131 | Height = 209 132 | ItemHeight = 13 133 | TabOrder = 0 134 | end 135 | object swKitchen: TJvSwitch 136 | Left = 122 137 | Top = 316 138 | Width = 50 139 | Height = 60 140 | Caption = 'Kitchen switch' 141 | TabOrder = 1 142 | OnOn = swKitchenOn 143 | OnOff = swKitchenOff 144 | end 145 | object swBathroom: TJvSwitch 146 | Left = 330 147 | Top = 316 148 | Width = 50 149 | Height = 60 150 | Caption = 'Bathroom switch' 151 | TabOrder = 2 152 | OnOn = swBathroomOn 153 | OnOff = swBathroomOff 154 | end 155 | end 156 | object plspBuilder: TJvStandardPage 157 | Left = 0 158 | Top = 0 159 | Width = 510 160 | Height = 452 161 | Caption = 'PageBuilder' 162 | object btnMeal1: TButton 163 | Left = 115 164 | Top = 317 165 | Width = 137 166 | Height = 28 167 | Caption = 'Make meal' 168 | TabOrder = 0 169 | OnClick = btnMeal1Click 170 | end 171 | object lstMeals: TListBox 172 | Left = 66 173 | Top = 102 174 | Width = 377 175 | Height = 209 176 | ItemHeight = 13 177 | TabOrder = 1 178 | end 179 | object btnMeal2: TButton 180 | Left = 258 181 | Top = 317 182 | Width = 139 183 | Height = 28 184 | Caption = 'Make kids meal' 185 | TabOrder = 2 186 | OnClick = btnMeal2Click 187 | end 188 | end 189 | object plspChainOfResponsibility: TJvStandardPage 190 | Left = 0 191 | Top = 0 192 | Width = 510 193 | Height = 452 194 | Caption = 'PageChainOfResponsibility' 195 | object btnHandleRequests: TButton 196 | Left = 256 197 | Top = 271 198 | Width = 185 199 | Height = 28 200 | Caption = 'Handle Requests' 201 | TabOrder = 0 202 | OnClick = btnHandleRequestsClick 203 | end 204 | object lstHandlerOutput: TListBox 205 | Left = 48 206 | Top = 56 207 | Width = 393 208 | Height = 209 209 | ItemHeight = 13 210 | TabOrder = 1 211 | end 212 | end 213 | object plspCommand: TJvStandardPage 214 | Left = 0 215 | Top = 0 216 | Width = 510 217 | Height = 452 218 | Caption = 'PageCommand' 219 | object edtOrderName: TEdit 220 | Left = 86 221 | Top = 147 222 | Width = 186 223 | Height = 21 224 | ParentShowHint = False 225 | ShowHint = True 226 | TabOrder = 0 227 | TextHint = 'Type order name here...' 228 | OnChange = edtOrderNameChange 229 | end 230 | object btnAddOrder: TButton 231 | Left = 278 232 | Top = 144 233 | Width = 145 234 | Height = 28 235 | Caption = 'Add new order' 236 | Default = True 237 | Enabled = False 238 | TabOrder = 1 239 | OnClick = btnAddOrderClick 240 | end 241 | object lstCookWorkLog: TListBox 242 | Left = 86 243 | Top = 178 244 | Width = 337 245 | Height = 129 246 | ItemHeight = 13 247 | TabOrder = 2 248 | end 249 | end 250 | object plspFactoryMethod: TJvStandardPage 251 | Left = 0 252 | Top = 0 253 | Width = 510 254 | Height = 452 255 | Caption = 'PageFactoryMethod' 256 | end 257 | object plspObjectPool: TJvStandardPage 258 | Left = 0 259 | Top = 0 260 | Width = 510 261 | Height = 452 262 | Caption = 'PageObjectPool' 263 | end 264 | object plspPrototype: TJvStandardPage 265 | Left = 0 266 | Top = 0 267 | Width = 510 268 | Height = 452 269 | Caption = 'PagePrototype' 270 | end 271 | object plspSingleton: TJvStandardPage 272 | Left = 0 273 | Top = 0 274 | Width = 510 275 | Height = 452 276 | Caption = 'PageSingleton' 277 | end 278 | object plspComposite: TJvStandardPage 279 | Left = 0 280 | Top = 0 281 | Width = 510 282 | Height = 452 283 | Caption = 'PageComposite' 284 | object mmoStructure: TMemo 285 | Left = 58 286 | Top = 53 287 | Width = 393 288 | Height = 313 289 | TabOrder = 0 290 | end 291 | object btnCreateTreeStructure: TButton 292 | Left = 314 293 | Top = 372 294 | Width = 139 295 | Height = 28 296 | Caption = 'Create tree structure' 297 | TabOrder = 1 298 | OnClick = btnCreateTreeStructureClick 299 | end 300 | end 301 | object plspDecorator: TJvStandardPage 302 | Left = 0 303 | Top = 0 304 | Width = 510 305 | Height = 452 306 | Caption = 'PageDecorator' 307 | end 308 | object plspFacade: TJvStandardPage 309 | Left = 0 310 | Top = 0 311 | Width = 510 312 | Height = 452 313 | Caption = 'PageFacade' 314 | end 315 | object plspFlyweight: TJvStandardPage 316 | Left = 0 317 | Top = 0 318 | Width = 510 319 | Height = 452 320 | Caption = 'PageFlyweight' 321 | end 322 | object plspPrivateClassData: TJvStandardPage 323 | Left = 0 324 | Top = 0 325 | Width = 510 326 | Height = 452 327 | Caption = 'PagePrivateClassData' 328 | end 329 | object plspProxy: TJvStandardPage 330 | Left = 0 331 | Top = 0 332 | Width = 510 333 | Height = 452 334 | Caption = 'PageProxy' 335 | end 336 | object plspInterpreter: TJvStandardPage 337 | Left = 0 338 | Top = 0 339 | Width = 510 340 | Height = 452 341 | Caption = 'PageInterpreter' 342 | end 343 | object plspIterator: TJvStandardPage 344 | Left = 0 345 | Top = 0 346 | Width = 510 347 | Height = 452 348 | Caption = 'PageIterator' 349 | end 350 | object plspMediator: TJvStandardPage 351 | Left = 0 352 | Top = 0 353 | Width = 510 354 | Height = 452 355 | Caption = 'PageMediator' 356 | end 357 | object plspMemento: TJvStandardPage 358 | Left = 0 359 | Top = 0 360 | Width = 510 361 | Height = 452 362 | Caption = 'PageMemento' 363 | end 364 | object plspNullObject: TJvStandardPage 365 | Left = 0 366 | Top = 0 367 | Width = 510 368 | Height = 452 369 | Caption = 'PageNullObject' 370 | end 371 | object plspObserver: TJvStandardPage 372 | Left = 0 373 | Top = 0 374 | Width = 510 375 | Height = 452 376 | Caption = 'PageObserver' 377 | end 378 | object plspState: TJvStandardPage 379 | Left = 0 380 | Top = 0 381 | Width = 510 382 | Height = 452 383 | Caption = 'PageState' 384 | end 385 | object plspStrategy: TJvStandardPage 386 | Left = 0 387 | Top = 0 388 | Width = 510 389 | Height = 452 390 | Caption = 'PageStrategy' 391 | end 392 | object plspTemplateMethod: TJvStandardPage 393 | Left = 0 394 | Top = 0 395 | Width = 510 396 | Height = 452 397 | Caption = 'PageTemplateMethod' 398 | end 399 | object plspVisitor: TJvStandardPage 400 | Left = 0 401 | Top = 0 402 | Width = 510 403 | Height = 452 404 | Caption = 'PageVisitor' 405 | end 406 | end 407 | object pltvMenu: TJvPageListTreeView 408 | Left = 0 409 | Top = 0 410 | Width = 241 411 | Height = 452 412 | ShowButtons = True 413 | ShowLines = True 414 | PageDefault = 0 415 | PageList = plPages 416 | Align = alLeft 417 | Indent = 19 418 | TabOrder = 1 419 | Items.NodeData = { 420 | 0303000000440000000000000000000000FFFFFFFFFFFFFFFF00000000000000 421 | 000600000001134300720065006100740069006F006E0061006C002000500061 422 | 0074007400650072006E0073003E0000000000000000000000FFFFFFFFFFFFFF 423 | FF00000000000000000000000001104100620073007400720061006300740020 424 | 0046006100630074006F00720079002C0000000000000000000000FFFFFFFFFF 425 | FFFFFF00000000030000000000000001074200750069006C006400650072003A 426 | 0000000000000000000000FFFFFFFFFFFFFFFF00000000060000000000000001 427 | 0E46006100630074006F007200790020004D006500740068006F006400340000 428 | 000000000000000000FFFFFFFFFFFFFFFF000000000700000000000000010B4F 429 | 0062006A00650063007400200050006F006F006C003000000000000000000000 430 | 00FFFFFFFFFFFFFFFF0000000008000000000000000109500072006F0074006F 431 | 007400790070006500300000000000000000000000FFFFFFFFFFFFFFFF000000 432 | 0009000000000000000109530069006E0067006C00650074006F006E00440000 433 | 000000000000000000FFFFFFFFFFFFFFFF000000000000000008000000011353 434 | 00740072007500630074007500720061006C0020005000610074007400650072 435 | 006E0073002C0000000000000000000000FFFFFFFFFFFFFFFF00000000010000 436 | 0000000000010741006400610070007400650072002A00000000000000000000 437 | 00FFFFFFFFFFFFFFFF0000000002000000000000000106420072006900640067 438 | 006500300000000000000000000000FFFFFFFFFFFFFFFF000000000A00000000 439 | 000000010943006F006D0070006F007300690074006500300000000000000000 440 | 000000FFFFFFFFFFFFFFFF000000000B0000000000000001094400650063006F 441 | 007200610074006F0072002A0000000000000000000000FFFFFFFFFFFFFFFF00 442 | 0000000C00000000000000010646006100630061006400650030000000000000 443 | 0000000000FFFFFFFFFFFFFFFF000000000D00000000000000010946006C0079 444 | 00770065006900670068007400420000000000000000000000FFFFFFFFFFFFFF 445 | FF000000000E0000000000000001125000720069007600610074006500200043 446 | 006C0061007300730020004400610074006100280000000000000000000000FF 447 | FFFFFFFFFFFFFF000000000F000000000000000105500072006F007800790044 448 | 0000000000000000000000FFFFFFFFFFFFFFFF00000000000000000C00000001 449 | 134200650068006100760069006F00720061006C002000500061007400740065 450 | 0072006E0073004C0000000000000000000000FFFFFFFFFFFFFFFF0000000004 451 | 00000000000000011743006800610069006E0020006F00660020005200650073 452 | 0070006F006E0073006900620069006C006900740079002C0000000000000000 453 | 000000FFFFFFFFFFFFFFFF000000000500000000000000010743006F006D006D 454 | 0061006E006400340000000000000000000000FFFFFFFFFFFFFFFF0000000010 455 | 00000000000000010B49006E007400650072007000720065007400650072002E 456 | 0000000000000000000000FFFFFFFFFFFFFFFF00000000110000000000000001 457 | 084900740065007200610074006F0072002E0000000000000000000000FFFFFF 458 | FFFFFFFFFF00000000120000000000000001084D00650064006900610074006F 459 | 0072002C0000000000000000000000FFFFFFFFFFFFFFFF000000001300000000 460 | 00000001074D0065006D0065006E0074006F00340000000000000000000000FF 461 | FFFFFFFFFFFFFF000000001400000000000000010B4E0075006C006C0020004F 462 | 0062006A006500630074002E0000000000000000000000FFFFFFFFFFFFFFFF00 463 | 000000150000000000000001084F006200730065007200760065007200280000 464 | 000000000000000000FFFFFFFFFFFFFFFF000000001600000000000000010553 465 | 0074006100740065002E0000000000000000000000FFFFFFFFFFFFFFFF000000 466 | 0017000000000000000108530074007200610074006500670079003C00000000 467 | 00000000000000FFFFFFFFFFFFFFFF000000001800000000000000010F540065 468 | 006D0070006C0061007400650020006D006500740068006F0064002C00000000 469 | 00000000000000FFFFFFFFFFFFFFFF0000000019000000000000000107560069 470 | 007300690074006F007200} 471 | Items.Links = { 472 | 1D00000000000000000000000300000006000000070000000800000009000000 473 | 0000000001000000020000000A0000000B0000000C0000000D0000000E000000 474 | 0F00000000000000040000000500000010000000110000001200000013000000 475 | 140000001500000016000000170000001800000019000000} 476 | end 477 | end 478 | -------------------------------------------------------------------------------- /DemoForm.pas: -------------------------------------------------------------------------------- 1 | unit DemoForm; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, 7 | System.Variants, 8 | System.Classes, 9 | Vcl.Graphics, 10 | Vcl.Controls, 11 | Vcl.Forms, 12 | Vcl.Dialogs, 13 | Vcl.StdCtrls, 14 | Vcl.ComCtrls, 15 | JvExComCtrls, 16 | JvPageListTreeView, 17 | JvPageList, 18 | JvExControls, 19 | Vcl.Buttons, 20 | JvSwitch, 21 | SwitchInterface, 22 | SwitchAbstraction, 23 | Handler; 24 | 25 | type 26 | TfrmDemo = class(TForm) 27 | cbbFactorySelect: TComboBox; 28 | btnCreateCar: TButton; 29 | lstCarsCreated: TListBox; 30 | pltvMenu: TJvPageListTreeView; 31 | plPages: TJvPageList; 32 | lblAdapterInfo: TLabel; 33 | edtCustomerId: TEdit; 34 | lstCustomers: TListBox; 35 | btnAddCustomer: TSpeedButton; 36 | lstSwitchInfo: TListBox; 37 | swKitchen: TJvSwitch; 38 | swBathroom: TJvSwitch; 39 | lblKitchenSwitch: TLabel; 40 | lblBathroomSwitch: TLabel; 41 | btnMeal1: TButton; 42 | lstMeals: TListBox; 43 | btnMeal2: TButton; 44 | btnHandleRequests: TButton; 45 | lstHandlerOutput: TListBox; 46 | plspAbstractFactory: TJvStandardPage; 47 | plspAdapter: TJvStandardPage; 48 | plspBridge: TJvStandardPage; 49 | plspBuilder: TJvStandardPage; 50 | plspChainOfResponsibility: TJvStandardPage; 51 | plspCommand: TJvStandardPage; 52 | plspFactoryMethod: TJvStandardPage; 53 | plspObjectPool: TJvStandardPage; 54 | plspPrototype: TJvStandardPage; 55 | plspSingleton: TJvStandardPage; 56 | plspComposite: TJvStandardPage; 57 | plspDecorator: TJvStandardPage; 58 | plspFacade: TJvStandardPage; 59 | plspFlyweight: TJvStandardPage; 60 | plspPrivateClassData: TJvStandardPage; 61 | plspProxy: TJvStandardPage; 62 | plspInterpreter: TJvStandardPage; 63 | plspIterator: TJvStandardPage; 64 | plspMediator: TJvStandardPage; 65 | plspMemento: TJvStandardPage; 66 | plspNullObject: TJvStandardPage; 67 | plspObserver: TJvStandardPage; 68 | plspState: TJvStandardPage; 69 | plspStrategy: TJvStandardPage; 70 | plspTemplateMethod: TJvStandardPage; 71 | plspVisitor: TJvStandardPage; 72 | edtOrderName: TEdit; 73 | btnAddOrder: TButton; 74 | lstCookWorkLog: TListBox; 75 | mmoStructure: TMemo; 76 | btnCreateTreeStructure: TButton; 77 | procedure btnCreateCarClick(Sender: TObject); 78 | procedure FormCreate(Sender: TObject); 79 | procedure btnAddCustomerClick(Sender: TObject); 80 | procedure FormDestroy(Sender: TObject); 81 | procedure swKitchenOn(Sender: TObject); 82 | procedure swKitchenOff(Sender: TObject); 83 | procedure swBathroomOn(Sender: TObject); 84 | procedure swBathroomOff(Sender: TObject); 85 | procedure btnMeal1Click(Sender: TObject); 86 | procedure btnMeal2Click(Sender: TObject); 87 | procedure btnHandleRequestsClick(Sender: TObject); 88 | procedure edtOrderNameChange(Sender: TObject); 89 | procedure btnAddOrderClick(Sender: TObject); 90 | procedure btnCreateTreeStructureClick(Sender: TObject); 91 | private 92 | FSwitchAbstraction: TSwitchAbstraction; 93 | FKitchenSwitch: ISwitch; 94 | FBathroomSwitch: ISwitch; 95 | FConcreteHandler1: THandler; 96 | FConcreteHandler2: THandler; 97 | FConcreteHandler3: THandler; 98 | end; 99 | 100 | var 101 | frmDemo: TfrmDemo; 102 | 103 | implementation 104 | 105 | uses 106 | AbstractCarFactory, 107 | Car, 108 | AdaptedCustomer, 109 | NewCustomer, 110 | Switch, 111 | Director, 112 | Builder, 113 | BuilderInterfaces, 114 | Invoker, 115 | Command, 116 | Receiver, 117 | Composite, 118 | Leaf; 119 | 120 | {$R *.dfm} 121 | 122 | procedure TfrmDemo.FormCreate(Sender: TObject); 123 | begin 124 | FSwitchAbstraction := TSwitchAbstraction.Create; 125 | 126 | FKitchenSwitch := TKitchenSwitch.Create; 127 | FBathroomSwitch := TBathroomSwitch.Create; 128 | 129 | FConcreteHandler1 := TConcreteHandler1.Create; 130 | FConcreteHandler2 := TConcreteHandler2.Create; 131 | FConcreteHandler3 := TConcreteHandler3.Create; 132 | end; 133 | 134 | procedure TfrmDemo.FormDestroy(Sender: TObject); 135 | begin 136 | FSwitchAbstraction.Free; 137 | 138 | FConcreteHandler3.Free; 139 | FConcreteHandler2.Free; 140 | FConcreteHandler1.Free; 141 | end; 142 | 143 | { Builder } 144 | 145 | procedure TfrmDemo.btnMeal1Click(Sender: TObject); 146 | var 147 | director: TDirector; 148 | mealBuilder1: IBuilder; 149 | product: IProduct; 150 | 151 | begin 152 | director := TDirector.Create; 153 | 154 | try 155 | mealBuilder1 := TMealBuilder1.Create; 156 | director.Construct(mealBuilder1); 157 | product := mealBuilder1.GetResult; 158 | 159 | lstMeals.Items.Add(product.Display) 160 | finally 161 | director.Free; 162 | end; 163 | end; 164 | 165 | procedure TfrmDemo.btnMeal2Click(Sender: TObject); 166 | var 167 | director: TDirector; 168 | mealBuilder2: IBuilder; 169 | product: IProduct; 170 | 171 | begin 172 | director := TDirector.Create; 173 | 174 | try 175 | mealBuilder2 := TMealBuilder2.Create; 176 | director.Construct(mealBuilder2); 177 | product := mealBuilder2.GetResult; 178 | 179 | lstMeals.Items.Add(product.Display) 180 | finally 181 | director.Free; 182 | end; 183 | end; 184 | 185 | { Adapter } 186 | 187 | procedure TfrmDemo.btnAddCustomerClick(Sender: TObject); 188 | var 189 | customerID: Integer; 190 | customer: TNewCustomer; 191 | 192 | begin 193 | if string(edtCustomerId.Text).IsEmpty then 194 | Exit; 195 | 196 | customerID := StrToInt(edtCustomerId.Text); 197 | 198 | customer := TAdaptedCustomer.GetCustomer(customerID); 199 | try 200 | try 201 | lstCustomers.Items.Add(customer.ToString); 202 | except on E: Exception do 203 | ShowMessage(E.Message); 204 | end; 205 | finally 206 | customer.Free; 207 | end; 208 | 209 | edtCustomerId.Clear; 210 | end; 211 | 212 | { AbstractFactory } 213 | 214 | procedure TfrmDemo.btnCreateCarClick(Sender: TObject); 215 | var 216 | carFactory: TAbstractCarFactory; 217 | car: TAbstractCar; 218 | 219 | begin 220 | if cbbFactorySelect.ItemIndex < 0 then 221 | Exit; 222 | 223 | try 224 | with cbbFactorySelect do 225 | begin 226 | case ItemIndex of 227 | 0: carFactory := TRenaultFactory.Create; 228 | 1: carFactory := TVolvoFactory.Create; 229 | 2: carFactory := TMercedesFactory.Create; 230 | end; 231 | end; 232 | 233 | car := carFactory.GetCar; 234 | lstCarsCreated.Items.Add(car.GetName); 235 | finally 236 | car.Free; 237 | carFactory.Free; 238 | end; 239 | end; 240 | 241 | { Bridge } 242 | 243 | procedure TfrmDemo.swBathroomOff(Sender: TObject); 244 | begin 245 | FSwitchAbstraction.Switch := FBathroomSwitch; 246 | lstSwitchInfo.Items.Add(FSwitchAbstraction.TurnOff); 247 | end; 248 | 249 | procedure TfrmDemo.swBathroomOn(Sender: TObject); 250 | begin 251 | FSwitchAbstraction.Switch := FBathroomSwitch; 252 | lstSwitchInfo.Items.Add(FSwitchAbstraction.TurnOn); 253 | end; 254 | 255 | procedure TfrmDemo.swKitchenOff(Sender: TObject); 256 | begin 257 | FSwitchAbstraction.Switch := FKitchenSwitch; 258 | lstSwitchInfo.Items.Add(FSwitchAbstraction.TurnOff); 259 | end; 260 | 261 | procedure TfrmDemo.swKitchenOn(Sender: TObject); 262 | begin 263 | FSwitchAbstraction.Switch := FKitchenSwitch; 264 | lstSwitchInfo.Items.Add(FSwitchAbstraction.TurnOn); 265 | end; 266 | 267 | { Chain Of Responsibility } 268 | 269 | procedure TfrmDemo.btnHandleRequestsClick(Sender: TObject); 270 | var 271 | requests: TArray; 272 | request: SmallInt; 273 | 274 | begin 275 | requests := TArray.Create(2, 5, 14, 22, 18, 3, 27, 20); 276 | 277 | FConcreteHandler1.Successor := FConcreteHandler2; 278 | FConcreteHandler2.Successor := FConcreteHandler3; 279 | 280 | for request in requests do 281 | lstHandlerOutput.Items.Add(FConcreteHandler1.HandleRequest(request)); 282 | end; 283 | 284 | { Command } 285 | 286 | procedure TfrmDemo.edtOrderNameChange(Sender: TObject); 287 | begin 288 | btnAddOrder.Enabled := Length(edtOrderName.Text) > 3; 289 | end; 290 | 291 | procedure TfrmDemo.btnAddOrderClick(Sender: TObject); 292 | var 293 | receiver: TReceiver; 294 | command: TCommand; 295 | invoker: TInvoker; 296 | 297 | begin 298 | receiver := TReceiver.Create(edtOrderName.Text); 299 | command := TConcreteCommand.Create(receiver); 300 | invoker := TInvoker.Create; 301 | 302 | try 303 | invoker.SetCommand(command); 304 | 305 | lstCookWorkLog.Items.Add(invoker.ExecuteCommand); 306 | finally 307 | invoker.Free; 308 | command.Free; 309 | receiver.Free; 310 | end; 311 | 312 | edtOrderName.SetFocus; 313 | edtOrderName.Clear; 314 | end; 315 | 316 | { Composite } 317 | 318 | procedure TfrmDemo.btnCreateTreeStructureClick(Sender: TObject); 319 | var 320 | root: TComposite; 321 | compositeX: TComposite; 322 | leaf: TLeaf; 323 | 324 | begin 325 | mmoStructure.Clear; 326 | 327 | root := TComposite.Create('root'); 328 | compositeX := TComposite.Create('Composite X'); 329 | 330 | try 331 | root.Add(TLeaf.Create('Leaf A')); 332 | root.Add(TLeaf.Create('Leaf B')); 333 | 334 | compositeX.Add(TLeaf.Create('Leaf XA')); 335 | compositeX.Add(TLeaf.Create('Leaf XB')); 336 | 337 | root.Add(compositeX); 338 | root.Add(TLeaf.Create('Leaf C')); 339 | 340 | leaf := TLeaf.Create('Leaf D'); 341 | 342 | root.Add(leaf); 343 | root.Remove(leaf); 344 | 345 | mmoStructure.Lines.AddStrings(root.Display(1)); 346 | finally 347 | root.Free; 348 | end; 349 | end; 350 | 351 | end. 352 | -------------------------------------------------------------------------------- /despat.dpr: -------------------------------------------------------------------------------- 1 | program despat; 2 | 3 | uses 4 | Vcl.Forms, 5 | DemoForm in 'DemoForm.pas' {frmDemo}, 6 | AbstractCarFactory in 'AbstractFactory\AbstractCarFactory.pas', 7 | Car in 'AbstractFactory\Car.pas', 8 | NewCustomer in 'Adapter\NewCustomer.pas', 9 | OldCustomer in 'Adapter\OldCustomer.pas', 10 | AdaptedCustomer in 'Adapter\AdaptedCustomer.pas', 11 | SwitchAbstraction in 'Bridge\SwitchAbstraction.pas', 12 | Switch in 'Bridge\Switch.pas', 13 | SwitchInterface in 'Bridge\SwitchInterface.pas', 14 | Builder in 'Builder\Builder.pas', 15 | Product in 'Builder\Product.pas', 16 | BuilderInterfaces in 'Builder\BuilderInterfaces.pas', 17 | Director in 'Builder\Director.pas', 18 | Handler in 'ChainOfResponsibility\Handler.pas', 19 | Command in 'Command\Command.pas', 20 | Receiver in 'Command\Receiver.pas', 21 | Invoker in 'Command\Invoker.pas', 22 | Component in 'Composite\Component.pas', 23 | Composite in 'Composite\Composite.pas', 24 | Leaf in 'Composite\Leaf.pas'; 25 | 26 | {$R *.res} 27 | 28 | begin 29 | {$IFDEF DEBUG} 30 | ReportMemoryLeaksOnShutdown := True; 31 | {$ENDIF} 32 | 33 | Application.Initialize; 34 | Application.MainFormOnTaskbar := True; 35 | Application.CreateForm(TfrmDemo, frmDemo); 36 | Application.Run; 37 | end. 38 | -------------------------------------------------------------------------------- /despat.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {D361713A-4A50-4F44-BAAC-BA3C1202448F} 4 | 16.0 5 | VCL 6 | despat.dpr 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Application 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) 44 | despat 45 | $(BDS)\bin\delphi_PROJECTICON.ico 46 | .\$(Platform)\$(Config) 47 | .\$(Platform)\$(Config) 48 | false 49 | false 50 | false 51 | false 52 | false 53 | 54 | 55 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 56 | $(BDS)\bin\default_app.manifest 57 | true 58 | JvBDE;JvGlobus;JvMM;JvManagedThreads;FireDACSqliteDriver;FireDACDSDriver;DBXSqliteDriver;FireDACPgDriver;fmx;JvDlgs;IndySystem;JvCrypt;tethering;inetdbbde;vclib;DBXInterBaseDriver;DataSnapClient;DataSnapServer;DataSnapCommon;JvNet;DataSnapProviderClient;JvDotNetCtrls;DBXSybaseASEDriver;DbxCommonDriver;vclimg;dbxcds;DatasnapConnectorsFreePascal;MetropolisUILiveTile;JvXPCtrls;vcldb;vcldsnap;fmxFireDAC;DBXDb2Driver;DBXOracleDriver;CustomIPTransport;JvCore;vclribbon;dsnap;IndyIPServer;fmxase;vcl;IndyCore;DBXMSSQLDriver;IndyIPCommon;CloudService;FireDACIBDriver;DataSnapFireDAC;FireDACDBXDriver;JvAppFrm;soapserver;JvDB;JvRuntimeDesign;inetdbxpress;dsnapxml;FireDACInfxDriver;FireDACDb2Driver;JclDeveloperTools;JvDocking;adortl;JvWizards;FireDACASADriver;JvHMI;bindcompfmx;nrcommd20;JvBands;vcldbx;FireDACODBCDriver;RESTBackendComponents;rtl;dbrtl;DbxClientDriver;FireDACCommon;bindcomp;inetdb;JvPluginSystem;JclContainers;DBXOdbcDriver;JvCmp;vclFireDAC;JvSystem;xmlrtl;DataSnapNativeClient;svnui;ibxpress;JvControls;JvTimeFramework;IndyProtocols;DBXMySQLDriver;FireDACCommonDriver;bindcompdbx;bindengine;vclactnband;soaprtl;JvJans;JvPageComps;bindcompvcl;JvStdCtrls;JvCustom;Jcl;vclie;JvPrintPreview;FireDACADSDriver;vcltouch;VclSmp;FireDACMSSQLDriver;FireDAC;DBXInformixDriver;VCLRESTComponents;DataSnapConnectors;DataSnapServerMidas;dsnapcon;DBXFirebirdDriver;inet;fmxobj;JclVcl;JvPascalInterpreter;FireDACMySQLDriver;soapmidas;vclx;svn;DBXSybaseASADriver;FireDACOracleDriver;fmxdae;RESTComponents;bdertl;FireDACMSAccDriver;dbexpress;DataSnapIndy10ServerTransport;IndyIPClient;$(DCC_UsePackage) 59 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 60 | 1033 61 | 62 | 63 | FireDACSqliteDriver;FireDACDSDriver;DBXSqliteDriver;FireDACPgDriver;fmx;IndySystem;tethering;vclib;DBXInterBaseDriver;DataSnapClient;DataSnapServer;DataSnapCommon;DataSnapProviderClient;DBXSybaseASEDriver;DbxCommonDriver;vclimg;dbxcds;DatasnapConnectorsFreePascal;MetropolisUILiveTile;vcldb;vcldsnap;fmxFireDAC;DBXDb2Driver;DBXOracleDriver;CustomIPTransport;vclribbon;dsnap;IndyIPServer;fmxase;vcl;IndyCore;DBXMSSQLDriver;IndyIPCommon;CloudService;FireDACIBDriver;DataSnapFireDAC;FireDACDBXDriver;soapserver;inetdbxpress;dsnapxml;FireDACInfxDriver;FireDACDb2Driver;adortl;FireDACASADriver;bindcompfmx;FireDACODBCDriver;RESTBackendComponents;rtl;dbrtl;DbxClientDriver;FireDACCommon;bindcomp;inetdb;DBXOdbcDriver;vclFireDAC;xmlrtl;DataSnapNativeClient;ibxpress;IndyProtocols;DBXMySQLDriver;FireDACCommonDriver;bindcompdbx;bindengine;vclactnband;soaprtl;bindcompvcl;vclie;FireDACADSDriver;vcltouch;VclSmp;FireDACMSSQLDriver;FireDAC;DBXInformixDriver;VCLRESTComponents;DataSnapConnectors;DataSnapServerMidas;dsnapcon;DBXFirebirdDriver;inet;fmxobj;FireDACMySQLDriver;soapmidas;vclx;DBXSybaseASADriver;FireDACOracleDriver;fmxdae;RESTComponents;FireDACMSAccDriver;dbexpress;DataSnapIndy10ServerTransport;IndyIPClient;$(DCC_UsePackage) 64 | 65 | 66 | DEBUG;$(DCC_Define) 67 | true 68 | false 69 | true 70 | true 71 | true 72 | 73 | 74 | false 75 | 76 | 77 | false 78 | RELEASE;$(DCC_Define) 79 | 0 80 | 0 81 | 82 | 83 | 84 | MainSource 85 | 86 | 87 |
frmDemo
88 | dfm 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | Cfg_2 111 | Base 112 | 113 | 114 | Base 115 | 116 | 117 | Cfg_1 118 | Base 119 | 120 | 121 | 122 | Delphi.Personality.12 123 | 124 | 125 | 126 | 127 | despat.dpr 128 | 129 | 130 | 131 | 132 | 133 | despat.exe 134 | true 135 | 136 | 137 | 138 | 139 | 1 140 | .dylib 141 | 142 | 143 | 0 144 | .bpl 145 | 146 | 147 | Contents\MacOS 148 | 1 149 | .dylib 150 | 151 | 152 | 1 153 | .dylib 154 | 155 | 156 | 157 | 158 | 1 159 | .dylib 160 | 161 | 162 | 0 163 | .dll;.bpl 164 | 165 | 166 | Contents\MacOS 167 | 1 168 | .dylib 169 | 170 | 171 | 1 172 | .dylib 173 | 174 | 175 | 176 | 177 | 1 178 | 179 | 180 | 1 181 | 182 | 183 | 184 | 185 | Contents 186 | 1 187 | 188 | 189 | 190 | 191 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 192 | 1 193 | 194 | 195 | 196 | 197 | res\drawable-normal 198 | 1 199 | 200 | 201 | 202 | 203 | library\lib\x86 204 | 1 205 | 206 | 207 | 208 | 209 | 1 210 | 211 | 212 | 1 213 | 214 | 215 | 216 | 217 | Contents 218 | 1 219 | 220 | 221 | 222 | 223 | library\lib\armeabi-v7a 224 | 1 225 | 226 | 227 | 228 | 229 | 1 230 | 231 | 232 | 1 233 | 234 | 235 | 236 | 237 | res\drawable-xlarge 238 | 1 239 | 240 | 241 | 242 | 243 | res\drawable-xhdpi 244 | 1 245 | 246 | 247 | 248 | 249 | 1 250 | 251 | 252 | 1 253 | 254 | 255 | 256 | 257 | res\drawable-xxhdpi 258 | 1 259 | 260 | 261 | 262 | 263 | library\lib\mips 264 | 1 265 | 266 | 267 | 268 | 269 | res\drawable 270 | 1 271 | 272 | 273 | 274 | 275 | Contents\MacOS 276 | 1 277 | 278 | 279 | 1 280 | 281 | 282 | 0 283 | 284 | 285 | 286 | 287 | Contents\MacOS 288 | 1 289 | .framework 290 | 291 | 292 | 0 293 | 294 | 295 | 296 | 297 | res\drawable-small 298 | 1 299 | 300 | 301 | 302 | 303 | 1 304 | 305 | 306 | 307 | 308 | Contents\MacOS 309 | 1 310 | 311 | 312 | 1 313 | 314 | 315 | Contents\MacOS 316 | 0 317 | 318 | 319 | 320 | 321 | classes 322 | 1 323 | 324 | 325 | 326 | 327 | 1 328 | 329 | 330 | 1 331 | 332 | 333 | 334 | 335 | 1 336 | 337 | 338 | 1 339 | 340 | 341 | 342 | 343 | res\drawable 344 | 1 345 | 346 | 347 | 348 | 349 | Contents\Resources 350 | 1 351 | 352 | 353 | 354 | 355 | 1 356 | 357 | 358 | 359 | 360 | 1 361 | 362 | 363 | 1 364 | 365 | 366 | 367 | 368 | 1 369 | 370 | 371 | library\lib\armeabi-v7a 372 | 1 373 | 374 | 375 | 0 376 | 377 | 378 | Contents\MacOS 379 | 1 380 | 381 | 382 | 1 383 | 384 | 385 | 386 | 387 | library\lib\armeabi 388 | 1 389 | 390 | 391 | 392 | 393 | res\drawable-large 394 | 1 395 | 396 | 397 | 398 | 399 | 0 400 | 401 | 402 | 0 403 | 404 | 405 | 0 406 | 407 | 408 | Contents\MacOS 409 | 0 410 | 411 | 412 | 0 413 | 414 | 415 | 416 | 417 | 1 418 | 419 | 420 | 1 421 | 422 | 423 | 424 | 425 | res\drawable-ldpi 426 | 1 427 | 428 | 429 | 430 | 431 | res\values 432 | 1 433 | 434 | 435 | 436 | 437 | 1 438 | 439 | 440 | 1 441 | 442 | 443 | 444 | 445 | res\drawable-mdpi 446 | 1 447 | 448 | 449 | 450 | 451 | res\drawable-hdpi 452 | 1 453 | 454 | 455 | 456 | 457 | 1 458 | 459 | 460 | 461 | 462 | 463 | 464 | 465 | 466 | 467 | 468 | True 469 | False 470 | 471 | 472 | 12 473 | 474 | 475 | 476 | 477 | 478 | -------------------------------------------------------------------------------- /despat.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jaxx/delphi-design-patterns-examples/14b1f9c535d291439893ad0f8418dc63001bceed/despat.res --------------------------------------------------------------------------------