*** empty log message ***
This commit is contained in:
ronaldhordijk
@ -39,11 +39,15 @@ type
|
||||
vHandkerchief, vHeart, vDisc, vSpiral, vHyperbolic, vSquare, vEx, vJulia,
|
||||
vBent, vWaves, vFisheye, vPopcorn, vExponential, vPower, vCosine, vSawTooth, vRandom);
|
||||
type
|
||||
TCPpoint = record
|
||||
x, y, c: double;
|
||||
end;
|
||||
PCPpoint = ^TCPpoint;
|
||||
|
||||
TPointsArray = array of TCPpoint;
|
||||
TPointsXYArray = array of TXYpoint;
|
||||
|
||||
T2Cpoint = record
|
||||
x, y, c1, c2: double;
|
||||
end;
|
||||
P2Cpoint = ^T2Cpoint;
|
||||
T2CPointsArray = array of T2Cpoint;
|
||||
|
||||
TControlPoint = class
|
||||
public
|
||||
@ -81,6 +85,7 @@ type
|
||||
PropTable: array of Integer;
|
||||
jpeg: TJPegImage;
|
||||
FAngle: Double;
|
||||
FTwoColorDimensions: Boolean;
|
||||
private
|
||||
procedure PreparePropTable;
|
||||
|
||||
@ -90,9 +95,7 @@ type
|
||||
|
||||
procedure ParseString(aString: string);
|
||||
procedure ParseStringList(sl: TStringlist);
|
||||
// procedure RandomCP(calc: boolean = true);
|
||||
procedure RandomCP(min: integer = 2; max: integer = NXFORMS; calc: boolean = true);
|
||||
// procedure RandomCP;
|
||||
procedure RandomCP1;
|
||||
procedure CalcBoundbox;
|
||||
function BlowsUp(NrPoints: integer): boolean;
|
||||
@ -102,8 +105,10 @@ type
|
||||
|
||||
class function interpolate(cp1, cp2: TControlPoint; Time: double): TControlPoint; /// just for now
|
||||
procedure InterpolateX(cp1, cp2: TControlPoint; Tm: double);
|
||||
procedure Iterate(NrPoints: integer; var Points: TPointsArray);
|
||||
procedure Iterate_d(NrPoints: integer; var Points: TPointsArray);
|
||||
procedure Iterate_Old(NrPoints: integer; var Points: TPointsArray);
|
||||
procedure IterateXY(NrPoints: integer; var Points: TPointsXYArray);
|
||||
procedure IterateXYC(NrPoints: integer; var Points: TPointsArray);
|
||||
procedure IterateXYCC(NrPoints: integer; var Points: T2CPointsArray);
|
||||
|
||||
function Clone: TControlPoint;
|
||||
procedure Copy(cp1: TControlPoint);
|
||||
@ -180,6 +185,8 @@ begin
|
||||
nbatches := 1;
|
||||
|
||||
white_level := 200;
|
||||
|
||||
FTwoColorDimensions := False;
|
||||
end;
|
||||
|
||||
destructor TControlPoint.Destroy;
|
||||
@ -221,7 +228,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControlPoint.Iterate(NrPoints: integer; var Points: TPointsArray);
|
||||
procedure TControlPoint.Iterate_Old(NrPoints: integer; var Points: TPointsArray);
|
||||
var
|
||||
i: Integer;
|
||||
px, py, pc: double;
|
||||
@ -452,7 +459,38 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControlPoint.Iterate_d(NrPoints: integer; var Points: TPointsArray);
|
||||
procedure TControlPoint.IterateXY(NrPoints: integer; var Points: TPointsXYArray);
|
||||
var
|
||||
i: Integer;
|
||||
px, py: double;
|
||||
CurrentPoint: PXYPoint;
|
||||
begin
|
||||
px := 2 * random - 1;
|
||||
py := 2 * random - 1;
|
||||
|
||||
PreparePropTable;
|
||||
|
||||
for i := 0 to NXFORMS - 1 do
|
||||
xform[i].prepare;
|
||||
|
||||
for i := -100 to NrPoints - 1 do begin
|
||||
try
|
||||
xform[PropTable[Random(1024)]].NextPointXY(px,py);
|
||||
except
|
||||
on EMathError do begin
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
// store points
|
||||
if i >= 0 then begin
|
||||
CurrentPoint := @Points[i];
|
||||
CurrentPoint.X := px;
|
||||
CurrentPoint.Y := py;
|
||||
end
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TControlPoint.IterateXYC(NrPoints: integer; var Points: TPointsArray);
|
||||
{ Variations for Draves conpatibility }
|
||||
var
|
||||
i: Integer;
|
||||
@ -473,7 +511,6 @@ begin
|
||||
xform[PropTable[Random(1024)]].NextPoint(px,py,pc);
|
||||
except
|
||||
on EMathError do begin
|
||||
// raise Exception.Create('Iteration blows up');
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
@ -487,21 +524,16 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TControlPoint.BlowsUp(NrPoints: integer): boolean;
|
||||
procedure TControlPoint.IterateXYCC(NrPoints: integer; var Points: T2CPointsArray);
|
||||
var
|
||||
i: Integer;
|
||||
px, py, pc: double;
|
||||
minx, maxx, miny, maxy: double;
|
||||
Points: TPointsArray;
|
||||
CurrentPoint: PCPPoint;
|
||||
px, py, pc1, pc2: double;
|
||||
CurrentPoint: P2Cpoint;
|
||||
begin
|
||||
Result := false;
|
||||
|
||||
SetLength(Points, SUB_BATCH_SIZE);
|
||||
|
||||
px := 2 * random - 1;
|
||||
py := 2 * random - 1;
|
||||
pc := random;
|
||||
pc1 := random;
|
||||
pc2 := random;
|
||||
|
||||
PreparePropTable;
|
||||
|
||||
@ -510,12 +542,51 @@ begin
|
||||
|
||||
for i := -100 to NrPoints - 1 do begin
|
||||
try
|
||||
xform[PropTable[Random(1024)]].NextPoint(px,py,pc);
|
||||
xform[PropTable[Random(1024)]].NextPoint2C(px, py, pc1, pc2);
|
||||
except
|
||||
on EMathError do begin
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
// store points
|
||||
if i >= 0 then begin
|
||||
CurrentPoint := @Points[i];
|
||||
CurrentPoint.X := px;
|
||||
CurrentPoint.Y := py;
|
||||
CurrentPoint.C1 := pc1;
|
||||
CurrentPoint.C2 := pc2;
|
||||
end
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TControlPoint.BlowsUp(NrPoints: integer): boolean;
|
||||
var
|
||||
i: Integer;
|
||||
px, py: double;
|
||||
minx, maxx, miny, maxy: double;
|
||||
Points: TPointsXYArray;
|
||||
CurrentPoint: PXYPoint;
|
||||
begin
|
||||
Result := false;
|
||||
|
||||
SetLength(Points, SUB_BATCH_SIZE);
|
||||
|
||||
px := 2 * random - 1;
|
||||
py := 2 * random - 1;
|
||||
|
||||
PreparePropTable;
|
||||
|
||||
for i := 0 to NXFORMS - 1 do
|
||||
xform[i].prepare;
|
||||
|
||||
for i := -100 to NrPoints - 1 do begin
|
||||
try
|
||||
xform[PropTable[Random(1024)]].NextPointXY(px,py);
|
||||
if i >= 0 then begin
|
||||
CurrentPoint := @Points[i];
|
||||
CurrentPoint.X := px;
|
||||
CurrentPoint.Y := py;
|
||||
CurrentPoint.C := pc;
|
||||
end
|
||||
except
|
||||
on EMathError do begin
|
||||
@ -849,8 +920,8 @@ begin
|
||||
try
|
||||
SetLength(Points, SUB_BATCH_SIZE);
|
||||
case compatibility of
|
||||
0: iterate(SUB_BATCH_SIZE, points);
|
||||
1: iterate_d(SUB_BATCH_SIZE, points);
|
||||
0: iterate_Old(SUB_BATCH_SIZE, points);
|
||||
1: iterateXYC(SUB_BATCH_SIZE, points);
|
||||
end;
|
||||
|
||||
LimitOutSidePoints := Round(0.05 * SUB_BATCH_SIZE);
|
||||
@ -921,14 +992,17 @@ begin
|
||||
else
|
||||
pixels_per_unit := 10;
|
||||
except on E: EMathError do
|
||||
pixels_per_unit := 10;
|
||||
begin// default
|
||||
center[0] := 0;
|
||||
center[1] := 0;
|
||||
pixels_per_unit := 10;
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
function CalcUPRMagn(const cp: TControlPoint): double;
|
||||
var
|
||||
Points: TPointsArray;
|
||||
Points: TPointsXYArray;
|
||||
i, j: integer;
|
||||
deltax, minx, maxx: double;
|
||||
cntminx, cntmaxx: integer;
|
||||
@ -937,10 +1011,9 @@ var
|
||||
LimitOutSidePoints: integer;
|
||||
xLength, yLength: double;
|
||||
begin
|
||||
result := 1.0;
|
||||
try
|
||||
SetLength(Points, SUB_BATCH_SIZE);
|
||||
cp.iterate_d(SUB_BATCH_SIZE, Points);
|
||||
cp.iterateXY(SUB_BATCH_SIZE, Points);
|
||||
|
||||
LimitOutSidePoints := Round(0.05 * SUB_BATCH_SIZE);
|
||||
|
||||
@ -1023,8 +1096,8 @@ begin
|
||||
end;
|
||||
|
||||
except on E: EMathError do
|
||||
raise Exception.Create('CalcUPRMagn: ' +e.Message);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
@ -1235,8 +1308,6 @@ begin
|
||||
result.free;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TControlPoint.SaveToFile(Filename: string);
|
||||
var
|
||||
sl: TStringlist;
|
||||
|
||||
@ -2,7 +2,7 @@ object MainForm: TMainForm
|
||||
Left = 316
|
||||
Top = 424
|
||||
Width = 574
|
||||
Height = 395
|
||||
Height = 415
|
||||
Caption = 'Apophysis'
|
||||
Color = clBtnFace
|
||||
Font.Charset = ANSI_CHARSET
|
||||
@ -27,7 +27,7 @@ object MainForm: TMainForm
|
||||
Left = 160
|
||||
Top = 28
|
||||
Width = 4
|
||||
Height = 294
|
||||
Height = 314
|
||||
end
|
||||
object ToolBar: TToolBar
|
||||
Left = 0
|
||||
@ -251,7 +251,7 @@ object MainForm: TMainForm
|
||||
Left = 0
|
||||
Top = 28
|
||||
Width = 160
|
||||
Height = 294
|
||||
Height = 314
|
||||
Align = alLeft
|
||||
Columns = <
|
||||
item
|
||||
@ -270,7 +270,7 @@ object MainForm: TMainForm
|
||||
Left = 164
|
||||
Top = 28
|
||||
Width = 402
|
||||
Height = 294
|
||||
Height = 314
|
||||
Align = alClient
|
||||
BevelInner = bvLowered
|
||||
BevelOuter = bvNone
|
||||
@ -281,7 +281,7 @@ object MainForm: TMainForm
|
||||
Left = 1
|
||||
Top = 1
|
||||
Width = 400
|
||||
Height = 292
|
||||
Height = 312
|
||||
Align = alClient
|
||||
AutoSize = True
|
||||
PopupMenu = DisplayPopup
|
||||
@ -293,7 +293,7 @@ object MainForm: TMainForm
|
||||
end
|
||||
object StatusBar: TStatusBar
|
||||
Left = 0
|
||||
Top = 322
|
||||
Top = 342
|
||||
Width = 566
|
||||
Height = 19
|
||||
Panels = <
|
||||
@ -2616,6 +2616,10 @@ object MainForm: TMainForm
|
||||
ShortCut = 16455
|
||||
OnClick = mnuGradClick
|
||||
end
|
||||
object mnuimage: TMenuItem
|
||||
Caption = 'Image '
|
||||
OnClick = mnuimageClick
|
||||
end
|
||||
object N4: TMenuItem
|
||||
Caption = '-'
|
||||
end
|
||||
|
||||
@ -221,6 +221,8 @@ type
|
||||
tbzoomwindow: TToolButton;
|
||||
tbDrag: TToolButton;
|
||||
tbRotate: TToolButton;
|
||||
mnuimage: TMenuItem;
|
||||
procedure mnuimageClick(Sender: TObject);
|
||||
procedure mnuExitClick(Sender: TObject);
|
||||
procedure mnuSaveUPRClick(Sender: TObject);
|
||||
procedure ListViewChange(Sender: TObject; Item: TListItem;
|
||||
@ -906,8 +908,9 @@ begin
|
||||
Trunc((Elapsed * 24 - Trunc(Elapsed * 24)) * 60),
|
||||
Trunc((Elapsed * 24 * 60 - Trunc(Elapsed * 24 * 60)) * 60),
|
||||
Trunc((Elapsed * 24 * 60 * 60 - Trunc(Elapsed * 24 * 60 * 60)) * 100)]);
|
||||
if prog > 0 then
|
||||
if prog > 0 then
|
||||
Remainder := Min(Remainder, Elapsed * (power(1 / prog, 1.2) - 1));
|
||||
|
||||
StatusBar.Panels[1].Text := Format('Remaining %2.2d:%2.2d:%2.2d.%2.2d',
|
||||
[Trunc(Remainder * 24),
|
||||
Trunc((Remainder * 24 - Trunc(Remainder * 24)) * 60),
|
||||
@ -3100,6 +3103,12 @@ begin
|
||||
GradientForm.Show;
|
||||
end;
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
procedure TMainForm.mnuimageClick(Sender: TObject);
|
||||
begin
|
||||
// frmImageColoring.Show;
|
||||
end;
|
||||
|
||||
procedure swapcolor(var clist: array of cardinal; i, j: integer);
|
||||
var
|
||||
t: cardinal;
|
||||
@ -4377,7 +4386,9 @@ begin
|
||||
StopThread;
|
||||
UpdateUndo;
|
||||
MainCp.ZoomtoRect(FSelectRect);
|
||||
DrawFlame;
|
||||
|
||||
RedrawTimer.Enabled := True;
|
||||
UpdateWindows;
|
||||
end;
|
||||
msDragMove:
|
||||
begin
|
||||
@ -4393,7 +4404,9 @@ begin
|
||||
StopThread;
|
||||
UpdateUndo;
|
||||
MainCp.MoveRect(FSelectRect);
|
||||
DrawFlame;
|
||||
|
||||
RedrawTimer.Enabled := True;
|
||||
UpdateWindows;
|
||||
end;
|
||||
msRotateMove:
|
||||
begin
|
||||
@ -4407,7 +4420,9 @@ begin
|
||||
StopThread;
|
||||
UpdateUndo;
|
||||
MainCp.Rotate(FRotateAngle);
|
||||
DrawFlame;
|
||||
|
||||
RedrawTimer.Enabled := True;
|
||||
UpdateWindows;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -4489,5 +4504,6 @@ begin
|
||||
FMouseMoveState := msRotate;
|
||||
end;
|
||||
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////
|
||||
end.
|
||||
|
||||
@ -1,474 +0,0 @@
|
||||
{***************************************************************************}
|
||||
{ This source code was generated automatically by }
|
||||
{ Pas file import tool for Scripter Studio }
|
||||
{ }
|
||||
{ Scripter Studio and Pas file import tool for Scripter Studio }
|
||||
{ written by Automa / TMS Software }
|
||||
{ copyright <20> 1997 - 2003 }
|
||||
{ Email : info@tmssoftware.com }
|
||||
{ Web : http://www.tmssoftware.com }
|
||||
{***************************************************************************}
|
||||
unit ap_FileCtrl;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows,
|
||||
Messages,
|
||||
SysUtils,
|
||||
Classes,
|
||||
Controls,
|
||||
Graphics,
|
||||
Forms,
|
||||
Menus,
|
||||
StdCtrls,
|
||||
Buttons,
|
||||
FileCtrl,
|
||||
Variants,
|
||||
atScript;
|
||||
|
||||
type
|
||||
TatFileCtrlLibrary = class(TatScripterLibrary)
|
||||
procedure __TFileListBoxCreate(AMachine: TatVirtualMachine);
|
||||
procedure __TFileListBoxDestroy(AMachine: TatVirtualMachine);
|
||||
procedure __TFileListBoxUpdate(AMachine: TatVirtualMachine);
|
||||
procedure __TFileListBoxApplyFilePath(AMachine: TatVirtualMachine);
|
||||
procedure __GetTFileListBoxDrive(AMachine: TatVirtualMachine);
|
||||
procedure __SetTFileListBoxDrive(AMachine: TatVirtualMachine);
|
||||
procedure __GetTFileListBoxDirectory(AMachine: TatVirtualMachine);
|
||||
procedure __SetTFileListBoxDirectory(AMachine: TatVirtualMachine);
|
||||
procedure __GetTFileListBoxFileName(AMachine: TatVirtualMachine);
|
||||
procedure __SetTFileListBoxFileName(AMachine: TatVirtualMachine);
|
||||
procedure __TDirectoryListBoxCreate(AMachine: TatVirtualMachine);
|
||||
procedure __TDirectoryListBoxDestroy(AMachine: TatVirtualMachine);
|
||||
procedure __TDirectoryListBoxDisplayCase(AMachine: TatVirtualMachine);
|
||||
procedure __TDirectoryListBoxFileCompareText(AMachine: TatVirtualMachine);
|
||||
procedure __TDirectoryListBoxGetItemPath(AMachine: TatVirtualMachine);
|
||||
procedure __TDirectoryListBoxOpenCurrent(AMachine: TatVirtualMachine);
|
||||
procedure __TDirectoryListBoxUpdate(AMachine: TatVirtualMachine);
|
||||
procedure __GetTDirectoryListBoxDrive(AMachine: TatVirtualMachine);
|
||||
procedure __SetTDirectoryListBoxDrive(AMachine: TatVirtualMachine);
|
||||
procedure __GetTDirectoryListBoxDirectory(AMachine: TatVirtualMachine);
|
||||
procedure __SetTDirectoryListBoxDirectory(AMachine: TatVirtualMachine);
|
||||
procedure __GetTDirectoryListBoxPreserveCase(AMachine: TatVirtualMachine);
|
||||
procedure __GetTDirectoryListBoxCaseSensitive(AMachine: TatVirtualMachine);
|
||||
procedure __TDriveComboBoxCreate(AMachine: TatVirtualMachine);
|
||||
procedure __TDriveComboBoxDestroy(AMachine: TatVirtualMachine);
|
||||
procedure __GetTDriveComboBoxDrive(AMachine: TatVirtualMachine);
|
||||
procedure __SetTDriveComboBoxDrive(AMachine: TatVirtualMachine);
|
||||
procedure __TFilterComboBoxCreate(AMachine: TatVirtualMachine);
|
||||
procedure __TFilterComboBoxDestroy(AMachine: TatVirtualMachine);
|
||||
procedure __GetTFilterComboBoxMask(AMachine: TatVirtualMachine);
|
||||
procedure __ProcessPath(AMachine: TatVirtualMachine);
|
||||
procedure __MinimizeName(AMachine: TatVirtualMachine);
|
||||
procedure __DirectoryExists(AMachine: TatVirtualMachine);
|
||||
procedure __ForceDirectories(AMachine: TatVirtualMachine);
|
||||
procedure Init; override;
|
||||
class function LibraryName: string; override;
|
||||
end;
|
||||
|
||||
TFileListBoxClass = class of TFileListBox;
|
||||
TDirectoryListBoxClass = class of TDirectoryListBox;
|
||||
TDriveComboBoxClass = class of TDriveComboBox;
|
||||
TFilterComboBoxClass = class of TFilterComboBox;
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{$WARNINGS OFF}
|
||||
|
||||
|
||||
|
||||
procedure TatFileCtrlLibrary.__TFileListBoxCreate(AMachine: TatVirtualMachine);
|
||||
var
|
||||
AResult: variant;
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
AResult := Integer(TFileListBoxClass(CurrentClass.ClassRef).Create(TComponent(Integer(GetInputArg(0)))));
|
||||
ReturnOutputArg(AResult);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__TFileListBoxDestroy(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
TFileListBox(CurrentObject).Destroy;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__TFileListBoxUpdate(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
TFileListBox(CurrentObject).Update;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__TFileListBoxApplyFilePath(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
TFileListBox(CurrentObject).ApplyFilePath(GetInputArg(0));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__GetTFileListBoxDrive(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
ReturnOutputArg(TFileListBox(CurrentObject).Drive);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__SetTFileListBoxDrive(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
TFileListBox(CurrentObject).Drive:=VarToStr(GetInputArg(0))[1];
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__GetTFileListBoxDirectory(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
ReturnOutputArg(TFileListBox(CurrentObject).Directory);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__SetTFileListBoxDirectory(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
TFileListBox(CurrentObject).Directory:=GetInputArg(0);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__GetTFileListBoxFileName(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
ReturnOutputArg(TFileListBox(CurrentObject).FileName);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__SetTFileListBoxFileName(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
TFileListBox(CurrentObject).FileName:=GetInputArg(0);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__TDirectoryListBoxCreate(AMachine: TatVirtualMachine);
|
||||
var
|
||||
AResult: variant;
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
AResult := Integer(TDirectoryListBoxClass(CurrentClass.ClassRef).Create(TComponent(Integer(GetInputArg(0)))));
|
||||
ReturnOutputArg(AResult);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__TDirectoryListBoxDestroy(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
TDirectoryListBox(CurrentObject).Destroy;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__TDirectoryListBoxDisplayCase(AMachine: TatVirtualMachine);
|
||||
var
|
||||
AResult: variant;
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
AResult := TDirectoryListBox(CurrentObject).DisplayCase(GetInputArg(0));
|
||||
ReturnOutputArg(AResult);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__TDirectoryListBoxFileCompareText(AMachine: TatVirtualMachine);
|
||||
var
|
||||
AResult: variant;
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
AResult := Integer(TDirectoryListBox(CurrentObject).FileCompareText(GetInputArg(0),GetInputArg(1)));
|
||||
ReturnOutputArg(AResult);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__TDirectoryListBoxGetItemPath(AMachine: TatVirtualMachine);
|
||||
var
|
||||
AResult: variant;
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
AResult := TDirectoryListBox(CurrentObject).GetItemPath(VarToInteger(GetInputArg(0)));
|
||||
ReturnOutputArg(AResult);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__TDirectoryListBoxOpenCurrent(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
TDirectoryListBox(CurrentObject).OpenCurrent;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__TDirectoryListBoxUpdate(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
TDirectoryListBox(CurrentObject).Update;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__GetTDirectoryListBoxDrive(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
ReturnOutputArg(TDirectoryListBox(CurrentObject).Drive);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__SetTDirectoryListBoxDrive(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
TDirectoryListBox(CurrentObject).Drive:=VarToStr(GetInputArg(0))[1];
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__GetTDirectoryListBoxDirectory(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
ReturnOutputArg(TDirectoryListBox(CurrentObject).Directory);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__SetTDirectoryListBoxDirectory(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
TDirectoryListBox(CurrentObject).Directory:=GetInputArg(0);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__GetTDirectoryListBoxPreserveCase(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
ReturnOutputArg(TDirectoryListBox(CurrentObject).PreserveCase);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__GetTDirectoryListBoxCaseSensitive(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
ReturnOutputArg(TDirectoryListBox(CurrentObject).CaseSensitive);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__TDriveComboBoxCreate(AMachine: TatVirtualMachine);
|
||||
var
|
||||
AResult: variant;
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
AResult := Integer(TDriveComboBoxClass(CurrentClass.ClassRef).Create(TComponent(Integer(GetInputArg(0)))));
|
||||
ReturnOutputArg(AResult);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__TDriveComboBoxDestroy(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
TDriveComboBox(CurrentObject).Destroy;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__GetTDriveComboBoxDrive(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
ReturnOutputArg(TDriveComboBox(CurrentObject).Drive);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__SetTDriveComboBoxDrive(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
TDriveComboBox(CurrentObject).Drive:=VarToStr(GetInputArg(0))[1];
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__TFilterComboBoxCreate(AMachine: TatVirtualMachine);
|
||||
var
|
||||
AResult: variant;
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
AResult := Integer(TFilterComboBoxClass(CurrentClass.ClassRef).Create(TComponent(Integer(GetInputArg(0)))));
|
||||
ReturnOutputArg(AResult);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__TFilterComboBoxDestroy(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
TFilterComboBox(CurrentObject).Destroy;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__GetTFilterComboBoxMask(AMachine: TatVirtualMachine);
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
ReturnOutputArg(TFilterComboBox(CurrentObject).Mask);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__ProcessPath(AMachine: TatVirtualMachine);
|
||||
var
|
||||
Param1: Char;
|
||||
Param2: string;
|
||||
Param3: string;
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
Param1 := VarToStr(GetInputArg(1))[1];
|
||||
Param2 := GetInputArg(2);
|
||||
Param3 := GetInputArg(3);
|
||||
FileCtrl.ProcessPath(GetInputArg(0),Param1,Param2,Param3);
|
||||
SetInputArg(1,Param1);
|
||||
SetInputArg(2,Param2);
|
||||
SetInputArg(3,Param3);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__MinimizeName(AMachine: TatVirtualMachine);
|
||||
var
|
||||
AResult: variant;
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
AResult := FileCtrl.MinimizeName(GetInputArg(0),TCanvas(Integer(GetInputArg(1))),VarToInteger(GetInputArg(2)));
|
||||
ReturnOutputArg(AResult);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__DirectoryExists(AMachine: TatVirtualMachine);
|
||||
var
|
||||
AResult: variant;
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
AResult := FileCtrl.DirectoryExists(GetInputArg(0));
|
||||
ReturnOutputArg(AResult);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.__ForceDirectories(AMachine: TatVirtualMachine);
|
||||
var
|
||||
AResult: variant;
|
||||
begin
|
||||
with AMachine do
|
||||
begin
|
||||
AResult := FileCtrl.ForceDirectories(GetInputArg(0));
|
||||
ReturnOutputArg(AResult);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TatFileCtrlLibrary.Init;
|
||||
begin
|
||||
With Scripter.DefineClass(TFileListBox) do
|
||||
begin
|
||||
DefineMethod('Create',1,tkClass,TFileListBox,__TFileListBoxCreate,true);
|
||||
DefineMethod('Destroy',0,tkNone,nil,__TFileListBoxDestroy,false);
|
||||
DefineMethod('Update',0,tkNone,nil,__TFileListBoxUpdate,false);
|
||||
DefineMethod('ApplyFilePath',1,tkNone,nil,__TFileListBoxApplyFilePath,false);
|
||||
DefineProp('Drive',tkVariant,__GetTFileListBoxDrive,__SetTFileListBoxDrive,nil,false,0);
|
||||
DefineProp('Directory',tkVariant,__GetTFileListBoxDirectory,__SetTFileListBoxDirectory,nil,false,0);
|
||||
DefineProp('FileName',tkVariant,__GetTFileListBoxFileName,__SetTFileListBoxFileName,nil,false,0);
|
||||
end;
|
||||
With Scripter.DefineClass(TDirectoryListBox) do
|
||||
begin
|
||||
DefineMethod('Create',1,tkClass,TDirectoryListBox,__TDirectoryListBoxCreate,true);
|
||||
DefineMethod('Destroy',0,tkNone,nil,__TDirectoryListBoxDestroy,false);
|
||||
DefineMethod('DisplayCase',1,tkVariant,nil,__TDirectoryListBoxDisplayCase,false);
|
||||
DefineMethod('FileCompareText',2,tkInteger,nil,__TDirectoryListBoxFileCompareText,false);
|
||||
DefineMethod('GetItemPath',1,tkVariant,nil,__TDirectoryListBoxGetItemPath,false);
|
||||
DefineMethod('OpenCurrent',0,tkNone,nil,__TDirectoryListBoxOpenCurrent,false);
|
||||
DefineMethod('Update',0,tkNone,nil,__TDirectoryListBoxUpdate,false);
|
||||
DefineProp('Drive',tkVariant,__GetTDirectoryListBoxDrive,__SetTDirectoryListBoxDrive,nil,false,0);
|
||||
DefineProp('Directory',tkVariant,__GetTDirectoryListBoxDirectory,__SetTDirectoryListBoxDirectory,nil,false,0);
|
||||
DefineProp('PreserveCase',tkVariant,__GetTDirectoryListBoxPreserveCase,nil,nil,false,0);
|
||||
DefineProp('CaseSensitive',tkVariant,__GetTDirectoryListBoxCaseSensitive,nil,nil,false,0);
|
||||
end;
|
||||
With Scripter.DefineClass(TDriveComboBox) do
|
||||
begin
|
||||
DefineMethod('Create',1,tkClass,TDriveComboBox,__TDriveComboBoxCreate,true);
|
||||
DefineMethod('Destroy',0,tkNone,nil,__TDriveComboBoxDestroy,false);
|
||||
DefineProp('Text',tkVariant,nil,nil,nil,false,0);
|
||||
DefineProp('Drive',tkVariant,__GetTDriveComboBoxDrive,__SetTDriveComboBoxDrive,nil,false,0);
|
||||
end;
|
||||
With Scripter.DefineClass(TFilterComboBox) do
|
||||
begin
|
||||
DefineMethod('Create',1,tkClass,TFilterComboBox,__TFilterComboBoxCreate,true);
|
||||
DefineMethod('Destroy',0,tkNone,nil,__TFilterComboBoxDestroy,false);
|
||||
DefineProp('Mask',tkVariant,__GetTFilterComboBoxMask,nil,nil,false,0);
|
||||
DefineProp('Text',tkVariant,nil,nil,nil,false,0);
|
||||
end;
|
||||
With Scripter.DefineClass(ClassType) do
|
||||
begin
|
||||
DefineMethod('ProcessPath',4,tkNone,nil,__ProcessPath,false).SetVarArgs([1,2,3]);
|
||||
DefineMethod('MinimizeName',3,tkVariant,nil,__MinimizeName,false);
|
||||
DefineMethod('DirectoryExists',1,tkVariant,nil,__DirectoryExists,false);
|
||||
DefineMethod('ForceDirectories',1,tkVariant,nil,__ForceDirectories,false);
|
||||
AddConstant('ftReadOnly',ftReadOnly);
|
||||
AddConstant('ftHidden',ftHidden);
|
||||
AddConstant('ftSystem',ftSystem);
|
||||
AddConstant('ftVolumeID',ftVolumeID);
|
||||
AddConstant('ftDirectory',ftDirectory);
|
||||
AddConstant('ftArchive',ftArchive);
|
||||
AddConstant('ftNormal',ftNormal);
|
||||
AddConstant('dtUnknown',dtUnknown);
|
||||
AddConstant('dtNoDrive',dtNoDrive);
|
||||
AddConstant('dtFloppy',dtFloppy);
|
||||
AddConstant('dtFixed',dtFixed);
|
||||
AddConstant('dtNetwork',dtNetwork);
|
||||
AddConstant('dtCDROM',dtCDROM);
|
||||
AddConstant('dtRAM',dtRAM);
|
||||
AddConstant('tcLowerCase',tcLowerCase);
|
||||
AddConstant('tcUpperCase',tcUpperCase);
|
||||
AddConstant('sdAllowCreate',sdAllowCreate);
|
||||
AddConstant('sdPerformCreate',sdPerformCreate);
|
||||
AddConstant('sdPrompt',sdPrompt);
|
||||
AddConstant('WNTYPE_DRIVE',WNTYPE_DRIVE);
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TatFileCtrlLibrary.LibraryName: string;
|
||||
begin
|
||||
result := 'FileCtrl';
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterScripterLibrary(TatFileCtrlLibrary, True);
|
||||
|
||||
{$WARNINGS ON}
|
||||
|
||||
end.
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user