Added BGRAPascalScript, Test & Plugin

bgracontrols.lpk

@@ -27,7 +27,7 @@
       </Other>
     </CompilerOptions>
     <Version Major="3" Minor="3"/>
-    <Files Count="36">
+    <Files Count="38">
       <Item1>
         <Filename Value="bcbasectrls.pas"/>
         <UnitName Value="BCBaseCtrls"/>
@@ -199,16 +199,28 @@
         <HasRegisterProc Value="True"/>
         <UnitName Value="uESelector"/>
       </Item36>
+      <Item37>
+        <Filename Value="bgrapascalscript.pas"/>
+        <UnitName Value="BGRAPascalScript"/>
+      </Item37>
+      <Item38>
+        <Filename Value="upsi_bgrapascalscript.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="uPSI_BGRAPascalScript"/>
+      </Item38>
     </Files>
     <Type Value="RunAndDesignTime"/>
-    <RequiredPkgs Count="2">
+    <RequiredPkgs Count="3">
       <Item1>
-        <PackageName Value="BGRABitmapPack"/>
-        <MinVersion Major="7" Minor="3" Valid="True"/>
+        <PackageName Value="pascalscript"/>
       </Item1>
       <Item2>
-        <PackageName Value="IDEIntf"/>
+        <PackageName Value="BGRABitmapPack"/>
+        <MinVersion Major="7" Minor="3" Valid="True"/>
       </Item2>
+      <Item3>
+        <PackageName Value="IDEIntf"/>
+      </Item3>
     </RequiredPkgs>
     <UsageOptions>
       <UnitPath Value="$(PkgOutDir)"/>

bgracontrols.pas

@@ -14,7 +14,7 @@ uses
   BGRAScript, BGRAShape, BGRASpeedButton, BGRASpriteAnimation, 
   BGRAVirtualScreen, DTAnalogClock, DTAnalogCommon, DTAnalogGauge, 
   dtthemedclock, dtthemedgauge, uEKnob, ueled, uEMultiTurn, uERotImage, 
-  uESelector, LazarusPackageIntf;
+  uESelector, BGRAPascalScript, uPSI_BGRAPascalScript, LazarusPackageIntf;
 
 implementation
 
@@ -46,6 +46,7 @@ begin
   RegisterUnit('uEMultiTurn', @uEMultiTurn.Register);
   RegisterUnit('uERotImage', @uERotImage.Register);
   RegisterUnit('uESelector', @uESelector.Register);
+  RegisterUnit('uPSI_BGRAPascalScript', @uPSI_BGRAPascalScript.Register);
 end;
 
 initialization

bgrapascalscript.pas

@@ -0,0 +1,77 @@
+unit BGRAPascalScript;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, BGRABitmap, BGRABitmapTypes;
+
+var
+  BitmapArray: array of TBGRABitmap;
+
+{Internal use only}
+procedure bgra_Initialization;
+procedure bgra_Finalization;
+procedure bgra_AddBitmap(id: Integer);
+
+{Constructors}
+// Note: overloaded procedures not supported, use unique identifiers
+procedure bgra_Create(id: Integer);
+procedure bgra_CreateFromFile(id: Integer; AFilename: string);
+procedure bgra_Destroy(id: Integer);
+
+implementation
+
+procedure bgra_Initialization;
+begin
+  //
+end;
+
+procedure bgra_Finalization;
+var
+  i: integer;
+begin
+  for i:= 0 to High(BitmapArray) do
+  begin
+    if BitmapArray[i] <> nil then
+      BitmapArray[i].Free;
+    BitmapArray[i] := nil;
+  end;
+  BitmapArray := nil;
+end;
+
+procedure bgra_AddBitmap(id: Integer);
+begin
+  if id + 1 > length(BitmapArray) then
+    SetLength(BitmapArray, id + 1);
+  if BitmapArray[id] <> nil then
+    BitmapArray[id].Free;
+end;
+
+procedure bgra_Create(id: Integer);
+begin
+  bgra_AddBitmap(id);
+  BitmapArray[id] := TBGRABitmap.Create;
+end;
+
+procedure bgra_CreateFromFile(id: Integer; AFilename: string);
+begin
+  bgra_AddBitmap(id);
+  BitmapArray[id] := TBGRABitmap.Create(AFilename);
+end;
+
+procedure bgra_Destroy(id: Integer);
+begin
+  BitmapArray[id].Free;
+end;
+
+initialization
+  bgra_Initialization;
+
+finalization
+  bgra_Finalization;
+
+
+end.
+

test/test_bgrapascalscript/test_bgrapascalscript.lpi

@@ -0,0 +1,95 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="test_bgrapascalscript"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="3">
+      <Item1>
+        <PackageName Value="pascalscript"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="bgracontrols"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="LCL"/>
+      </Item3>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="test_bgrapascalscript.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test_bgrapascalscript"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="umain.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="umain"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="test_bgrapascalscript"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerMessages>
+        <MsgFileName Value=""/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

test/test_bgrapascalscript/test_bgrapascalscript.lpr

@@ -0,0 +1,21 @@
+program test_bgrapascalscript;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, pascalscript, umain
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource := True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

test/test_bgrapascalscript/umain.lfm

