source: trunk/Library/ACLLibraryTestForm.pas@ 392

Last change on this file since 392 was 392, checked in by RBRi, 9 years ago

update FileUtilsUnit (merged from old 2.20)

  • Property svn:eol-style set to native
File size: 3.5 KB
Line 
1Unit ACLLibraryTestForm;
2
3Interface
4
5Uses
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
25Type
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
46Var
47 ACLLibraryTestForm: TACLLibraryTestForm;
48
49Implementation
50
51uses
52 SysUtils,
53 ACLString, AStringUtilityUnit,
54 RunProgramUnit;
55
56Procedure TACLLibraryTestForm.FindButtonOnClick (Sender: TObject);
57var
58 i: integer;
59Begin
60 i := CaseInsensitivePos( Edit1.Text,
61 Edit2.Text );
62 Memo1.Lines.Add( 'Result: ' + intToStr( i ) );
63End;
64
65Procedure TACLLibraryTestForm.Button4OnClick (Sender: TObject);
66var
67 a: TAString;
68Begin
69 a := TAString.CreateFromPCharWithDispose( Memo1.Lines.GetText );
70 a.InsertString( 5, Edit1.Text );
71 Memo1.Lines.SetText( a.AsPChar );
72 a.Destroy;
73End;
74
75Procedure TACLLibraryTestForm.Button3OnClick (Sender: TObject);
76Begin
77End;
78
79
80type
81 TTestSharedMemObject = record
82 Cake: longint;
83 Sausage: string;
84 end;
85 TPTestSharedMemObject = ^TTestSharedMemObject;
86
87Procedure TACLLibraryTestForm.ACLLibraryTestFormOnCreate (Sender: TObject);
88var
89 SharedMem1, SharedMem2: TSuballocatedSharedMemory;
90 a,b: TPTestSharedMemObject;
91Begin
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;
120End;
121
122Procedure TACLLibraryTestForm.ACLLibraryTestFormOnDestroy (Sender: TObject);
123Begin
124 CheckAllAStringsDestroyed;
125End;
126
127Procedure TACLLibraryTestForm.ACLLibraryTestFormOnDismissDlg (Sender: TObject);
128Begin
129
130End;
131
132Procedure TACLLibraryTestForm.Button1OnClick (Sender: TObject);
133var
134 VersionsModule: TVersionsModule;
135 Version: string;
136begin
137 if OpenModuleForVersions( GetApplicationFilename,
138 VersionsModule ) then
139 begin
140 while GetVersionFromModule( VersionsModule,
141 Version ) do
142 Memo1.Lines.Add( Version );
143 end;
144
145End;
146
147Initialization
148 RegisterClasses ([TACLLibraryTestForm, TMemo, TEdit, TButton]);
149End.
Note: See TracBrowser for help on using the repository browser.