Delphi Pascal functions

Navigation:  Programmer developer tools > Application extension > Program source code >

Delphi Pascal functions

Previous pageReturn to chapter overviewNext page

This Pascal code is from the Delphi XE2 platform (full unicode compliant). The example code supplied with Jeanie does also include Delphi 5 code.

This source code is found in the file Jeanie.pas

 

unit DynJeanie;

//This unit calls the JeanieComObj.DLL

//as a dynamic call, finding it in the Jeanie install directory

//this is the preferred method

interface

uses windows;

type

 MvmtClass = (mcPairs, mcIndividuals);

 MvmtType = (mtAny,

                        mt3QHowell,

           mt1HalfAMitchell,

           mtwhist,

           mtAppHowell,

           mtAppMitchell,

           mtBlackpool,

           mtBlockMitchell,

           mtBowman,

           mtCrissCrossMitchell,

           mtDispMitchell,

           mtDoubleHesMitchell,

           mtDoubleHowell,

           mtDoubleWeaveMitchell,

           mtExtraBoardHowell,

           mtExtraBoardMitchell,

           mtFlowerHowell,

           mtHesitationBowman,

           mtHesitationMitchell,

           mtHowell,

           mtInterwovenHowell,

           mtMitchell,

           mtNSRover,

           mtRelayMitchell,

           mtRovertableMitchell,

           mtSkipMitchell,

           mtStaggerMitchell,

           mtTwinMitchells,

           mtUndefined,

           mtWebMitchell,

           mtiHowelltype,

           mtiMitchelltype,

           mtiIrregular,

           mtiCombination,

           mtiShomate,

           mtPivotMitchell,

           mt2TAppMitchell,

           mtiUser1,

           mtiUser2,

           mtiUser3,

           mtiUser4,

           mtiUser5,

           mtUser1,

           mtUser2,

           mtUser3,

           mtUser4,

           mtUser5);

 

 

 ScorerType = (stASE, stSB, stACBL);

 

//************************************************

//  Set up Dynamic Functions for DLL

// All function return a boolean result as smallInt

// zero is false and -1 is true

 

// Main entry points to Jeanie tools

// ask the user to choose a movement

 tPickMovement = function(MvtClass, MvtType, Players, rounds, winners: smallInt;

                                               var FileNo, BrdPerSet: smallInt; LibName: PChar): smallInt; stdcall;

// write the movement to a text file

       tExportMovement = function(Scorer, FileNo: smallInt; LibName, filename: PChar): smallInt; stdcall;

// get the full details of the movement

 tGetDetails = function (var Tables, rounds, winners, BrdPerSet, players, Brdsets, balance, MovementClass, FileNo: smallInt;

                  name, MovementType, Description, Reference, page, MII, LibName: PChar): smallInt; stdcall;

 

//************************************************

// Other entry points to Jeanie tools

// In iteration use "first" then "next" until false returned followed by "Close"

 

// Iterate through the libraries

 tGetFirstLib = function (LibName: PChar): smallInt; stdcall;

 tGetNexttLib = function (LibName: PChar): smallInt; stdcall;

 tGetLibClose = function : smallInt; stdcall;

// Iterate through the movements of the library with properties supplied

 tGetFirstMvt = function (MvtClass, Tables, players, rounds, winners, balance, MovementType: smallInt; var FileNo: smallInt;

                       Reference, LibName: PChar): smallInt; stdcall;

 tGetNextMvt = function (var FileNo: smallInt): smallInt; stdcall;

 tGetMvtClose = function : smallInt; stdcall;

// get the details from the index file - basic information

 tGetDisplay = function (var Tables, rounds, winners, players, balance, Sets, MovementType, FileNo: smallInt;

                  name, Reference, Page: PChar): smallInt; stdcall;

// load up the names of the movements for the class in use

// so the "GetMovementName" will work

 tLoadMovementText = function (MvtClass: smallInt): smallInt; stdcall;

// unload before load is used - just to tidy up

 tUnLoadMovementText = function : smallInt; stdcall;

// Give me the movement name of supplied type

 tGetMovementName = function (mvtType: smallInt; MvtName: PChar): smallInt; stdcall;

//give me the name of the movement, in movement class of supplied type

// combination of LoadMovementText, GetMovementName, UnLoadMovementText

 tGetMovementTitle = function (MvtClass, mvtType: smallInt; var MvtTitle: PChar): smallInt; stdcall;

// Return index (0 based) of the movement with supplied name

// add 1 to get movement type. If false then mvtIdx = -1

 tGetMovementIndex = function (var mvtIdx: smallInt; MvtName: PChar): smallInt; stdcall;

// Iterate through all the movement names

// After LoadMovementtext of class this returns first movement name of that class

 tGetFirstMvtName = function (MvtName: PChar): smallInt; stdcall;

// After GetFirstMvtName this returns next movement name of the class

// will return false at end of list

 tGetNextMvtName = function (MvtName: PChar): smallInt; stdcall;

//************************************************

// end Other entry points to Jeanie tools

//  End of Dynamic Functions

 

function JeanieInstalled: boolean;

function ReleaseJeanie: boolean;

 

//*************************************************************

//Native format calls

