1 | Unit ACLLibraryTestForm;
|
---|
2 |
|
---|
3 | Interface
|
---|
4 |
|
---|
5 | Uses
|
---|
6 | Classes, Forms, Graphics, Buttons,
|
---|
7 | StdCtrls,
|
---|
8 | ACLFileIOUtility,
|
---|
9 | ACLFileUtility, ACLFindFunctions,
|
---|
10 | ACLProfile,
|
---|
11 | ACLStringUtility, ACLUtility,
|
---|
12 | PCharList,
|
---|
13 | ACLResourceUtility, ACLVersionUtilityUnit,
|
---|
14 | Semaphores, SharedMemoryUnit;
|
---|
15 |
|
---|
16 | Type
|
---|
17 | TACLLibraryTestForm = Class (TForm)
|
---|
18 | Memo1: TMemo;
|
---|
19 | Edit1: TEdit;
|
---|
20 | Edit2: TEdit;
|
---|
21 | FindButton: TButton;
|
---|
22 | Button1: TButton;
|
---|
23 | Button3: TButton;
|
---|
24 | Procedure FindButtonOnClick (Sender: TObject);
|
---|
25 | Procedure Button4OnClick (Sender: TObject);
|
---|
26 | Procedure Button3OnClick (Sender: TObject);
|
---|
27 | Procedure ACLLibraryTestFormOnCreate (Sender: TObject);
|
---|
28 | Procedure ACLLibraryTestFormOnDestroy (Sender: TObject);
|
---|
29 | Procedure ACLLibraryTestFormOnDismissDlg (Sender: TObject);
|
---|
30 | Procedure Button1OnClick (Sender: TObject);
|
---|
31 | Private
|
---|
32 | {Insert private declarations here}
|
---|
33 | Public
|
---|
34 | {Insert public declarations here}
|
---|
35 | End;
|
---|
36 |
|
---|
37 | Var
|
---|
38 | ACLLibraryTestForm: TACLLibraryTestForm;
|
---|
39 |
|
---|
40 | Implementation
|
---|
41 |
|
---|
42 | uses
|
---|
43 | SysUtils,
|
---|
44 | ACLString, AStringUtilityUnit,
|
---|
45 | RunProgramUnit;
|
---|
46 |
|
---|
47 | Procedure TACLLibraryTestForm.FindButtonOnClick (Sender: TObject);
|
---|
48 | var
|
---|
49 | i: integer;
|
---|
50 | Begin
|
---|
51 | i := CaseInsensitivePos( Edit1.Text,
|
---|
52 | Edit2.Text );
|
---|
53 | Memo1.Lines.Add( 'Result: ' + intToStr( i ) );
|
---|
54 | End;
|
---|
55 |
|
---|
56 | Procedure TACLLibraryTestForm.Button4OnClick (Sender: TObject);
|
---|
57 | var
|
---|
58 | a: TAString;
|
---|
59 | Begin
|
---|
60 | a := TAString.CreateFromPCharWithDispose( Memo1.Lines.GetText );
|
---|
61 | a.InsertString( 5, Edit1.Text );
|
---|
62 | Memo1.Lines.SetText( a.AsPChar );
|
---|
63 | a.Destroy;
|
---|
64 | End;
|
---|
65 |
|
---|
66 | Procedure TACLLibraryTestForm.Button3OnClick (Sender: TObject);
|
---|
67 | Begin
|
---|
68 | End;
|
---|
69 |
|
---|
70 |
|
---|
71 | type
|
---|
72 | TTestSharedMemObject = record
|
---|
73 | Cake: longint;
|
---|
74 | Sausage: string;
|
---|
75 | end;
|
---|
76 | TPTestSharedMemObject = ^TTestSharedMemObject;
|
---|
77 |
|
---|
78 | Procedure TACLLibraryTestForm.ACLLibraryTestFormOnCreate (Sender: TObject);
|
---|
79 | var
|
---|
80 | SharedMem1, SharedMem2: TSuballocatedSharedMemory;
|
---|
81 | a,b: TPTestSharedMemObject;
|
---|
82 | Begin
|
---|
83 | Memo1.Lines.Add( GetApplicationDir );
|
---|
84 | // Memo1.Lines.Add( 'Color depth: ' + IntToStr( GetScreenColorDepth ) );
|
---|
85 | // Memo1.Lines.Add( 'Video driver: ' + GetVideoDriverName );
|
---|
86 |
|
---|
87 | SharedMem1 := TSuballocatedSharedMemory.Create( 'TEST_SHARED_MEM', 4096, sizeof( TTestSharedMemObject ) );
|
---|
88 | SharedMem2 := TSuballocatedSharedMemory.Create( 'TEST_SHARED_MEM', 4096, sizeof( TTestSharedMemObject ) );
|
---|
89 |
|
---|
90 | a := SharedMem1.Data;
|
---|
91 | b := SharedMem2.Data;
|
---|
92 |
|
---|
93 | a^.Cake := 7;
|
---|
94 | a^.Sausage := 'The Seventh Sausage';
|
---|
95 |
|
---|
96 | SharedMem1.Allocate( a, sizeof( TTestSharedMemObject ) );
|
---|
97 | a^.Cake := 12;
|
---|
98 | a^.Sausage := 'Four Times Fifty Living Men';
|
---|
99 |
|
---|
100 | SharedMem1.Destroy;
|
---|
101 |
|
---|
102 | Memo1.Lines.Add( 'Shared Mem: ' + IntToStr( b^.Cake ) );
|
---|
103 | Memo1.Lines.Add( 'Shared Mem: ' + b^.Sausage );
|
---|
104 |
|
---|
105 | Memo1.Lines.Add( 'Suballoced: ' + IntToStr( a^.Cake ) );
|
---|
106 | Memo1.Lines.Add( 'Suballoced: ' + a^.Sausage );
|
---|
107 |
|
---|
108 | SharedMem2.Free( a );
|
---|
109 |
|
---|
110 | SharedMem2.Destroy;
|
---|
111 | End;
|
---|
112 |
|
---|
113 | Procedure TACLLibraryTestForm.ACLLibraryTestFormOnDestroy (Sender: TObject);
|
---|
114 | Begin
|
---|
115 | CheckAllAStringsDestroyed;
|
---|
116 | End;
|
---|
117 |
|
---|
118 | Procedure TACLLibraryTestForm.ACLLibraryTestFormOnDismissDlg (Sender: TObject);
|
---|
119 | Begin
|
---|
120 |
|
---|
121 | End;
|
---|
122 |
|
---|
123 | Procedure TACLLibraryTestForm.Button1OnClick (Sender: TObject);
|
---|
124 | var
|
---|
125 | VersionsModule: TVersionsModule;
|
---|
126 | Version: string;
|
---|
127 | begin
|
---|
128 | if OpenModuleForVersions( GetApplicationFilename,
|
---|
129 | VersionsModule ) then
|
---|
130 | begin
|
---|
131 | while GetVersionFromModule( VersionsModule,
|
---|
132 | Version ) do
|
---|
133 | Memo1.Lines.Add( Version );
|
---|
134 | end;
|
---|
135 |
|
---|
136 | End;
|
---|
137 |
|
---|
138 | Initialization
|
---|
139 | RegisterClasses ([TACLLibraryTestForm, TMemo, TEdit, TButton]);
|
---|
140 | End.
|
---|