.Create;
29 | end;
30 |
31 | destructor TTrivialXmlWriter.Destroy;
32 | begin
33 | while fNodes.Count > 0 do
34 | WriteEndElement;
35 | fNodes.Free;
36 | inherited;
37 | end;
38 |
39 | procedure TTrivialXmlWriter.WriteEndElement;
40 | begin
41 | fWriter.Write('');
42 | end;
43 |
44 | procedure TTrivialXmlWriter.WriteStartElement(const sName: string);
45 | begin
46 | fWriter.Write('<' + sName + '>');
47 | fNodes.Push (sname);
48 | end;
49 |
50 | procedure TTrivialXmlWriter.WriteString(const sValue: string);
51 | begin
52 | fWriter.Write(sValue);
53 | end;
54 |
55 | end.
56 |
--------------------------------------------------------------------------------
/03/RttiIntro/RttiIntro_MainForm.pas:
--------------------------------------------------------------------------------
1 | unit RttiIntro_MainForm;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, StdCtrls;
8 |
9 | type
10 | TFormRttiIntro = class(TForm)
11 | btnInfo: TButton;
12 | Memo1: TMemo;
13 | btnChange: TButton;
14 | procedure btnInfoClick(Sender: TObject);
15 | procedure btnChangeClick(Sender: TObject);
16 | private
17 | { Private declarations }
18 | public
19 | procedure Log (const strMsg: string);
20 | end;
21 |
22 | var
23 | FormRttiIntro: TFormRttiIntro;
24 |
25 | implementation
26 |
27 | {$R *.dfm}
28 |
29 | uses
30 | Rtti;
31 |
32 |
33 | procedure TFormRttiIntro.btnChangeClick(Sender: TObject);
34 | var
35 | context: TRttiContext;
36 | aProp: TRttiProperty;
37 | begin
38 | aProp := context.GetType(TButton).GetProperty('Caption');
39 | aProp.SetValue(btnChange, StringOfChar ('*', random (10) + 1));
40 | end;
41 |
42 | procedure TFormRttiIntro.btnInfoClick(Sender: TObject);
43 | var
44 | context: TRttiContext;
45 | begin
46 | Log (context.
47 | GetType(TButton).
48 | GetProperty('Caption').
49 | GetValue(Sender).ToString);
50 | end;
51 |
52 | procedure TFormRttiIntro.Log(const strMsg: string);
53 | begin
54 | Memo1.Lines.Add (strMsg);
55 | end;
56 |
57 | end.
58 |
--------------------------------------------------------------------------------
/05/GetOSVersion/GetOSVersionForm.pas:
--------------------------------------------------------------------------------
1 | unit GetOSVersionForm;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, StdCtrls;
8 |
9 | type
10 | TForm8 = class(TForm)
11 | btnGetVersion: TButton;
12 | Memo1: TMemo;
13 | procedure btnGetVersionClick(Sender: TObject);
14 | private
15 | { Private declarations }
16 | public
17 | procedure Log (const strMsg: string);
18 | end;
19 |
20 | var
21 | Form8: TForm8;
22 |
23 | implementation
24 |
25 | {$R *.dfm}
26 |
27 | function IsVista: Boolean;
28 | begin
29 | Result := lobyte(loword (GetVersion)) = 6;
30 | end;
31 |
32 | procedure TForm8.btnGetVersionClick(Sender: TObject);
33 | begin
34 | Log ('IsVista: ' + BoolToStr (IsVista, True));
35 | Log ('Win32MajorVersion: ' + IntToStr(Win32MajorVersion));
36 | Log ('Win32MinorVersion: ' + IntToStr(Win32MinorVersion));
37 | Log ('Win32BuildNumber: ' + IntToStr(Win32BuildNumber));
38 | // any use?
39 | // Memo1.Lines.Add ('Win32CSDVersion: ' + Win32CSDVersion);
40 | if CheckWin32Version(6) then
41 | Log ('Running at least on Vista');
42 | if CheckWin32Version(6, 1) then
43 | Log ('Running on 7');
44 | end;
45 |
46 | procedure TForm8.Log(const strMsg: string);
47 | begin
48 | Memo1.Lines.Add (strMsg);
49 | end;
50 |
51 | end.
52 |
--------------------------------------------------------------------------------
/08/DataRestServer/jRestClientSimple.html:
--------------------------------------------------------------------------------
1 |
2 |
3 | jQuery and Delphi 2010 REST
5 |
6 |
7 |
33 |
34 |
35 |
36 | jQuery and Delphi 2010 REST
37 |
38 | This is your data
39 |
Result goes here:
41 |
42 |
43 |
--------------------------------------------------------------------------------
/07/First3TierHttp/First3TierHttp_ServerMainForm.dfm:
--------------------------------------------------------------------------------
1 | object FormFirst3Tier2009Server: TFormFirst3Tier2009Server
2 | Left = 0
3 | Top = 0
4 | Caption = 'First3TierHttp Server'
5 | ClientHeight = 227
6 | ClientWidth = 438
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 | PixelsPerInch = 96
16 | TextHeight = 13
17 | object Memo1: TMemo
18 | Left = 0
19 | Top = 0
20 | Width = 438
21 | Height = 227
22 | Align = alClient
23 | TabOrder = 0
24 | end
25 | object DSServer1: TDSServer
26 | OnConnect = DSServer1Connect
27 | OnDisconnect = DSServer1Disconnect
28 | AutoStart = True
29 | HideDSAdmin = False
30 | Left = 120
31 | Top = 176
32 | end
33 | object DSServerClass1: TDSServerClass
34 | OnGetClass = DSServerClass1GetClass
35 | Server = DSServer1
36 | LifeCycle = 'Session'
37 | Left = 336
38 | Top = 176
39 | end
40 | object DSHTTPService1: TDSHTTPService
41 | RESTContext = 'rest'
42 | Server = DSServer1
43 | DSHostname = 'localhost'
44 | DSPort = 0
45 | Filters = <>
46 | HttpPort = 8090
47 | Active = False
48 | Left = 216
49 | Top = 176
50 | end
51 | end
52 |
--------------------------------------------------------------------------------
/07/First3TierHttp/First3TierHttp_ServerModule.pas:
--------------------------------------------------------------------------------
1 | unit First3TierHttp_ServerModule;
2 |
3 | interface
4 |
5 | uses
6 | SysUtils, Classes, DSServer, WideStrings, DBXInterbase, FMTBcd, Provider, DB,
7 | SqlExpr, DSCommonServer, DSTCPServerTransport, DBXFirebird;
8 |
9 | type
10 | TDSFirst3TierServerModule = class(TDSServerModule)
11 | EMPLOYEE: TSQLDataSet;
12 | DataSetProviderEmployee: TDataSetProvider;
13 | EMPLOYEEEMP_NO: TSmallintField;
14 | EMPLOYEEFIRST_NAME: TStringField;
15 | EMPLOYEELAST_NAME: TStringField;
16 | EMPLOYEEPHONE_EXT: TStringField;
17 | EMPLOYEEHIRE_DATE: TSQLTimeStampField;
18 | EMPLOYEEDEPT_NO: TStringField;
19 | EMPLOYEEJOB_CODE: TStringField;
20 | EMPLOYEEJOB_GRADE: TSmallintField;
21 | EMPLOYEEJOB_COUNTRY: TStringField;
22 | EMPLOYEESALARY: TFMTBCDField;
23 | EMPLOYEEFULL_NAME: TStringField;
24 | FBCONNECTION: TSQLConnection;
25 | private
26 | { Private declarations }
27 | public
28 | function GetHello: string;
29 | end;
30 |
31 | var
32 | DSFirst3TierServerModule: TDSFirst3TierServerModule;
33 |
34 | implementation
35 |
36 | {$R *.dfm}
37 |
38 | { TDSFirst3TierServerModule }
39 |
40 | function TDSFirst3TierServerModule.GetHello: string;
41 | begin
42 | Result := 'Hello from TDSFirst3TierServerModule at ' + TimeToStr (Now);
43 | end;
44 |
45 | end.
--------------------------------------------------------------------------------
/02/NamedThreads/NamedThreadsMainForm.dfm:
--------------------------------------------------------------------------------
1 | object FormNamedThreads: TFormNamedThreads
2 | Left = 0
3 | Top = 0
4 | Caption = 'NamedThreads'
5 | ClientHeight = 327
6 | ClientWidth = 554
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 | PixelsPerInch = 96
16 | TextHeight = 13
17 | object btnCreate: TButton
18 | Left = 24
19 | Top = 30
20 | Width = 99
21 | Height = 25
22 | Caption = 'btnCreate'
23 | TabOrder = 0
24 | OnClick = btnCreateClick
25 | end
26 | object btnTerminate: TButton
27 | Left = 24
28 | Top = 80
29 | Width = 99
30 | Height = 25
31 | Caption = 'btnTerminate'
32 | TabOrder = 1
33 | OnClick = btnTerminateClick
34 | end
35 | object StatusBar1: TStatusBar
36 | Left = 0
37 | Top = 308
38 | Width = 554
39 | Height = 19
40 | Panels = <>
41 | ExplicitLeft = 120
42 | ExplicitTop = 264
43 | ExplicitWidth = 0
44 | end
45 | object Memo1: TMemo
46 | Left = 144
47 | Top = 32
48 | Width = 393
49 | Height = 257
50 | TabOrder = 3
51 | end
52 | object Timer1: TTimer
53 | OnTimer = Timer1Timer
54 | Left = 64
55 | Top = 160
56 | end
57 | end
58 |
--------------------------------------------------------------------------------
/08/FirstSimpleRestServer/jRestClient.html:
--------------------------------------------------------------------------------
1 |
2 |
3 | jQuery and Delphi 2010 REST
5 |
6 |
7 |
22 |
23 |
24 |
25 | jQuery and Delphi 2010 REST
26 |
27 | This example demonstrates basic use of jQuery calling a barebones Delphi 2010 REST server.
28 |
29 | Insert the text to "Echo":
30 |
Result goes here:
36 |
37 |
38 |
--------------------------------------------------------------------------------
/06/KeyboardTest/KeyboardTest_MainForm.dfm:
--------------------------------------------------------------------------------
1 | object KeyboardForm: TKeyboardForm
2 | Left = 0
3 | Top = 0
4 | Caption = 'KeyboardTest'
5 | ClientHeight = 340
6 | ClientWidth = 674
7 | Color = clBtnFace
8 | Font.Charset = DEFAULT_CHARSET
9 | Font.Color = clWindowText
10 | Font.Height = -15
11 | Font.Name = 'Segoe UI'
12 | Font.Style = []
13 | OldCreateOrder = False
14 | Scaled = False
15 | PixelsPerInch = 96
16 | TextHeight = 20
17 | object TouchKeyboard1: TTouchKeyboard
18 | Left = 32
19 | Top = 88
20 | Width = 623
21 | Height = 233
22 | GradientEnd = clSilver
23 | GradientStart = clGray
24 | Layout = 'Standard'
25 | end
26 | object LabeledEdit1: TLabeledEdit
27 | Left = 32
28 | Top = 40
29 | Width = 265
30 | Height = 28
31 | EditLabel.Width = 87
32 | EditLabel.Height = 20
33 | EditLabel.Caption = 'LabeledEdit1'
34 | TabOrder = 1
35 | end
36 | object LabeledEdit2: TLabeledEdit
37 | Left = 303
38 | Top = 40
39 | Width = 273
40 | Height = 28
41 | EditLabel.Width = 87
42 | EditLabel.Height = 20
43 | EditLabel.Caption = 'LabeledEdit2'
44 | TabOrder = 2
45 | end
46 | object btnTest: TButton
47 | Left = 582
48 | Top = 39
49 | Width = 73
50 | Height = 31
51 | Caption = 'Test'
52 | TabOrder = 3
53 | OnClick = btnTestClick
54 | end
55 | end
56 |
--------------------------------------------------------------------------------
/03/RttiAccess/RttiAccessMainForm.dfm:
--------------------------------------------------------------------------------
1 | object Form39: TForm39
2 | Left = 0
3 | Top = 0
4 | Caption = 'RttiAcccess'
5 | ClientHeight = 292
6 | ClientWidth = 560
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 | PixelsPerInch = 96
15 | TextHeight = 13
16 | object btnReadValues: TButton
17 | Left = 32
18 | Top = 24
19 | Width = 121
20 | Height = 25
21 | Caption = 'btnReadValues'
22 | TabOrder = 0
23 | OnClick = btnReadValuesClick
24 | end
25 | object btnInvoke: TButton
26 | Left = 32
27 | Top = 80
28 | Width = 121
29 | Height = 25
30 | Caption = 'btnInvoke'
31 | TabOrder = 1
32 | OnClick = btnInvokeClick
33 | end
34 | object btnSet: TButton
35 | Left = 32
36 | Top = 176
37 | Width = 121
38 | Height = 25
39 | Caption = 'btnSet'
40 | TabOrder = 2
41 | OnClick = btnSetClick
42 | end
43 | object Memo1: TMemo
44 | Left = 176
45 | Top = 24
46 | Width = 361
47 | Height = 241
48 | TabOrder = 3
49 | end
50 | object btnLowLevel: TButton
51 | Left = 32
52 | Top = 129
53 | Width = 121
54 | Height = 25
55 | Caption = 'btnLowLevel'
56 | TabOrder = 4
57 | OnClick = btnLowLevelClick
58 | end
59 | end
60 |
--------------------------------------------------------------------------------
/04/ClassCtor/ClassCtorMainForm.pas:
--------------------------------------------------------------------------------
1 | unit ClassCtorMainForm;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, StdCtrls;
8 |
9 | type
10 | TForm39 = class(TForm)
11 | Button1: TButton;
12 | procedure Button1Click(Sender: TObject);
13 | private
14 | { Private declarations }
15 | public
16 | { Public declarations }
17 | end;
18 |
19 | var
20 | Form39: TForm39;
21 |
22 | implementation
23 |
24 | {$R *.dfm}
25 |
26 | type
27 | TTestClass = class
28 | public
29 | class var
30 | StartTime: TDateTime;
31 | EndTime: TDateTime;
32 | public
33 | class constructor Create;
34 | // class constructor Foo;
35 | class destructor Destroyer;
36 | end;
37 |
38 |
39 |
40 | procedure TForm39.Button1Click(Sender: TObject);
41 | begin
42 | ShowMessage (TimeToStr (TTestClass.StartTime));
43 | end;
44 |
45 | { TTestClass }
46 |
47 | class constructor TTestClass.Create;
48 | begin
49 | StartTime := Now;
50 | end;
51 |
52 | class destructor TTestClass.Destroyer;
53 | begin
54 | EndTime := Now;
55 | end;
56 |
57 | //class constructor TTestClass.Foo;
58 | //begin
59 | // ShowMessage ('Foo');
60 | //end;
61 |
62 | initialization
63 | ShowMessage (TimeToStr (TTestClass.StartTime));
64 |
65 | finalization
66 | ShowMessage (TimeToStr (TTestClass.EndTime));
67 |
68 | end.
69 |
--------------------------------------------------------------------------------
/07/DSnapWebAppDebug/DSnapServerMethods.dfm:
--------------------------------------------------------------------------------
1 | object ServerMethods1: TServerMethods1
2 | OldCreateOrder = False
3 | Height = 306
4 | Width = 312
5 | object DataSetProvider1: TDataSetProvider
6 | DataSet = CUSTOMER
7 | Left = 144
8 | Top = 136
9 | end
10 | object FBCONNECTION: TSQLConnection
11 | ConnectionName = 'FBCONNECTION'
12 | DriverName = 'Firebird'
13 | GetDriverFunc = 'getSQLDriverINTERBASE'
14 | LibraryName = 'dbxfb.dll'
15 | LoginPrompt = False
16 | Params.Strings = (
17 | ';DelegateConnection=DBXTraceConnection'
18 | 'drivername=Firebird'
19 |
20 | 'Database=localhost:C:/Program Files/Firebird/Firebird2.1/example' +
21 | 's/empbuild/employee.fdb'
22 | 'rolename=RoleName'
23 | 'user_name=sysdba'
24 | 'password=masterkey'
25 | 'sqldialect=3'
26 | 'localecode=0000'
27 | 'blobsize=-1'
28 | 'commitretain=False'
29 | 'waitonlocks=True'
30 | 'isolationlevel=ReadCommitted'
31 | 'trim char=False')
32 | VendorLib = 'fbclient.DLL'
33 | Left = 32
34 | Top = 32
35 | end
36 | object CUSTOMER: TSQLDataSet
37 | CommandText = 'CUSTOMER'
38 | CommandType = ctTable
39 | DbxCommandType = 'Dbx.Table'
40 | MaxBlobSize = -1
41 | Params = <>
42 | SQLConnection = FBCONNECTION
43 | Left = 43
44 | Top = 99
45 | end
46 | end
47 |
--------------------------------------------------------------------------------
/07/DSnapJson/DSnapJsonClient_MainForm.dfm:
--------------------------------------------------------------------------------
1 | object FormJsonClient: TFormJsonClient
2 | Left = 0
3 | Top = 0
4 | Caption = 'DsnapJsonClient'
5 | ClientHeight = 325
6 | ClientWidth = 598
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 btnValue: TButton
19 | Left = 24
20 | Top = 22
21 | Width = 113
22 | Height = 25
23 | Caption = 'btnValue'
24 | TabOrder = 0
25 | OnClick = btnValueClick
26 | end
27 | object btnArray: TButton
28 | Left = 24
29 | Top = 64
30 | Width = 113
31 | Height = 25
32 | Caption = 'btnArray'
33 | TabOrder = 1
34 | OnClick = btnArrayClick
35 | end
36 | object btnMarshal: TButton
37 | Left = 24
38 | Top = 112
39 | Width = 113
40 | Height = 25
41 | Caption = 'btnMarshal'
42 | TabOrder = 2
43 | OnClick = btnMarshalClick
44 | end
45 | object Memo1: TMemo
46 | Left = 160
47 | Top = 24
48 | Width = 417
49 | Height = 281
50 | TabOrder = 3
51 | end
52 | object SQLConnection1: TSQLConnection
53 | DriverName = 'Datasnap'
54 | LoginPrompt = False
55 | Left = 32
56 | Top = 192
57 | end
58 | end
59 |
--------------------------------------------------------------------------------
/04/GenericClassCtor/GenericClassCtor_Classes.pas:
--------------------------------------------------------------------------------
1 | unit GenericClassCtor_Classes;
2 |
3 | interface
4 |
5 | uses
6 | Classes;
7 |
8 | type
9 | TGenericWithClassCtor = class
10 | private
11 | FData: T;
12 | procedure SetData(const Value: T);
13 | public
14 | class constructor Create;
15 | property Data: T read FData write SetData;
16 | class var
17 | DataSize: Integer;
18 | end;
19 |
20 | function ListSequence: TStringList;
21 |
22 | // procedure Useless; // not really needed
23 |
24 | implementation
25 |
26 | var // one for the unit (shared by all geenrics)
27 | sListSequence: TStringList;
28 |
29 | function ListSequence: TStringList;
30 | begin
31 | if not Assigned (sListSequence) then
32 | sListSequence := TStringList.Create;
33 | Result := sListSequence;
34 | end;
35 |
36 | // uncomment to show a double initialization
37 | //procedure Useless;
38 | //var
39 | // genStr: TGenericWithClassCtor ;
40 | //begin
41 | // genStr := TGenericWithClassCtor .Create;
42 | // genStr.Data := '100';
43 | // genStr.Free;
44 | //end;
45 |
46 | { TGenericWithClassCtor }
47 |
48 | class constructor TGenericWithClassCtor.Create;
49 | begin
50 | DataSize := SizeOf (T);
51 | ListSequence.Add(ClassName);
52 | end;
53 |
54 | procedure TGenericWithClassCtor.SetData(const Value: T);
55 | begin
56 | FData := Value;
57 | end;
58 |
59 | end.
60 |
--------------------------------------------------------------------------------
/07/DsnapMethodsCallback/DsnapMethodsServer_MainForm.dfm:
--------------------------------------------------------------------------------
1 | object FormDsnapMethodsServer: TFormDsnapMethodsServer
2 | Left = 0
3 | Top = 0
4 | Caption = 'DsnapMethodsServer'
5 | ClientHeight = 283
6 | ClientWidth = 434
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 | PixelsPerInch = 96
15 | TextHeight = 13
16 | object Memo1: TMemo
17 | Left = 8
18 | Top = 26
19 | Width = 401
20 | Height = 249
21 | TabOrder = 0
22 | end
23 | object DSServer1: TDSServer
24 | OnConnect = DSServer1Connect
25 | OnDisconnect = DSServer1Disconnect
26 | AutoStart = True
27 | HideDSAdmin = False
28 | Left = 48
29 | Top = 96
30 | end
31 | object DSServerClass1: TDSServerClass
32 | OnGetClass = DSServerClass1GetClass
33 | Server = DSServer1
34 | LifeCycle = 'Session'
35 | Left = 128
36 | Top = 128
37 | end
38 | object DSTCPServerTransport1: TDSTCPServerTransport
39 | PoolSize = 20
40 | Server = DSServer1
41 | BufferKBSize = 32
42 | Filters = <>
43 | Left = 88
44 | Top = 176
45 | end
46 | object DSServerClass2: TDSServerClass
47 | OnGetClass = DSServerClass2GetClass
48 | OnDestroyInstance = DSSC2DestroyInstance
49 | Server = DSServer1
50 | LifeCycle = 'Invocation'
51 | Left = 192
52 | Top = 200
53 | end
54 | end
55 |
--------------------------------------------------------------------------------
/08/DataRestServer/DataRestServer_ServerClass.pas:
--------------------------------------------------------------------------------
1 | unit DataRestServer_ServerClass;
2 |
3 | interface
4 |
5 | uses
6 | SysUtils, Classes, DSServer, DB, DBClient, dbxJson;
7 |
8 | type
9 | {$METHODINFO ON}
10 | TServerData = class(TDataModule)
11 | ClientDataSet1: TClientDataSet;
12 | private
13 | { Private declarations }
14 | public
15 | function Data: TJSONArray;
16 | function Meta: TJSONArray;
17 | end;
18 | {$METHODINFO OFF}
19 |
20 | var
21 | ServerData: TServerData;
22 |
23 | implementation
24 |
25 | {$R *.dfm}
26 |
27 | { TServerData }
28 |
29 | function TServerData.Data: TJSONArray;
30 | var
31 | jRecord: TJSONObject;
32 | I: Integer;
33 | begin
34 | ClientDataSet1.Open;
35 | Result := TJSonArray.Create;
36 |
37 | while not ClientDataSet1.EOF do
38 | begin
39 | jRecord := TJSONObject.Create;
40 | for I := 0 to ClientDataSet1.FieldCount - 1 do
41 | jRecord.AddPair(
42 | ClientDataSet1.Fields[I].FieldName,
43 | TJSONString.Create (ClientDataSet1.Fields[I].AsString));
44 | Result.AddElement(jRecord);
45 | ClientDataSet1.Next;
46 | end;
47 | end;
48 |
49 | function TServerData.Meta: TJSONArray;
50 | var
51 | jRecord: TJSONObject;
52 | I: Integer;
53 | begin
54 | ClientDataSet1.Open;
55 | Result := TJSonArray.Create;
56 |
57 | for I := 0 to ClientDataSet1.FieldDefs.Count - 1 do
58 | Result.Add(ClientDataSet1.FieldDefs[I].Name);
59 | end;
60 |
61 | end.
62 |
63 |
64 |
65 |
66 |
--------------------------------------------------------------------------------
/05/D2DCanvasMix/D2DCanvasMix_MainForm.pas:
--------------------------------------------------------------------------------
1 | unit D2DCanvasMix_MainForm;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs;
8 |
9 | type
10 | TFormMix = class(TForm)
11 | procedure FormPaint(Sender: TObject);
12 | procedure FormResize(Sender: TObject);
13 | private
14 | { Private declarations }
15 | public
16 | { Public declarations }
17 | end;
18 |
19 | var
20 | FormMix: TFormMix;
21 |
22 | implementation
23 |
24 | {$R *.dfm}
25 |
26 | uses
27 | Direct2D, D2D1;
28 |
29 | procedure TFormMix.FormPaint(Sender: TObject);
30 | var
31 | d2dCanvas: TDirect2DCanvas;
32 | begin
33 | d2dCanvas := TDirect2DCanvas.Create(Canvas,
34 | Rect (0, 0, Width, Height));
35 | // limited surface
36 | // Rect (0, 0, Width div 2, Height));
37 |
38 | d2dCanvas.BeginDraw;
39 | try
40 | d2dCanvas.Brush.Color := clWhite;
41 | d2dCanvas.Pen.Color := clBlack;
42 | d2dCanvas.Ellipse(100, 100, Width div 2, Height - 100);
43 | d2dCanvas.DrawLine(
44 | D2D1PointF(100, 100),
45 | D2D1PointF(Width - 100, Height - 100));
46 | finally
47 | d2dCanvas.EndDraw;
48 | d2dCanvas.Free;
49 | end;
50 |
51 | Canvas.Ellipse(Width div 2, 100, Width - 100, Height - 100);
52 | Canvas.MoveTo (110, 110);
53 | Canvas.LineTo (Width - 90, Height - 90);
54 | end;
55 |
56 | procedure TFormMix.FormResize(Sender: TObject);
57 | begin
58 | Invalidate;
59 | end;
60 |
61 | end.
62 |
--------------------------------------------------------------------------------
/08/FirstSimpleRestServer/FirstRestClient_MainForm.dfm:
--------------------------------------------------------------------------------
1 | object FormFirstRestClient: TFormFirstRestClient
2 | Left = 0
3 | Top = 0
4 | Caption = 'FirstRestClient'
5 | ClientHeight = 168
6 | ClientWidth = 352
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 | PixelsPerInch = 96
15 | TextHeight = 13
16 | object btnPlainCall: TButton
17 | Left = 32
18 | Top = 73
19 | Width = 129
20 | Height = 25
21 | Caption = 'btnPlainCall'
22 | TabOrder = 0
23 | OnClick = btnPlainCallClick
24 | end
25 | object btnToJSON: TButton
26 | Left = 176
27 | Top = 73
28 | Width = 137
29 | Height = 25
30 | Caption = 'btnToJSON'
31 | TabOrder = 1
32 | OnClick = btnToJSONClick
33 | end
34 | object edInput: TEdit
35 | Left = 32
36 | Top = 30
37 | Width = 281
38 | Height = 21
39 | TabOrder = 2
40 | Text = 'Hello from a Delphi Client Application'
41 | end
42 | object IdHTTP1: TIdHTTP
43 | AllowCookies = True
44 | ProxyParams.BasicAuthentication = False
45 | ProxyParams.ProxyPort = 0
46 | Request.ContentLength = -1
47 | Request.Accept = 'text/html, */*'
48 | Request.BasicAuthentication = False
49 | Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)'
50 | HTTPOptions = [hoForceEncodeParams]
51 | Left = 240
52 | Top = 120
53 | end
54 | end
55 |
--------------------------------------------------------------------------------
/07/JsonMarshal/JsonMarshal_MainForm.dfm:
--------------------------------------------------------------------------------
1 | object FormJson: TFormJson
2 | Left = 0
3 | Top = 0
4 | Caption = 'JsonMarshal'
5 | ClientHeight = 331
6 | ClientWidth = 600
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 | PixelsPerInch = 96
15 | TextHeight = 13
16 | object btnMarshal: TButton
17 | Left = 24
18 | Top = 16
19 | Width = 122
20 | Height = 25
21 | Caption = 'btnMarshal'
22 | TabOrder = 0
23 | OnClick = btnMarshalClick
24 | end
25 | object Memo1: TMemo
26 | Left = 168
27 | Top = 18
28 | Width = 401
29 | Height = 287
30 | Lines.Strings = (
31 | 'Memo1')
32 | TabOrder = 1
33 | end
34 | object btnUnmarshal: TButton
35 | Left = 24
36 | Top = 64
37 | Width = 122
38 | Height = 25
39 | Caption = 'btnUnmarshal'
40 | TabOrder = 2
41 | OnClick = btnUnmarshalClick
42 | end
43 | object btnMarshalConverter: TButton
44 | Left = 24
45 | Top = 152
46 | Width = 122
47 | Height = 25
48 | Caption = 'btnMarshalConverter'
49 | TabOrder = 3
50 | OnClick = btnMarshalConverterClick
51 | end
52 | object btnUnmarshalReverter: TButton
53 | Left = 24
54 | Top = 192
55 | Width = 122
56 | Height = 25
57 | Caption = 'btnUnmarshalReverter'
58 | TabOrder = 4
59 | OnClick = btnUnmarshalReverterClick
60 | end
61 | end
62 |
--------------------------------------------------------------------------------
/07/DSnapFilterDemo/DSnapFilter_WebModule.pas:
--------------------------------------------------------------------------------
1 | unit DSnapFilter_WebModule;
2 |
3 | interface
4 |
5 | uses
6 | SysUtils, Classes, HTTPApp, DSHTTP, DSHTTPCommon, DSHTTPWebBroker, DSServer,
7 | DSCommonServer, DbxCompressionFilter;
8 |
9 | type
10 | TWebModule3 = class(TWebModule)
11 | DSServer1: TDSServer;
12 | DSHTTPWebDispatcher1: TDSHTTPWebDispatcher;
13 | DSServerClass1: TDSServerClass;
14 | procedure DSServerClass1GetClass(DSServerClass: TDSServerClass;
15 | var PersistentClass: TPersistentClass);
16 | procedure WebModule3DefaultHandlerAction(Sender: TObject;
17 | Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
18 | private
19 | { Private declarations }
20 | public
21 | { Public declarations }
22 | end;
23 |
24 | var
25 | WebModule3: TWebModule3;
26 |
27 | implementation
28 |
29 | uses WebReq, DSnapFilter_ServerMethods;
30 |
31 | {$R *.dfm}
32 |
33 | procedure TWebModule3.WebModule3DefaultHandlerAction(Sender: TObject;
34 | Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
35 | begin
36 | Response.Content := 'jQuery and Delphi REST
5 |
6 |
7 |
8 |
33 |
34 |
35 |
36 | jQuery Getting Started Example - rate me
37 |
38 | This example demonstrate basic use of AJAX. Click one of the links below to rate. The
39 | number of rating and the average rating will be returned from the serverside script and displayed.
40 |
41 | Container
42 |
43 | result
44 |
45 |
46 |
--------------------------------------------------------------------------------
/04/StopWatchTest/StopWatchTestMainForm.pas:
--------------------------------------------------------------------------------
1 | unit StopWatchTestMainForm;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, IniFiles, Registry, StdCtrls;
8 |
9 | type
10 | TForm39 = class(TForm)
11 | Memo1: TMemo;
12 | btnTest: TButton;
13 | btnCondensed: TButton;
14 | procedure btnTestClick(Sender: TObject);
15 | procedure FormCreate(Sender: TObject);
16 | procedure btnCondensedClick(Sender: TObject);
17 | private
18 | { Private declarations }
19 | public
20 | procedure Log (const strMsg: string);
21 | end;
22 |
23 | var
24 | Form39: TForm39;
25 |
26 | implementation
27 |
28 | {$R *.dfm}
29 |
30 | uses
31 | Diagnostics;
32 |
33 | procedure TForm39.btnCondensedClick(Sender: TObject);
34 | var
35 | sw: TStopWatch;
36 | I: Integer;
37 | begin
38 | sw := TStopwatch.StartNew;
39 | for I := 0 to 999 do
40 | Caption := TimeToStr (Now);
41 | Log ('msec: ' + IntToStr (sw.ElapsedMilliseconds));
42 | Log ('ticks: ' + IntToStr (sw.ElapsedTicks));
43 | end;
44 |
45 | procedure TForm39.btnTestClick(Sender: TObject);
46 | var
47 | sw: TStopWatch;
48 | I: Integer;
49 | begin
50 | sw := TStopwatch.Create;
51 | sw.Start;
52 | for I := 0 to 999 do
53 | Caption := TimeToStr (Now);
54 | sw.Stop;
55 | Log ('msec: ' + IntToStr (sw.ElapsedMilliseconds));
56 | Log ('ticks: ' + IntToStr (sw.ElapsedTicks));
57 | end;
58 |
59 | procedure TForm39.FormCreate(Sender: TObject);
60 | begin
61 | TStopwatch.IsHighResolution := True;
62 | end;
63 |
64 | procedure TForm39.Log(const strMsg: string);
65 | begin
66 | Memo1.Lines.Add (strMsg);
67 | end;
68 |
69 | end.
70 |
--------------------------------------------------------------------------------
/05/TiffViewer/TiffViewer_MainForm.dfm:
--------------------------------------------------------------------------------
1 | object Form1: TForm1
2 | Left = 0
3 | Top = 0
4 | Caption = 'TiffViewer'
5 | ClientHeight = 310
6 | ClientWidth = 708
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 | DesignSize = (
15 | 708
16 | 310)
17 | PixelsPerInch = 96
18 | TextHeight = 13
19 | object Image1: TImage
20 | Left = 8
21 | Top = 8
22 | Width = 511
23 | Height = 294
24 | Anchors = [akLeft, akTop, akRight, akBottom]
25 | ExplicitWidth = 489
26 | ExplicitHeight = 274
27 | end
28 | object Button1: TButton
29 | Left = 625
30 | Top = 8
31 | Width = 75
32 | Height = 25
33 | Anchors = [akTop, akRight]
34 | Caption = 'btnOpen'
35 | TabOrder = 0
36 | OnClick = Button1Click
37 | ExplicitLeft = 503
38 | end
39 | object Button2: TButton
40 | Left = 625
41 | Top = 39
42 | Width = 75
43 | Height = 25
44 | Anchors = [akTop, akRight]
45 | Caption = 'btnRotate'
46 | TabOrder = 1
47 | OnClick = Button2Click
48 | ExplicitLeft = 503
49 | end
50 | object Memo1: TMemo
51 | Left = 536
52 | Top = 70
53 | Width = 163
54 | Height = 232
55 | Anchors = [akTop, akRight, akBottom]
56 | TabOrder = 2
57 | ExplicitLeft = 552
58 | ExplicitHeight = 226
59 | end
60 | object OpenDialog1: TOpenDialog
61 | Filter =
62 | 'TIFF file (*.tif, *.tiff)|*.tif*|JPEG file (*.jpg)|*.jpg|Any Fil' +
63 | 'e (*.*)|*.*'
64 | FilterIndex = 0
65 | Left = 536
66 | Top = 88
67 | end
68 | end
69 |
--------------------------------------------------------------------------------
/03/XmlPersistPublish/XmlPersistPublish_MainForm.pas:
--------------------------------------------------------------------------------
1 | unit XmlPersistPublish_MainForm;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, StdCtrls, xmldom, XMLIntf, msxmldom, XMLDoc;
8 |
9 | type
10 | TForm1 = class(TForm)
11 | Button1: TButton;
12 | Memo1: TMemo;
13 | procedure Button1Click(Sender: TObject);
14 | private
15 | { Private declarations }
16 | public
17 | { Public declarations }
18 | end;
19 |
20 | var
21 | Form1: TForm1;
22 |
23 | implementation
24 |
25 | {$R *.dfm}
26 |
27 | uses
28 | TrivialXmlWriter, XmlPersistPublish_Classes;
29 |
30 | procedure TForm1.Button1Click(Sender: TObject);
31 | var
32 | aPerson: TPerson;
33 | aCompany: TCompany;
34 | ss: TStringStream;
35 | xmlWri: TTrivialXmlWriter;
36 | begin
37 | // create a person
38 | aPerson := TPerson.Create;
39 | aPerson.Name := 'Willy';
40 | aPerson.Country := 'Desert';
41 |
42 | // create a company and add person to it
43 | aCompany := TCompany.Create;
44 | aCompany.Name := 'ACME Inc.';
45 | aCompany.ID := IntToStr (GetTickCount);
46 | aCompany.Country := 'Worldwide';
47 | aCompany.Person := aPerson;
48 |
49 | // stream the company (and person)
50 | ss := TStringStream.Create;
51 | try
52 | xmlWri := TTrivialXmlWriter.Create (ss);
53 | try
54 | xmlWri.WriteStartElement('company');
55 | xmlWri.WriteObjectPublished(aCompany);
56 | xmlWri.WriteEndElement;
57 | finally
58 | xmlWri.Free;
59 | end;
60 | // reset and laod stream
61 | ss.Position := 0;
62 | Memo1.Lines.LoadFromStream (ss);
63 | finally
64 | ss.Free;
65 | end;
66 | end;
67 |
68 | end.
69 |
--------------------------------------------------------------------------------
/08/Rest1/Rest1Group.groupproj:
--------------------------------------------------------------------------------
1 |
2 |
3 | {2A5F13F4-5ED1-4B3A-9325-3355597418B6}
4 |
5 |
6 |
7 |
9 |
10 |
12 |
13 |
14 | Default.Personality.12
15 |
17 |
19 |
20 |
21 |
23 |
24 |
26 |
27 |
29 |
30 |
32 |
33 |
35 |
36 |
38 |
39 |
41 |
42 |
44 |
45 |
47 |
49 |
--------------------------------------------------------------------------------
/04/GenericClassCtor/GenericClassCtor_MainForm.pas:
--------------------------------------------------------------------------------
1 | unit GenericClassCtor_MainForm;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, StdCtrls;
8 |
9 | type
10 | TFormGenericClassCtor = class(TForm)
11 | btnInt: TButton;
12 | Memo1: TMemo;
13 | btnString: TButton;
14 | btnSequence: TButton;
15 | procedure btnIntClick(Sender: TObject);
16 | procedure btnSequenceClick(Sender: TObject);
17 | procedure btnStringClick(Sender: TObject);
18 | private
19 | { Private declarations }
20 | public
21 | procedure Log (const strMsg: string);
22 | end;
23 |
24 | var
25 | FormGenericClassCtor: TFormGenericClassCtor;
26 |
27 | implementation
28 |
29 | {$R *.dfm}
30 |
31 | uses GenericClassCtor_Classes;
32 |
33 | type
34 | TGenDouble = TGenericWithClassCtor ;
35 |
36 | procedure TFormGenericClassCtor.btnIntClick(Sender: TObject);
37 | var
38 | genInt: TGenericWithClassCtor ;
39 | begin
40 | genInt := TGenericWithClassCtor .Create;
41 | genInt.Data := 100;
42 | Log ('Size: ' + IntToStr (genInt.DataSize));
43 | genInt.Free;
44 | end;
45 |
46 | procedure TFormGenericClassCtor.btnSequenceClick(Sender: TObject);
47 | begin
48 | Log (Trim(ListSequence.Text));
49 | end;
50 |
51 | procedure TFormGenericClassCtor.btnStringClick(Sender: TObject);
52 | var
53 | genStr: TGenericWithClassCtor ;
54 | begin
55 | genStr := TGenericWithClassCtor .Create;
56 | genStr.Data := '100';
57 | Log ('Size: ' + IntToStr (genStr.DataSize));
58 | genStr.Free;
59 | end;
60 |
61 | procedure TFormGenericClassCtor.Log(const strMsg: string);
62 | begin
63 | Memo1.Lines.Add(strMsg)
64 | end;
65 |
66 | end.
67 |
--------------------------------------------------------------------------------
/08/DataRestServer/jRestClient.html:
--------------------------------------------------------------------------------
1 |
2 |
3 | jQuery and Delphi 2010 REST
5 |
6 |
7 |
46 |
47 |
48 |
49 | jQuery and Delphi 2010 REST
50 |
51 | This is your data
52 |
Result goes here:
54 |
55 |
56 |
--------------------------------------------------------------------------------
/08/LargeXml/saxphilo.pas:
--------------------------------------------------------------------------------
1 | unit saxphilo;
2 |
3 | interface
4 |
5 | uses
6 | AdomCore_4_3, classes, strutils;
7 |
8 | type
9 | TDataSaxHandler = class (TXmlStandardHandler)
10 | protected
11 | stack: TStringList;
12 | strCurrent: string;
13 | public
14 | constructor Create(aowner: TComponent); override;
15 | procedure ProcessSignal(const Signal: TXmlSignal); override;
16 | destructor Destroy; override;
17 | end;
18 |
19 | implementation
20 |
21 | uses
22 | LargeXmlForm, saxform;
23 |
24 | { TDataSaxHandler }
25 |
26 | constructor TDataSaxHandler.Create(aowner: TComponent);
27 | begin
28 | inherited;
29 | stack := tstringlist.create;
30 | end;
31 |
32 | destructor TDataSaxHandler.Destroy;
33 | begin
34 | stack.Free;
35 | inherited;
36 | end;
37 |
38 | procedure TDataSaxHandler.ProcessSignal(const Signal: TXmlSignal);
39 | var
40 | tagname: string;
41 | begin
42 | if Signal is TXmlStartElementSignal then
43 | begin
44 | stack.Add (TXmlStartElementSignal(Signal).TagName);
45 | if TXmlStartElementSignal(Signal).TagName = 'employeeData' then
46 | Form1.clientdataset2.Insert;
47 | strCurrent := '';
48 | end
49 | else if Signal is TXmlEndElementSignal then
50 | begin
51 | if TXmlEndElementSignal(Signal).TagName = 'employeeData' then
52 | Form1.clientdataset2.Post;
53 | if stack.Count > 2 then
54 | begin
55 | Form1.ClientDataSet2.Edit;
56 | Form1.ClientDataSet2.FieldByName (
57 | TXmlEndElementSignal(Signal).TagName).AsString := strCurrent;
58 | end;
59 | stack.Delete (stack.Count - 1);
60 | end
61 | else if Signal is TXmlPCDATASignal then
62 | begin
63 | strCurrent := strCurrent + RemoveWhites(
64 | TXmlPCDATASignal(Signal).Data);
65 | end;
66 | end;
67 |
68 | end.
69 |
--------------------------------------------------------------------------------
/03/TypesList/TypesListMainForm.dfm:
--------------------------------------------------------------------------------
1 | object FormTypesList: TFormTypesList
2 | Left = 0
3 | Top = 0
4 | Caption = 'TypesList'
5 | ClientHeight = 546
6 | ClientWidth = 561
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 | PixelsPerInch = 96
15 | TextHeight = 13
16 | object btnTypesList: TButton
17 | Left = 8
18 | Top = 8
19 | Width = 75
20 | Height = 25
21 | Caption = 'btnTypesList'
22 | TabOrder = 0
23 | OnClick = btnTypesListClick
24 | end
25 | object ListBox1: TListBox
26 | Left = 96
27 | Top = 8
28 | Width = 441
29 | Height = 193
30 | ItemHeight = 13
31 | TabOrder = 1
32 | end
33 | object TreeView1: TTreeView
34 | Left = 96
35 | Top = 216
36 | Width = 441
37 | Height = 297
38 | Indent = 19
39 | TabOrder = 2
40 | OnDblClick = TreeView1DblClick
41 | end
42 | object btnHierarchy: TButton
43 | Left = 8
44 | Top = 216
45 | Width = 75
46 | Height = 25
47 | Caption = 'btnHierarchy'
48 | TabOrder = 3
49 | OnClick = btnHierarchyClick
50 | end
51 | object btnPackages: TButton
52 | Left = 8
53 | Top = 48
54 | Width = 75
55 | Height = 25
56 | Caption = 'btnPackages'
57 | TabOrder = 4
58 | OnClick = btnPackagesClick
59 | end
60 | object Button1: TButton
61 | Left = 8
62 | Top = 96
63 | Width = 75
64 | Height = 25
65 | Caption = 'btnMemory'
66 | TabOrder = 5
67 | OnClick = Button1Click
68 | end
69 | object StatusBar1: TStatusBar
70 | Left = 0
71 | Top = 527
72 | Width = 561
73 | Height = 19
74 | Panels = <>
75 | SimplePanel = True
76 | end
77 | end
78 |
--------------------------------------------------------------------------------
/07/DSnapWebAppDebug/ProjectGroup1.groupproj:
--------------------------------------------------------------------------------
1 |
2 |
3 | {DBE05C0C-F2FA-47F9-AD96-CE6DE752D2FB}
4 |
5 |
6 |
7 |
9 |
10 |
12 |
13 |
14 | Default.Personality.12
15 |
17 |
19 |
20 |
21 |
23 |
24 |
26 |
27 |
29 |
30 |
32 |
33 |
35 |
36 |
38 |
39 |
41 |
42 |
44 |
45 |
47 |
49 |
--------------------------------------------------------------------------------
/03/TypesList/TypeInfoForm.dfm:
--------------------------------------------------------------------------------
1 | object FormTypeInfo: TFormTypeInfo
2 | Left = 0
3 | Top = 0
4 | Caption = 'FormTypeInfo'
5 | ClientHeight = 308
6 | ClientWidth = 600
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 | PixelsPerInch = 96
15 | TextHeight = 13
16 | object HeaderControl1: THeaderControl
17 | Left = 0
18 | Top = 0
19 | Width = 600
20 | Height = 17
21 | Sections = <
22 | item
23 | ImageIndex = -1
24 | MinWidth = 100
25 | Text = 'Properties'
26 | Width = 200
27 | end
28 | item
29 | ImageIndex = -1
30 | MinWidth = 200
31 | Text = 'Methods'
32 | Width = 200
33 | end
34 | item
35 | ImageIndex = -1
36 | MinWidth = 100
37 | Text = 'Fields'
38 | Width = 200
39 | end>
40 | OnSectionResize = HeaderControl1SectionResize
41 | ExplicitLeft = 232
42 | ExplicitTop = 40
43 | ExplicitWidth = 0
44 | end
45 | object ListProperties: TListBox
46 | Left = 0
47 | Top = 17
48 | Width = 200
49 | Height = 291
50 | Align = alLeft
51 | ItemHeight = 13
52 | TabOrder = 1
53 | end
54 | object ListMethods: TListBox
55 | Left = 200
56 | Top = 17
57 | Width = 200
58 | Height = 291
59 | Align = alLeft
60 | ItemHeight = 13
61 | TabOrder = 2
62 | end
63 | object ListFields: TListBox
64 | Left = 400
65 | Top = 17
66 | Width = 200
67 | Height = 291
68 | Align = alClient
69 | ItemHeight = 13
70 | TabOrder = 3
71 | ExplicitLeft = 472
72 | ExplicitTop = 88
73 | ExplicitWidth = 121
74 | ExplicitHeight = 97
75 | end
76 | end
77 |
--------------------------------------------------------------------------------
/06/FirstTouch/FirstTouch_MainForm.pas:
--------------------------------------------------------------------------------
1 | unit FirstTouch_MainForm;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, StdCtrls;
8 |
9 | type
10 | TForm1 = class(TForm)
11 | Memo1: TMemo;
12 | protected
13 | procedure CreateWnd; override;
14 | procedure DestroyWnd; override;
15 | { Private declarations }
16 | public
17 | procedure WMTouch(var Message: TMessage); message WM_TOUCH;
18 | end;
19 |
20 | var
21 | Form1: TForm1;
22 |
23 | implementation
24 |
25 | {$R *.dfm}
26 |
27 | { TForm1 }
28 |
29 | procedure TForm1.CreateWnd;
30 | begin
31 | inherited;
32 | RegisterTouchWindow(Handle, 0);
33 | end;
34 |
35 | procedure TForm1.DestroyWnd;
36 | begin
37 | inherited;
38 | UnregisterTouchWindow(Handle);
39 | end;
40 |
41 | procedure TForm1.WMTouch(var Message: TMessage);
42 |
43 | function TouchPointToPoint(const TouchPoint: TTouchInput): TPoint;
44 | begin
45 | Result := Point(TouchPoint.X div 100, TouchPoint.Y div 100);
46 | PhysicalToLogicalPoint(Handle, Result);
47 | end;
48 |
49 | var
50 | TouchInputs: array of TTouchInput;
51 | TouchInput: TTouchInput;
52 | Handled: Boolean;
53 | Point: TPoint;
54 |
55 | begin
56 | Memo1.Clear;
57 | Handled := False;
58 | SetLength(TouchInputs, Message.WParam);
59 | GetTouchInputInfo(Message.LParam, Message.WParam, @TouchInputs[0],
60 | SizeOf(TTouchInput));
61 | try
62 | for TouchInput in TouchInputs do
63 | begin
64 | Point := TouchPointToPoint(TouchInput);
65 | Memo1.Lines.Add(Format ('%d:%d', [Point.X, Point.Y]));
66 | end;
67 |
68 | Handled := True;
69 | finally
70 | if Handled then
71 | CloseTouchInputHandle(Message.LParam)
72 | else
73 | inherited;
74 | end;
75 | end;
76 |
77 | end.
78 |
--------------------------------------------------------------------------------
/06/EditGestures/EditGestures_MainForm.pas:
--------------------------------------------------------------------------------
1 | unit EditGestures_MainForm;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, StdActns, ActnList, GestureMgr, StdCtrls, ExtCtrls;
8 |
9 | type
10 | TFormEditGest = class(TForm)
11 | lbEditFirstName: TLabeledEdit;
12 | lbEditLastName: TLabeledEdit;
13 | lblEditCity: TLabeledEdit;
14 | GestureManager1: TGestureManager;
15 | ActionList1: TActionList;
16 | EditCut1: TEditCut;
17 | EditCopy1: TEditCopy;
18 | EditPaste1: TEditPaste;
19 | EditSelectAll1: TEditSelectAll;
20 | EditUndo1: TEditUndo;
21 | EditDelete1: TEditDelete;
22 | EditClear1: TAction;
23 | Memo1: TMemo;
24 | procedure EditClear1Execute(Sender: TObject);
25 | procedure FormGesture(Sender: TObject; const EventInfo: TGestureEventInfo;
26 | var Handled: Boolean);
27 | procedure ActionList1Execute(Action: TBasicAction; var Handled: Boolean);
28 | private
29 | { Private declarations }
30 | public
31 | procedure Log (const strMsg: string);
32 | end;
33 |
34 | var
35 | FormEditGest: TFormEditGest;
36 |
37 | implementation
38 |
39 | {$R *.dfm}
40 |
41 | procedure TFormEditGest.ActionList1Execute(Action: TBasicAction;
42 | var Handled: Boolean);
43 | begin
44 | Log ('Action: ' + Action.Name);
45 | end;
46 |
47 | procedure TFormEditGest.EditClear1Execute(Sender: TObject);
48 | begin
49 | if (ActiveControl is TCustomEdit) then
50 | TCustomEdit(ActiveControl).Clear;
51 | end;
52 |
53 | procedure TFormEditGest.FormGesture(Sender: TObject;
54 | const EventInfo: TGestureEventInfo; var Handled: Boolean);
55 | begin
56 | Log ('Gesture performed');
57 | end;
58 |
59 | procedure TFormEditGest.Log(const strMsg: string);
60 | begin
61 | Memo1.Lines.Add (strMsg);
62 | end;
63 |
64 | end.
65 |
--------------------------------------------------------------------------------
/07/DSnapGateway/ServerContainerUnit1.pas:
--------------------------------------------------------------------------------
1 | unit ServerContainerUnit1;
2 |
3 | interface
4 |
5 | uses
6 | SysUtils, Classes,
7 | DSTCPServerTransport,
8 | DSServer, DSCommonServer;
9 |
10 | type
11 | TServerContainer1 = class(TDataModule)
12 | DSServer1: TDSServer;
13 | DSTCPServerTransport1: TDSTCPServerTransport;
14 | DSServerClass1: TDSServerClass;
15 | procedure DSServerClass1GetClass(DSServerClass: TDSServerClass;
16 | var PersistentClass: TPersistentClass);
17 | private
18 | { Private declarations }
19 | public
20 | end;
21 |
22 | procedure RunDSServer;
23 |
24 | implementation
25 |
26 | uses Windows, ServerMethodsUnit2;
27 |
28 | {$R *.dfm}
29 |
30 | procedure TServerContainer1.DSServerClass1GetClass(
31 | DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
32 | begin
33 | PersistentClass := ServerMethodsUnit2.TServerMethods2;
34 | end;
35 |
36 | procedure RunDSServer;
37 | var
38 | LModule: TServerContainer1;
39 | LInputRecord: TInputRecord;
40 | LEvent: DWord;
41 | LHandle: THandle;
42 | begin
43 | Writeln(Format('Starting %s', [TServerContainer1.ClassName]));
44 | LModule := TServerContainer1.Create(nil);
45 | try
46 | LModule.DSServer1.Start;
47 | try
48 | Writeln('Press ESC to stop the server');
49 | LHandle := GetStdHandle(STD_INPUT_HANDLE);
50 | while True do
51 | begin
52 | Win32Check(ReadConsoleInput(LHandle, LInputRecord, 1, LEvent));
53 | if (LInputRecord.EventType = KEY_EVENT) and
54 | LInputRecord.Event.KeyEvent.bKeyDown and
55 | (LInputRecord.Event.KeyEvent.wVirtualKeyCode = VK_ESCAPE) then
56 | break;
57 | end;
58 | finally
59 | LModule.DSServer1.Stop;
60 | end;
61 | finally
62 | LModule.Free;
63 | end;
64 | end;
65 |
66 | end.
67 |
68 |
69 |
70 |
71 |
--------------------------------------------------------------------------------
/07/DSnapJson/DSnapJsonGroup.groupproj:
--------------------------------------------------------------------------------
1 |
2 |
3 | {17BA8DE0-190D-4AF5-8AFA-1F4791287D8F}
4 |
5 |
6 |
7 |
9 |
10 |
12 |
13 |
14 | Default.Personality.12
15 |
17 |
19 |
20 |
21 |
23 |
24 |
26 |
27 |
29 |
30 |
32 |
33 |
35 |
36 |
38 |
39 |
41 |
42 |
44 |
45 |
47 |
49 |
--------------------------------------------------------------------------------
/07/DSnapHttpConsole/DSnapHttpConsoleGroup.groupproj:
--------------------------------------------------------------------------------
1 |
2 |
3 | {2D171D59-3BBC-43E0-BFDF-3BAA0CD56750}
4 |
5 |
6 |
7 |
9 |
10 |
12 |
13 |
14 | Default.Personality.12
15 |
17 |
19 |
20 |
21 |
23 |
24 |
26 |
27 |
29 |
30 |
32 |
33 |
35 |
36 |
38 |
39 |
41 |
42 |
44 |
45 |
47 |
49 |
--------------------------------------------------------------------------------
/05/Win7Libraries/Win7Libraries_MainForm.dfm:
--------------------------------------------------------------------------------
1 | object Form1: TForm1
2 | Left = 0
3 | Top = 0
4 | Caption = 'Win7Libraries'
5 | ClientHeight = 315
6 | ClientWidth = 657
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 | DesignSize = (
15 | 657
16 | 315)
17 | PixelsPerInch = 96
18 | TextHeight = 13
19 | object btnOpenClassic: TButton
20 | Left = 24
21 | Top = 24
22 | Width = 145
23 | Height = 25
24 | Caption = 'btnOpenClassic'
25 | TabOrder = 0
26 | OnClick = btnOpenClassicClick
27 | end
28 | object btnOpenNew: TButton
29 | Left = 24
30 | Top = 56
31 | Width = 145
32 | Height = 25
33 | Caption = 'btnOpenNew'
34 | TabOrder = 1
35 | OnClick = btnOpenNewClick
36 | end
37 | object btnLibraries: TButton
38 | Left = 24
39 | Top = 120
40 | Width = 145
41 | Height = 25
42 | Caption = 'btnLibraries'
43 | TabOrder = 2
44 | OnClick = btnLibrariesClick
45 | end
46 | object Memo1: TMemo
47 | Left = 192
48 | Top = 24
49 | Width = 448
50 | Height = 266
51 | Anchors = [akLeft, akTop, akRight, akBottom]
52 | Lines.Strings = (
53 | 'Memo1')
54 | TabOrder = 3
55 | ExplicitWidth = 345
56 | ExplicitHeight = 241
57 | end
58 | object btnLibraryXml: TButton
59 | Left = 24
60 | Top = 160
61 | Width = 145
62 | Height = 25
63 | Caption = 'btnLibraryXml'
64 | TabOrder = 4
65 | OnClick = btnLibraryXmlClick
66 | end
67 | object OpenDialog1: TOpenDialog
68 | Left = 232
69 | Top = 16
70 | end
71 | object FileOpenDialog1: TFileOpenDialog
72 | FavoriteLinks = <>
73 | FileTypes = <>
74 | Options = []
75 | Left = 320
76 | Top = 48
77 | end
78 | end
79 |
--------------------------------------------------------------------------------
/02/NamedThreads/NamedThreadsMainForm.pas:
--------------------------------------------------------------------------------
1 | unit NamedThreadsMainForm;
2 |
3 | interface
4 |
5 | uses
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 | Dialogs, StdCtrls, ComCtrls, ExtCtrls;
8 |
9 | type
10 | TFormNamedThreads = class(TForm)
11 | btnCreate: TButton;
12 | btnTerminate: TButton;
13 | StatusBar1: TStatusBar;
14 | Memo1: TMemo;
15 | Timer1: TTimer;
16 | procedure btnCreateClick(Sender: TObject);
17 | procedure btnTerminateClick(Sender: TObject);
18 | procedure Timer1Timer(Sender: TObject);
19 | procedure FormCreate(Sender: TObject);
20 | private
21 | procedure MyThreadTerminated(Sender: TObject);
22 | public
23 | procedure Log (const strMsg: string);
24 | end;
25 |
26 | var
27 | FormNamedThreads: TFormNamedThreads;
28 |
29 | implementation
30 |
31 | uses MyThreadClass;
32 |
33 | {$R *.dfm}
34 |
35 | var
36 | aGlobalThread: TMyThread;
37 |
38 | procedure TFormNamedThreads.btnCreateClick(Sender: TObject);
39 | begin
40 | if not Assigned (aGlobalThread) then
41 | begin
42 | aGlobalThread := TMyThread.Create (False);
43 | aGlobalThread.OnTerminate := MyThreadTerminated;
44 | end;
45 | end;
46 |
47 | procedure TFormNamedThreads.btnTerminateClick(Sender: TObject);
48 | begin
49 | if Assigned (aGlobalThread) then
50 | aGlobalThread.Terminate;
51 | end;
52 |
53 | procedure TFormNamedThreads.FormCreate(Sender: TObject);
54 | begin
55 | TThread.NameThreadForDebugging('Main');
56 | end;
57 |
58 | procedure TFormNamedThreads.Log(const strMsg: string);
59 | begin
60 | Memo1.Lines.Add (strMsg);
61 | end;
62 |
63 | procedure TFormNamedThreads.MyThreadTerminated(Sender: TObject);
64 | begin
65 | aGlobalThread := nil;
66 | end;
67 |
68 | procedure TFormNamedThreads.Timer1Timer(Sender: TObject);
69 | begin
70 | Log ('Main: ' + CurrentTimeAsStr);
71 | end;
72 |
73 | end.
74 |
--------------------------------------------------------------------------------
/07/DSnapWebAppDebug/DSnapWebAppDebugGroup.groupproj:
--------------------------------------------------------------------------------
1 |
2 |
3 | {DBE05C0C-F2FA-47F9-AD96-CE6DE752D2FB}
4 |
5 |
6 |
7 |
9 |
10 |
12 |
13 |
14 | Default.Personality.12
15 |
17 |
19 |
20 |
21 |
23 |
24 |
26 |
27 |
29 |
30 |
32 |
33 |
35 |
36 |
38 |
39 |
41 |
42 |
44 |
45 |
47 |
49 |
--------------------------------------------------------------------------------
/05/FileAccess/FileAccessForm.dfm:
--------------------------------------------------------------------------------
1 | object FormFile: TFormFile
2 | Left = 0
3 | Top = 0
4 | Caption = 'FileAccess'
5 | ClientHeight = 303
6 | ClientWidth = 567
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 | PixelsPerInch = 96
16 | TextHeight = 13
17 | object Memo1: TMemo
18 | Left = 24
19 | Top = 16
20 | Width = 425
21 | Height = 265
22 | Lines.Strings = (
23 | 'Some text here.')
24 | TabOrder = 0
25 | end
26 | object btnSaveRoot: TButton
27 | Left = 456
28 | Top = 16
29 | Width = 100
30 | Height = 25
31 | Caption = 'Save Root'
32 | TabOrder = 1
33 | OnClick = btnSaveRootClick
34 | end
35 | object btnSaveLocal: TButton
36 | Left = 456
37 | Top = 56
38 | Width = 100
39 | Height = 25
40 | Caption = 'Save Local'
41 | TabOrder = 2
42 | OnClick = btnSaveLocalClick
43 | end
44 | object btnLoadLocal: TButton
45 | Left = 456
46 | Top = 96
47 | Width = 100
48 | Height = 25
49 | Caption = 'Load Local'
50 | TabOrder = 3
51 | OnClick = btnLoadLocalClick
52 | end
53 | object btnSaveDocs: TButton
54 | Left = 455
55 | Top = 136
56 | Width = 101
57 | Height = 25
58 | Caption = 'Save Docs'
59 | TabOrder = 4
60 | OnClick = btnSaveDocsClick
61 | end
62 | object btnLoadDocs: TButton
63 | Left = 455
64 | Top = 176
65 | Width = 101
66 | Height = 25
67 | Caption = 'Load Docs'
68 | TabOrder = 5
69 | OnClick = btnLoadDocsClick
70 | end
71 | object btnUAC: TButton
72 | Left = 456
73 | Top = 256
74 | Width = 100
75 | Height = 25
76 | Caption = 'Copy (UAC)'
77 | TabOrder = 6
78 | OnClick = btnUACClick
79 | end
80 | end
81 |
--------------------------------------------------------------------------------