@@ -0,0 +1,71 @@
+object Form1: TForm1
+  Left = 465
+  Height = 550
+  Top = 205
+  Width = 644
+  Caption = 'Form1'
+  ClientHeight = 550
+  ClientWidth = 644
+  LCLVersion = '1.2.4.0'
+  object Memo1: TMemo
+    Left = 8
+    Height = 530
+    Top = 8
+    Width = 446
+    Lines.Strings = (
+      'Program Test_BGRAPascalScript;'
+      ''
+      'begin'
+      '  bgra_CreateFromFile(0,''16.png'');'
+      '  //bgra_Destroy(0);'
+      'end.'
+    )
+    TabOrder = 0
+  end
+  object Button1: TButton
+    Left = 464
+    Height = 35
+    Top = 8
+    Width = 112
+    AutoSize = True
+    Caption = '1 - Execute'
+    OnClick = Button1Click
+    TabOrder = 1
+  end
+  object Button2: TButton
+    Left = 464
+    Height = 35
+    Top = 44
+    Width = 85
+    AutoSize = True
+    Caption = '2 - Test'
+    Enabled = False
+    OnClick = Button2Click
+    TabOrder = 2
+  end
+  object BGRAVirtualScreen1: TBGRAVirtualScreen
+    Left = 464
+    Height = 32
+    Top = 88
+    Width = 32
+    OnRedraw = BGRAVirtualScreen1Redraw
+    Alignment = taLeftJustify
+    Color = clWhite
+    ParentColor = False
+    TabOrder = 3
+  end
+  object PSScript1: TPSScript
+    CompilerOptions = []
+    Plugins = <    
+      item
+        Plugin = PSImport_BGRAPascalScript1
+      end>
+    UsePreProcessor = False
+    left = 136
+    top = 19
+  end
+  object PSImport_BGRAPascalScript1: TPSImport_BGRAPascalScript
+    left = 136
+    top = 96
+  end
+end

test/test_bgrapascalscript/umain.pas

@@ -0,0 +1,63 @@
+unit umain;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  BGRAPascalScript, uPSI_BGRAPascalScript, BGRAVirtualScreen, uPSComponent,
+  BGRABitmap, BCTypes,
+  BGRABitmapTypes;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    BGRAVirtualScreen1: TBGRAVirtualScreen;
+    Button1: TButton;
+    Button2: TButton;
+    Memo1: TMemo;
+    PSImport_BGRAPascalScript1: TPSImport_BGRAPascalScript;
+    PSScript1: TPSScript;
+    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
+    procedure Button1Click(Sender: TObject);
+    procedure Button2Click(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  PSScript1.Script := Memo1.Lines;
+  if PSScript1.Compile then
+  begin
+    PSScript1.Execute;
+    Button2.Enabled := True;
+  end;
+end;
+
+procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
+begin
+  if Button2.Enabled then
+    Bitmap.StretchPutImage(Rect(0, 0, 32, 32), BitmapArray[0], dmSet);
+end;
+
+procedure TForm1.Button2Click(Sender: TObject);
+begin
+  BGRAVirtualScreen1.RedrawBitmap;
+end;
+
+end.

upsi_bgrapascalscript.pas

@@ -0,0 +1,87 @@
+unit uPSI_BGRAPascalScript;
+{
+This file has been generated by UnitParser v0.7, written by M. Knight
+and updated by NP. v/d Spek and George Birbilis. 
+Source Code from Carlo Kok has been used to implement various sections of
+UnitParser. Components of ROPS are used in the construction of UnitParser,
+code implementing the class wrapper is taken from Carlo Kok's conv utility
+
+}
+interface
+ 
+uses
+   SysUtils
+  ,Classes
+  ,uPSComponent
+  ,uPSRuntime
+  ,uPSCompiler
+  ;
+ 
+type 
+(*----------------------------------------------------------------------------*)
+  TPSImport_BGRAPascalScript = class(TPSPlugin)
+  protected
+    procedure CompileImport1(CompExec: TPSScript); override;
+    procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
+  end;
+ 
+ 
+{ compile-time registration functions }
+procedure SIRegister_bgrapascalscript(CL: TPSPascalCompiler);
+
+{ run-time registration functions }
+procedure RIRegister_bgrapascalscript_Routines(S: TPSExec);
+
+procedure Register;
+
+implementation
+
+
+uses
+   BGRABitmap
+  ,BGRABitmapTypes
+  ,BGRAPascalScript
+  ;
+ 
+ 
+procedure Register;
+begin
+  RegisterComponents('BGRA Controls', [TPSImport_bgrapascalscript]);
+end;
+
+(* === compile-time registration functions === *)
+(*----------------------------------------------------------------------------*)
+procedure SIRegister_BGRAPascalScript(CL: TPSPascalCompiler);
+begin
+ CL.AddDelphiFunction('Procedure bgra_Create( id : Integer)');
+ CL.AddDelphiFunction('Procedure bgra_CreateFromFile( id : Integer; AFilename : string)');
+ CL.AddDelphiFunction('Procedure bgra_Destroy( id : Integer)');
+end;
+
+(* === run-time registration functions === *)
+(*----------------------------------------------------------------------------*)
+procedure RIRegister_BGRAPascalScript_Routines(S: TPSExec);
+begin
+ S.RegisterDelphiFunction(@bgra_Create, 'bgra_Create', cdRegister);
+ S.RegisterDelphiFunction(@bgra_CreateFromFile, 'bgra_CreateFromFile', cdRegister);
+ S.RegisterDelphiFunction(@bgra_Destroy, 'bgra_Destroy', cdRegister);
+end;
+
+ 
+ 
+{ TPSImport_BGRAPascalScript }
+(*----------------------------------------------------------------------------*)
+procedure TPSImport_BGRAPascalScript.CompileImport1(CompExec: TPSScript);
+begin
+  SIRegister_BGRAPascalScript(CompExec.Comp);
+end;
+(*----------------------------------------------------------------------------*)
+procedure TPSImport_BGRAPascalScript.ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter);
+begin
+  //RIRegister_BGRAPascalScript(ri);
+  RIRegister_BGRAPascalScript_Routines(CompExec.Exec); // comment it if no routines
+end;
+(*----------------------------------------------------------------------------*)
+ 
+ 
+end.