procedure PortOut(Port : Word; Data : Byte); stdcall; external 'io.dll';
function PortIn(Port:Word):Byte; stdcall; external 'io.dll';
function writeport(dc:integer;db:integer):integer;
var
databyte:integer;
begin
        databyte:=32+4+2*db+16 ;
        PortOut(888,databyte);
        //sleep(10);
        PortOut(888,databyte+1);
        //sleep(10);
        PortOut(888,databyte);
       // sleep(10);
end;
function dataport(dc:integer;db7:integer;db6:integer;db5:integer;db4:integer;db3:integer;db2:integer;db1:integer;db0:integer):integer;
begin
    writeport(dc,db7);
    writeport(dc,db6);
    writeport(dc,db5);
    writeport(dc,db4);
    writeport(dc,db3);
    writeport(dc,db2);
    writeport(dc,db1);
    writeport(dc,db0);
end;



procedure TForm1.Button1Click(Sender: TObject);

begin
    PortOut(888,63);
    sleep(20);
    PortOut(888,59);
    sleep(250);
    PortOut(888,63);
    sleep(20);
    PortOut (888,54);
    sleep(10);

    dataport(0,0,0,1,0,0,0,0,1);
    dataport(0,1,0,0,1,0,0,0,0);
    dataport(0,0,0,1,0,0,0,0,0);
    dataport(0,0,0,0,0,1,1,0,0);
    dataport(1,0,0,0,1,1,1,1,1);
    dataport(1,0,0,0,1,1,1,1,1);
    dataport(1,0,0,0,1,1,1,1,1);
    dataport(1,0,0,0,1,1,1,1,1);
    PortOut(888,56);


end;

procedure TForm1.Button3Click(Sender: TObject);
begin
       PortOut (888,00);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin

end;

end.

unit controller;

interface
uses
  SysUtils;

const ID = 'Nokia 3210/3310 (Philips PCD8544)'; //ID sets the description of the dll
      MAX_RESPIXELS = 4032;

type TCharData = record
                  position : byte;
                  data : array[0..7,0..7] of byte;
                 end;
     TDLLInfo = record
                 IDArray : array[0..255] of byte;
                 SupportGfxLCD : Boolean;
                 SupportTxtLCD : Boolean;
                 SupportSlider : Boolean;
                 CCharWidth : Byte;
                 CCharHeight : Byte;
                 FontPitch : Byte;
                end;
     TSymbolInfo = record
                    SymbolData : array[0..19] of boolean;
                   end;

     TArrayType = array[0..MAX_RESPIXELS-1] of byte;
var
  Ports: INTEGER;
//Sends Data to the Controller Chip
procedure LCD_SendToController(Value : Byte); stdcall;

//Sends Data to the integrated LCD Memory
//on adress specified by LCD_SetOutputAdress
procedure LCD_SendToMemory(Value : Byte); stdcall;

//Sends Data to LCD Gfx Memory
procedure LCD_SendToGfxMemory(Pixels : TArrayType; X1,Y1,X2,Y2 : Word; inverted : boolean); stdcall;

//Sets the LCD RAM Adress for Outputs
procedure LCD_SetOutputAddress(x,y : Longword); stdcall;

//Sets a LCD Custom Char specified in cdata
procedure LCD_SetCGRAMChar(cdata : TCharData); stdcall;

//Returns the Custom Char bytecode for the current display
//Based on the HD44780 eg. the input for the first Custom Char
//is position=0 and the return value is the equivalent bytecode
//to the HD44780 Custom Char bytecode
function LCD_GetCGRAMChar(position : Byte) : Byte; stdcall;

//Initialize the LCD
procedure LCD_Init; stdcall;

//Called when DLL released
procedure LCD_CleanUp; stdcall;

//Sets the Port Adress where the LCD are connected and
//the lcd execution time for processing sended data
procedure LCD_SetIOPropertys(Port : pchar;
                             Exectime : Longword;
                             ExectimeGfx : Longword;
                             X,Y : longword;
                             GX,GY : Longword;
                             LightOn : Boolean;
                             SliderValue : Byte;
                             UnderlineMode : Boolean;
                             UnderlineOutput : Boolean); stdcall;

//This is a routine for customizing output,
//by default only used by m50530 symbol lcd
procedure LCD_Customize(SymData : TSymbolInfo); stdcall;

//Caller of this function gets some info about the DLL
function DLL_GetInfo : TDLLInfo; stdcall;

//Signals if the write sequence to LCD is ended or not
function LCD_IsReadyToReceive : boolean; stdcall;

//Imported DLL Routine from DriverLinx PortIO DLL Driver
function DlPortReadPortUchar(Port:longint):byte;stdcall;external 'DLPORTIO.DLL';
procedure DlPortWritePortUchar(Port:longint;Value:byte);stdcall;external 'DLPORTIO.DLL';

