paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

systools: Another example for StrLArr

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6143 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2018-01-17 09:16:37 +00:00
parent 50261c1f99
commit 0921d3d4ff
4 changed files with 395 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
components/systools/examples/3d array/ex3darr.lpi Normal file
View File

@ -0,0 +1,86 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<Flags>
<UseDefaultCompilerOptions Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="ex3darr"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="laz_systools"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="ex3darr.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Ex3darr"/>
</Unit0>
<Unit1>
<Filename Value="ex3darru.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Ex3DArrU"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="ex3darr"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

46
components/systools/examples/3d array/ex3darr.lpr Normal file
View File

@ -0,0 +1,46 @@
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower SysTools
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$IFDEF FPC}
{$mode DELPHI}
{$ENDIF}
program Ex3darr;
uses
Interfaces,
Forms, lclversion,
Ex3DArrU in 'Ex3DArrU.pas' {Form1};
{$R *.res}
begin
{$IF LCL_FULLVERSION >= 1080000}
Application.Scaled := True;
{$ENDIF}
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

99
components/systools/examples/3d array/ex3darru.lfm Normal file
View File

@ -0,0 +1,99 @@
object Form1: TForm1
Left = 375
Height = 210
Top = 189
Width = 170
Caption = '3-D Example'
ClientHeight = 210
ClientWidth = 170
Color = clBtnFace
Font.Color = clBlack
OnClose = FormClose
OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '1.9.0.0'
object Label4: TLabel
Left = 23
Height = 15
Top = 139
Width = 28
Caption = 'Value'
ParentColor = False
end
object Button1: TButton
Left = 48
Height = 33
Top = 167
Width = 89
Caption = 'Get Value'
Default = True
OnClick = Button1Click
TabOrder = 0
end
object Edit4: TEdit
Left = 63
Height = 23
Top = 136
Width = 75
ReadOnly = True
TabOrder = 1
end
object GroupBox1: TGroupBox
Left = 7
Height = 116
Top = 4
Width = 153
Caption = ' Array Position (All 0..49)'
ClientHeight = 96
ClientWidth = 149
TabOrder = 2
object Label1: TLabel
Left = 28
Height = 15
Top = 11
Width = 53
Caption = 'X Position'
ParentColor = False
end
object Label2: TLabel
Left = 27
Height = 15
Top = 38
Width = 53
Caption = 'Y Position'
ParentColor = False
end
object Label3: TLabel
Left = 28
Height = 15
Top = 63
Width = 53
Caption = 'Z Position'
ParentColor = False
end
object Edit1: TEdit
Left = 88
Height = 23
Top = 8
Width = 40
TabOrder = 0
Text = '0'
end
object Edit2: TEdit
Left = 88
Height = 23
Top = 34
Width = 40
TabOrder = 1
Text = '0'
end
object Edit3: TEdit
Left = 88
Height = 23
Top = 60
Width = 40
TabOrder = 2
Text = '0'
end
end
end

164
components/systools/examples/3d array/ex3darru.pas Normal file
View File

@ -0,0 +1,164 @@
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower SysTools
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$IFDEF FPC}
{$mode DELPHI}
{$ENDIF}
unit Ex3DArrU;
interface
uses
{$IFNDEF FPC}
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls,
StConst, StBase, StLArr;
type
TMy3D = class(TStLArray)
protected
XMax,
YMax,
ZMax : LongInt;
public
constructor Create(X, Y, Z : Cardinal);
destructor Destroy; override;
end;
TForm1 = class(TForm)
Button1: TButton;
Edit4: TEdit;
Label4: TLabel;
GroupBox1: TGroupBox;
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
Label3: TLabel;
Edit3: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
My3D : TMy3D;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
const
MaxX = 50;
MaxY = 50;
MaxZ = 50;
constructor TMy3D.Create(X, Y, Z : Cardinal);
var
row,
col,
up,
Value : LongInt;
A : TStLMatrix;
begin
XMax := X;
YMax := Y;
ZMax := Z;
inherited Create(ZMax, SizeOf(TStLMatrix));
for up := 0 to ZMax-1 do
begin
A := TStLMatrix.Create(XMax, YMax, SizeOf(LongInt));
for row := 0 to YMax-1 do
for col := 0 to XMax-1 do begin
Value := up+100*col+10000*row;
A.Put(row, col, Value);
end;
Put(up, A);
end;
end;
destructor TMy3D.Destroy;
var
Up : LongInt;
A : TStLMatrix;
begin
for Up := 0 to ZMax-1 do
begin
Get(Up, A);
if Assigned(A) then
A.Free;
end;
inherited Destroy;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
My3D := TMy3D.Create(MaxX, MaxY, MaxZ);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
My3D.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
XV,
YV,
ZV,
Value : LongInt;
Z : TStLMatrix;
begin
XV := StrToInt(Edit1.Text);
YV := StrToInt(Edit2.Text);
ZV := StrToInt(Edit3.Text);
if (XV < 0) or (XV >= MaxX) then begin
Edit1.Text := '0';
XV := StrToInt(Edit1.Text);
end;
if (YV < 0) or (YV >= MaxY) then begin
Edit2.Text := '0';
YV := StrToInt(Edit2.Text);
end;
if (ZV < 0) or (ZV >= MaxZ) then begin
Edit3.Text := '0';
ZV := StrToInt(Edit3.Text);
end;
My3D.Get(ZV, Z);
Z.Get(XV, YV, Value);
Edit4.Text := IntToStr(Value);
end;
end.