to jest w delphi ale moze pomoze tylko trzeba uzycprogrsamUserPort.exe i cos poprzestawiac zeby miec dostep do LPT
unit clpt_port;
interface
uses windows;
var
buffer : string;
lpt : integer = $378;
bufl : integer = 4;
akt : integer;
Lpt1Addr,Lpt2Addr,Lpt3Addr:Word;
PrevConf1,PrevConf2,PrevConf3:Byte;
procedure initialize_lpt(lpttype, buffer_level : integer);
procedure prt(portn : word; val : byte);
procedure write_lpt(a : byte; sterowanie : boolean);
procedure lcd_define(d0,d1,d2,d3,d4,d5,d6,d7 : byte);
procedure lcd_init;
procedure lcd_clear;
procedure lcd_home;
procedure lcd_shift;
procedure lcd_release;
procedure check_lpt;
function GetLpt1:Word;
function GetLpt2:Word;
function GetLpt3:Word;
function CheckECPMode(LPTNumber:Integer):Boolean;
function GetEcpMode(LPTNumber:Integer):Byte;
procedure SetEcpMode(LPTNumber:Integer;Mode:Byte);
procedure write_to_strob;
implementation
procedure check_lpt;
begin
Lpt1Addr:=GetLpt1;
Lpt2Addr:=GetLpt2;
Lpt3Addr:=GetLpt3;
end;
function checkECPMode(LPTNumber:Integer):Boolean;
var
EcrValue:Byte;
CtrlValue:Byte;
BaseAddr:Word;
ECRAddr:Word;
begin
if ((LPTNumber<1) or (LPTNumber>3)) then begin
MessageBeep(0);
Result:=False;
Exit;
end;
case LPTNumber of
1: BaseAddr:=Lpt1Addr;
2: BaseAddr:=Lpt2Addr;
3: BaseAddr:=Lpt3Addr;
end;
ECRAddr:=BaseAddr + $402;
asm
mov dx,ECRAddr
in al,dx
mov EcrValue,al
end;
if (((EcrValue and $01) <> $01) or ((EcrValue and $02) <> 0)) then begin
Result:= False;
Exit;
end;
asm
mov dx,ECRAddr
mov al,$34
out dx,al
end;
asm
mov dx,ECRAddr
in al,dx
mov CtrlValue,al
end;
if CtrlValue=$35 then begin
Result:=True;
asm
mov dx,ECRAddr
mov al,EcrValue
out dx,al
end;
end else Result:=False;
end;
procedure SetEcpMode(LPTNumber:Integer;Mode:Byte);
var
EcrValue:Byte;
BaseAddr:Word;
ECRAddr:Word;
begin
if ((LPTNumber<1) or (LPTNumber>3)) then Exit;
case LPTNumber of
1: BaseAddr:=Lpt1Addr;
2: BaseAddr:=Lpt2Addr;
3: BaseAddr:=Lpt3Addr;
end;
ECRAddr:=BaseAddr + $402;
asm
mov dx,ECRAddr
in al,dx
mov EcrValue,al
end;
EcrValue:=EcrValue and $1f or (Mode shl 5);
asm
mov dx,ECRAddr
mov al,EcrValue
out dx,al
end;
end;
function GetEcpMode(LPTNumber:Integer):Byte;
var
EcrValue:Byte;
BaseAddr:Word;
ECRAddr:Word;
begin
if ((LPTNumber<1) or (LPTNumber>3)) then begin
MessageBeep(0);
Result:=0;
Exit;
end;
case LPTNumber of
1: BaseAddr:=Lpt1Addr;
2: BaseAddr:=Lpt2Addr;
3: BaseAddr:=Lpt3Addr;
end;
ECRAddr:=BaseAddr + $402;
asm
mov dx,ECRAddr
in al,dx
mov EcrValue,al
end;
Result:=EcrValue shr 5;
end;
function GetLpt1:Word;
begin
asm
push es;
mov ax, $40;
mov es, ax
db $66, $26, $67, $a1, $08, $00
pop es;
mov Result,ax
end;
end;
function GetLpt2:Word;
begin
asm
push es;
mov ax, $40;
mov es, ax
db $66, $26, $67, $a1, $0a, $00
pop es;
mov Result,ax
end;
end;
function GetLpt3:Word;
begin
asm
push es;
mov ax, $40;
mov es, ax
db $66, $26, $67, $a1, $0c, $00
pop es;
mov Result,ax
end;
end;
////////////
procedure initialize_lpt(lpttype, buffer_level : integer);
begin
lpt := lpttype; //$278, $378
bufl := buffer_level;
lcd_init;
end;
procedure prt(portn : word; val : byte);
begin
asm
mov al, val
mov dx,portn
out dx,al
end;
end;
procedure write_lpt(a : byte; sterowanie : boolean);
begin
if sterowanie = true then
begin
prt(lpt+$02,$09);
prt(lpt+$00,a);
prt(lpt+$02,$01);
prt(lpt+$02,$09);
end else
begin
prt(lpt+$02,$08);
prt(lpt+$00,a);
prt(lpt+$02,$00);
prt(lpt+$02,$08);
end; //eof sterowanie
end; //eof procka
procedure lcd_define(d0,d1,d2,d3,d4,d5,d6,d7 : byte);
begin
sleep(10);
write_lpt(d0,false);
sleep(10);
write_lpt(d1,false);
sleep(10);
write_lpt(d2,false);
sleep(10);
write_lpt(d3,false);
sleep(10);
write_lpt(d4,false);
sleep(10);
write_lpt(d5,false);
sleep(10);
write_lpt(d6,false);
sleep(10);
write_lpt(d7,false);
sleep(10);
end;
procedure lcd_init;
begin
{sleep(10);
write_lpt(32+16+8,true);
sleep(10);
write_lpt(16+4,true);
sleep(10);
write_lpt(8+4,true);
sleep(10);
write_lpt(4+2,true);
sleep(10);
write_lpt(1,true);
sleep(1000);
write_lpt(64,true);
sleep(10);
lcd_define(0,0,0,0,0,0,0,31);
lcd_define(0,0,0,0,0,0,31,31);
lcd_define(0,0,0,0,0,31,31,31);
lcd_define(0,0,0,0,31,31,31,31);
lcd_define(0,0,0,31,31,31,31,31);
lcd_define(0,0,31,31,31,31,31,31);
lcd_define(0,31,31,31,31,31,31,31);
lcd_define(31,31,31,31,31,31,31,31);
sleep(10); }
end;
procedure lcd_clear;
begin
write_lpt(1,true);
end;
procedure lcd_home;
begin
write_lpt(2,true);
end;
procedure lcd_shift;
begin
write_lpt(16+8+4+1,true);
end;
procedure lcd_release;
var
i : integer;
begin
lcd_home;
for i:=0 to length(buffer) do
write_lpt(ord(buffer[i]),false);
end;
procedure write_to_strob;
begin
//lcd_home;
write_lpt(ord('1'),false);
end;
end.
a pozniej oblsuga dla 3 diod czerwonej niebiejskiej i zielonej.
to jest tak mamy klase tswiatlo ktora ma wartosci pozycjai kolor
zaswiec_bajtem to swieci i nie gasnie dopiero jak jest zgas_wszystko; wywolane to sie gasi
unit HALM_UNIT;
interface
uses windows, classes, dialogs, sysutils, clpt_port,gldynamiclight,noxx_math,glarraytypes,variables;
procedure TEST_HAML_LPT(position : t3dpoint; lights : array of tnoxx_gllight);
procedure zgas_wszystko;
procedure bum(x:integer);
implementation
//bezkolizyjne Światła
{
NIEBIESKI = 33
CZERWONY = 17
ZIELONY = 3
//MIKSY SWIATEL
CZERWONY + ZIELONY = 18
ZIELONY + NIEBIESKI = 34
CZERWONY + NIEBIESKI = 38
CZERWONY + ZIELONY + NIEBIESKI = 50
}
var
HAML_INITIALIZED : BOOLEAN = false;
SWIATLA_SWIECA : boolean = false;
SWIATLA_SWIECAI : integer;
procedure initialize_hardware;
begin
initialize_lpt($378,4);
HAML_INITIALIZED := true;
end;
procedure zaswiec_niebieski(x : integer);
begin
write_lpt(ord('1'),false);
SWIATLA_SWIECA := true;
SWIATLA_SWIECAI := x;
end;
procedure zaswiec_bajtem(x : byte);
begin
write_lpt(x,false);
end;
procedure zgas_wszystko;
begin
lcd_clear;
end;
function rgbaTO_LOGICAL(COLOR : text4dpoint) : byte;
begin
//if COLOR[0] > c
end;
procedure bum(x : integer);
begin
if x = 0 then
zaswiec_bajtem(17);
if x = 1 then zaswiec_bajtem(3);
if x = 2 then zaswiec_bajtem(33);
end;
procedure TEST_HAML_LPT(position : t3dpoint; lights : array of tnoxx_gllight);
var
i : integer;
wynikowa : text4dpoint;
R,G,B : boolean; Wr,Wg,Wb:boolean;
begin
R:=FALSE;
G:=FALSE;
B:=FALSE;
ileswieci := 0;
wynikowa[0] := 0.0; wynikowa[1] := 0.0; wynikowa[2] := 0.0;
wR:=FALSE;
wG:=FALSE;
wB:=FALSE;
for i:=0 to high(lights) do begin
lights[i].LED_R := FALSE; lights[i].LED_G := FALSE; lights[i].LED_B := FALSE;
if n3ddistance(lights[i].pos,position) < 300 then begin
if (lights[i].rgba[0]-0.3 > lights[i].rgba[1]) and (lights[i].rgba[0]-0.3 > lights[i].rgba[2]) then begin R := TRUE; lights[i].LED_R := TRUE; end;
if (lights[i].rgba[1]-0.3 > lights[i].rgba[0]) and (lights[i].rgba[1]-0.3 > lights[i].rgba[2]) then begin G := TRUE; lights[i].LED_G := TRUE; end;
if (lights[i].rgba[2]-0.3 > lights[i].rgba[1]) and (lights[i].rgba[2]-0.3 > lights[i].rgba[0]) then begin B := TRUE; lights[i].LED_B := TRUE; end;
if (lights[i].rgba[0] = lights[i].rgba[1]) and (lights[i].rgba[1] = lights[i].rgba[2] ) then
begin
R :=true; B:=true; G := true;
lights[i].LED_R := TRUE;
lights[i].LED_G := TRUE;
lights[i].LED_B := TRUE;
end;
if lights[i].LED_LIGHT.led_type = tlsBassFLASH then begin
if BASS_BEAT < 1.8 then begin
if HAML_SUPPORTED then zgas_wszystko;
{if lights[i].LED_R = TRUE then R := FALSE;
if lights[i].LED_G = TRUE then G := FALSE;
if lights[i].LED_B = TRUE then B := FALSE; }
end; end;
{
if lights[i].LED_LIGHT.led_type = tlsSTATIC then begin
if R = FALSE then if wR = true then r := true;
if g = FALSE then if wg = true then g := true;
if b = FALSE then if wR = true then b := true;
end; }
ileswieci := ileswieci + 1;
wynikowa[0] := wynikowa[0] + lights[i].rgba[0];
wynikowa[1] := wynikowa[1] + lights[i].rgba[1];
wynikowa[2] := wynikowa[2] + lights[i].rgba[2];
end;
//R := ADD_BOOL(wR,false);
if (R =true) and (g=true) and (b=true) then zaswiec_bajtem(50);
if (R =true) and (g=false) and (b=true) then zaswiec_bajtem(55);
if (R =true) and (g=true) and (b=false) then zaswiec_bajtem(18);
if (R =false) and (g=true) and (b=true) then zaswiec_bajtem(34);
if (R =true) and (g=false) and (b=false) then zaswiec_bajtem(17);
if (R =false) and (g=true) and (b=false) then zaswiec_bajtem(3);
if (R =false) and (g=false) and (b=true) then zaswiec_bajtem(33);
{
NIEBIESKI = 33
CZERWONY = 17
ZIELONY = 3
}
if ileswieci <> 0 then begin
wynikowa[0] := wynikowa[0]/ileswieci;
wynikowa[1] := wynikowa[1]/ileswieci;
wynikowa[2] := wynikowa[2]/ileswieci;
end;
if ileswieci = 0 then if HAML_SUPPORTED then zgas_wszystko;
end;
end;
end.