implementation
//-----------------------------------------------
procedure Command (Value: Byte);
var i : Byte;
begin
DlPortWritePortUchar(Ports-2 , 254);

For i := 7 downto 0 do
if (Value And Round(exp(i*ln(2))))>0 then
  begin
//   DlPortWritePortUchar($37A , 0) ;
   DlPortWritePortUchar(Ports , 2) ;
   DlPortWritePortUchar(Ports , 0) ;
  end
else
  begin
//   DlPortWritePortUchar($37A , 1);
   DlPortWritePortUchar(Ports , 3) ;
   DlPortWritePortUchar(Ports , 1) ;
  end;
end;
//-----------------------------------------------
procedure Data (Value: Byte);
var i : Byte;
begin
DlPortWritePortUchar(Ports-2 , 255);

For i := 7 downto 0 do
if (Value And Round(exp(i*ln(2))))>0 then
  begin
//   DlPortWritePortUchar($37A , 0) ;
   DlPortWritePortUchar(Ports , 2) ;
   DlPortWritePortUchar(Ports , 0) ;
  end
else
  begin
//   DlPortWritePortUchar($37A , 1);
   DlPortWritePortUchar(Ports , 3) ;
   DlPortWritePortUchar(Ports , 1) ;
  end;

end;


//-----------------------------------------------
//a small routine for generating very short delays
procedure Wait(x : longword);
var c : longword;
begin
     for c:=0 to x do  ;
      DlPortReadPortUchar($220); //read = 1 microsecond delay
end;
//-----------------------------------------------
procedure LCD_SetIOPropertys(Port : pchar;
                             Exectime : longword;
                             ExectimeGfx : Longword;
                             X,Y : Longword;
                             GX,GY : Longword;
                             LightOn : Boolean;
                             SliderValue : Byte;
                             UnderlineMode : Boolean;
                             UnderlineOutput : Boolean);
begin
Ports:=StrToInt('$'+Port)+2;
DlPortWritePortUchar(Ports-2,255)
//if LightOn then DlPortWritePortUchar(Ports-2,255)
//  else DlPortWritePortUchar( Ports-2,31) ;
end;

function DLL_GetInfo : TDLLInfo;
var c : integer; x : TDLLInfo;
begin
     //copy lcd driver name to structure
     for c:=0 to 255 do x.IDArray[c] := 0;
     for c:=1 to length(ID) do begin
      x.IDArray[c-1] := ord(ID[c]);
     end;

     x.SupportGfxLCD := true; //do we support gfx output?
     x.SupportTxtLCD := false;  //do we support txt output?
     x.SupportSlider := false; //do we support the slider in lcdhype output?
     x.CCharWidth := 0; //max custom char width in pixels
     x.CCharHeight := 0; //max custom char height in pixels
     x.FontPitch := 6; //fontpitch of lcd

     result := x;
end;




function LCD_IsReadyToReceive : boolean;
begin
result:=true;
end;

procedure LCD_SendToController(Value : Byte);
begin
end;

procedure LCD_SendToGfxMemory(Pixels : TArrayType; X1,Y1,X2,Y2 : Word; inverted : boolean);
var
  j ,i , z , Bitmap: byte;
begin
Command ($40)   ;
Command ($80)   ;
j:=0 ;
while j<47 do
 begin
   for i := 0 to 83 do
     begin
      Bitmap := 0;
      for z:=0 to 7 do
       if Pixels[i+ (z*84)+(j*84)]>0 then Bitmap :=Bitmap + Round(exp(z*ln(2))) ;
       data (Bitmap);
     end;                                                     
   j:=j+8 ;
  end;

end;

procedure LCD_SendToMemory(Value : Byte);
begin
end;

procedure LCD_SetOutputAddress(x,y : Longword);
begin
end;

procedure LCD_SetCGRAMChar(cdata : TCharData);
begin
end;

function LCD_GetCGRAMChar(position : Byte) : Byte;
begin result := position;
end;

procedure LCD_Init;
var
i : integer ;
begin
DlPortWritePortUchar(Ports-2 , 254);

Command ($21) ;
Command ($b7) ;   //  VOLTAGE  $80-&FF  (äîáàâèòü íàñòîðîéêó)
Command ($6)  ;   //  TEMP
Command ($13) ;   //  BIAS
Command ($20) ;
Command ($9)   ;
Command ($8)   ;
Command ($C)   ;
Command ($40)   ;
Command ($80)   ;
Command ($C)    ;
For i := 0 To 504 do data (0) ;   //clear lcd
end;

procedure LCD_CleanUp;
begin
DlPortWritePortUchar(Ports-2 , 0);  //lcd off
end;

procedure LCD_Customize(SymData : TSymbolInfo);
begin
end;


end.