LStrings
unit StrForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Label1: TLabel;
Button1: TButton;
Button8: TButton;
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
private
Test, S2, S3: String;
public
procedure UpdateInfo;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function GetRefCount (const s: string) : Integer;
var
RefCountPointer: Pointer;
begin
if Pointer(s) <> nil then
begin
RefCountPointer :=
Pointer (Integer (Pointer (s)) - 8);
Result := Integer (RefCountPointer^);
end
else
Result := 0;
end;
function GetSize (const s: String) : Integer;
var
SizePointer: Pointer;
begin
if Pointer(s) <> nil then
begin
SizePointer := Pointer (
Integer (Pointer (s)) - 4);
Result := Integer (SizePointer^);
end
else
Result := 0;
end;
procedure TForm1.UpdateInfo;
begin
with Listbox1.Items do
begin
Clear;
Add ('Text: ' + Test);
Add ('Pascal Size: ' + IntToStr (Length (Test)));
Add ('PChar Size: ' + IntToStr (StrLen (PChar (Test))));
Add (Format ('Address: %p', [Pointer (Test)]));
Add ('Size Info: ' + IntToStr ( GetSize (Test)));
Add ('RefCount Info: ' + IntToStr (GetRefCount (Test)));
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Test := 'Test String';
UpdateInfo;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
S2 := Test;
UpdateInfo;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
S2 := S2 + '*';
UpdateInfo;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Test := Test + '*';
UpdateInfo;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
S3 := Test;
UpdateInfo;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
SetLength (Test, 100);
GetWindowText (Handle, PChar (Test), 100);
UpdateInfo;
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
Test := PChar (Test);
UpdateInfo;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetLength (Test, StrLen (PChar (Test)));
UpdateInfo;
end;
procedure TForm1.Button8Click(Sender: TObject);
begin
Test := '';
UpdateInfo;
end;
end.
|
Загрузить весь проект
|