// Main entry points to Jeanie tools

// ask the user to choose a movement

 

function UserChooses(MovementClass: MvmtClass; MovementType: MvmtType; Players, rounds, winners: smallInt;

                                 var FileNo, BrdsPerSet: smallInt;

                               var LibName: string): boolean;

 

// write the movement to a text file

function SaveMovement(Scorer: ScorerType;

                                 FileNo: smallInt;

                                 LibName, filename: string): boolean;

 

// get the full details of the movement

function GetProperties(var Tables, rounds, winners, BrdPerSet, players, Brdsets, balance: smallInt;

                                 var MovementType: string;

                                 FileNo: smallInt;

                               var name, Description, Reference, page: string;

                       LibName: string): boolean;

 

var

 JeanieDLL: THandle;

 PickMovement: tPickMovement;

 ExportMovement: tExportMovement;

 GetDetails: tGetDetails;

//any other entry points just define here

 

 

implementation

uses registry, sysutils;

 

function GetSysPath: string;

var

 Reg: TRegistry;

begin

 Reg := TRegistry.Create;

try

   Reg.RootKey := HKEY_LOCAL_MACHINE;

  if Reg.OpenKey('\Software\ASEComputing\Jeanie2', False) then

  //false means do not create if not there

               result := Reg.ReadString('Path')

  else

         result := '';

finally

   Reg.CloseKey;

   Reg.Free;

end;

end;

 

function JeanieInstalled: boolean;

var

 s: string;

begin

 s := GetSysPath;

if s <> '' then

    if FileExists(s + '\JeanieComObj.dll') then

    begin

      JeanieDLL := LoadLibrary(PChar(s + '\JeanieComObj.dll'));

      if JeanieDLL <> 0 then

        begin

          PickMovement := GetProcAddress(JeanieDLL, 'PickMovement');

          ExportMovement := GetProcAddress(JeanieDLL, 'ExportMovement');

          GetDetails := GetProcAddress(JeanieDLL, 'GetDetails');

//any other entry points just define here

          Result := True;

        end

      else

        result := false;

    end

    else

        result := false

else

       result := false;

end;

 

function ReleaseJeanie: boolean;

begin

 if JeanieDLL <> null then

         result := FreeLibrary(JeanieDLL)

else

       result := false;

end;

 

 

// ask the user to choose a movement

function UserChooses(MovementClass: MvmtClass; MovementType: MvmtType; Players, rounds, winners: smallInt;

                                 var FileNo, BrdsPerSet: smallInt;

                               var LibName: string): boolean;

var

 lpLibName: array [0..1023] of Char;

 MvtClass, MvtType: smallint;

begin

 LibName := #0;

if length(LibName) < 1024 then

begin

       strcopy(lpLibName, pchar(LibName));

    MvtClass := ord(MovementClass);

    MvtType := ord(MovementType);

 

    if  boolean(PickMovement(MvtClass, MvtType, Players, rounds, winners, FileNo, BrdsPerSet, lpLibName)) then

    begin

       LibName := lpLibName;

       result := true;

    end

    else

       result := false;

end

else

    result := false;

end;

 

// write the movement to a text file

function SaveMovement(Scorer: ScorerType;

                                 FileNo: smallInt;

                                 LibName, filename: string): boolean;

var

 lpLibName: array [0..1023] of Char;

 lpFileName: array [0..1023] of Char;

 screr: smallint;

begin

 result := false;

 

if length(LibName) < 1024 then

 begin

       lpLibName := #0;

         strcopy(lpLibName, pchar(LibName));

end

else

       exit;

 

if length(FileName) < 1024 then

 begin

       lpFileName := #0;

         strcopy(lpFileName, pchar(FileName));

end

else

       exit;

 

 screr := ord(Scorer);

if boolean(ExportMovement(Screr, FileNo, lpLibName, lpFilename)) then

       result := true;

end;

 

// get the full details of the movement

function GetProperties(var Tables, rounds, winners, BrdPerSet, players, Brdsets, balance: smallInt;

                                 var MovementType: string;

                                 FileNo: smallInt;

                               var name, Description, Reference, page: string;

                       LibName: string): boolean;

var

 lpName, lpReference, lpLibName: array [0..1023] of Char;

 lpDescription: array [0..2048] of Char;

 lpPage: array [0..64] of Char;

 lpMvtType: array [0..64] of Char;

 lpMII: array [0..64] of Char;

 MvtType: smallint;

begin

 

  result := false;

 

  if length(LibName) < 1024 then

  begin

       lpLibName := #0;

         strcopy(lpLibName, pchar(LibName));

  end

  else

       exit;

  lpName := #0;

  lpReference := #0;

  lpDescription := #0;

  lpPage := #0;

  lpMvtType := #0;

  lpMII := #0;

 

  if boolean(GetDetails(Tables, rounds, winners, BrdPerSet, players, Brdsets, balance, MvtType, FileNo,

                  lpName, lpMvtType, lpDescription, lpReference, lpPage, lpMII, lpLibName)) then

  begin

          Name := lpName;

     Description := lpDescription;

     Reference := lpReference;

     Page := lpPage;

     MovementType := lpMvtType;

     Result := true;

  end;

end;

 

end.