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