by karinha » Sat Aug 26, 2006 12:29 pm
Ejemplo de lo que necesito:
{Este programa controla uma rede de terminais 485 através de dll.
Arquivos utilizados:
WTechLpt.dll:que pode ser encontrado na HomePage.(Deve ser colocada no mesmo diretório do programa).}
unit AcessaTerminal485;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus;
type
TFrmAcessaTerminal = class(TForm)
Abre: TButton;
Fecha: TButton;
Timer1: TTimer;
BtSair: TBitBtn;
Emulador: TCheckBox;
procedure AbreClick(Sender: TObject);
procedure FechaClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure BtSairClick(Sender: TObject);
end;
var
dado1 : char;
terminal:integer;
x:integer;
Status:Byte;
k:integer;
Car2,Car3,ByteCom:integer;
aux:string;
Emula:boolean;
QtdeTerms:integer;
//Vetores criados para controle de cada terminal
teclado:array[0..31] of string;
waitkbd:array[0..31] of boolean;
pikture:array[0..31] of string;
pospic :array[0..31] of integer;
estado :array[0..31] of integer;
vendedor:array[0..31] of string;
produto:array[0..31] of String;
quantidade:array[0..31] of string;
peso: array[0..31] of string;
pprinter:array[0..31] of string;
sprinter:array[0..31] of string;
pinpos:array[0..31] of integer;
poutpos:array[0..31] of integer;
sinpos:array[0..31] of integer;
soutpos:array[0..31] of integer;
FrmAcessaTerminal: TFrmAcessaTerminal;
//Declara funções da dll
function ConfigLpt(Endereco, Timeout:Word):Boolean; stdcall; external 'WTechLpt.dll';
procedure Dll_PosCur (Terminal, Lin, Col: Byte); stdcall; external 'WTechLpt.dll';
procedure Dll_Clear (Terminal:Byte); stdcall; external 'WTechLpt.dll';
procedure Dll_Echo (Terminal:Byte;Dado:char); stdcall; external 'WTechLpt.dll';
procedure Dll_Display (Terminal:Byte; Dado:string); stdcall; external 'WTechLpt.dll';
function Dll_Get(Terminal:Byte):char; stdcall; external 'WTechLpt.dll';
function Dll_Status(Terminal:Byte):Byte; stdcall; external 'WTechLpt.dll';
function Dll_Print(Terminal:Byte;dado:char):Byte; stdcall; external 'WTechLpt.dll';
function Dll_Serial(Terminal:Byte;dado:char):Byte; stdcall; external 'WTechLpt.dll';
function Dll_Acesso(Cmd:string):Integer;stdcall;external 'WTechLpt.dll';
implementation
uses Principal;
{$R *.DFM}
procedure Gdisplay( str:string );
var
Term:string;
begin
//Escreve a string correspondente no terminal selecionado
if Emula then
Form1.VEntrada.Text := chr(254)+ '00D'+str
else
begin
if terminal < 10 then
Term := '0'+inttostr(terminal)
else term := inttostr(terminal);
Dll_Acesso(chr(254)+term+'D'+str) ;
end;
end;
procedure Gecho( str:char );
begin
// Escreve o caracter correspondente no terminal selecionado
if Emula then
form1.VEntrada.Text :=chr(254)+'00D'+str
else
Dll_Echo(Terminal,str);
end;
procedure Gposcur( linha:integer; coluna:integer );
begin
//Posiciona o cursor na linha e coluna desejadas
if Emula then
form1.VEntrada.Text := chr(254)+'00C'+ chr(linha+1)+chr(coluna+1)
else
Dll_PosCur(Terminal,Linha, coluna);
end;
procedure Gclear;
var
Term:string;
begin
//Limpa o display do terminal
if Emula then
Form1.VEntrada.Text := chr(254)+'00L'
else
begin
if terminal < 10 then
Term := '0'+inttostr(terminal)
else term := inttostr(terminal);
Dll_Acesso(chr(254)+ term+'L');
end;
end;
procedure Gpedetecla;
var
AuxPede:string;
begin
//Recebe caracter do buffer
if Emula then
begin
if form1.VSaida.Text <> '' then
begin
AuxPede:=form1.VSaida.text;
dado1:=AuxPede[1];
delete(AuxPede,1,1);
form1.VSaida.text := AuxPede;
end
else
dado1 := chr(0);
end
else
dado1:= Dll_Get(Terminal);
aux:='';
if estado[terminal] = 8 then
begin
if dado1='\' then
begin
k:=2;
dado1:=chr(0);
end
else if k>1 then
begin
if k=2 then
begin
car2 := Ord(dado1);
car2:=car2 and 240;
dado1:=chr(car2);
dado1:=chr(0);
k:=3;
end
else
begin
car3:= ord(dado1);
car3:=car3 and 15;
dado1:=chr(car3);
x:=car2+car3;
dado1:=chr(x);
k:=1;
end;
end;
end;
end;
procedure Gget( str : string );
//Coloca máscara no valor digitado
begin
if (waitkbd[terminal]=false) then
begin
waitkbd[terminal] := true;
pospic[terminal] := 1;
pikture[terminal] := str;
teclado[terminal] := '';
end;
end;
procedure Gpedestatus;
begin
//Retorna byte de status do microterminal
if Emula then
begin
form1.VStatus.Text :='';
form1.VEntrada.text := chr(254)+'00U';
while form1.VStatus.Text = '' do
Application.processmessages;
status := ord(form1.VStatus.text[1]);
end
else
Status:=Dll_Status(Terminal);
end;
procedure Ginicia;
//Inicializa funcionamento do microterminal
var
i:integer;
begin
if FrmAcessaTerminal.Emulador.checked = false then
// Em Delphi - Eca...
ConfigLpt($378,250);//Configura porta e timeOut
for i:=0 to 31 do
begin
estado[i]:=1;
pikture[i]:='';
pospic[i]:=1;
waitkbd[i]:=false;
Terminal:=i;
pinpos[i]:=1;
pprinter[i]:='';
poutpos[i]:=1;
sprinter[i]:='';
sinpos[i]:=1;
soutpos[i]:=1;
Gclear();
Gclear();
end;
end;
procedure gAjustaPonto;
//Testa se a tecla ponto foi pressionada
var
PosPonto:integer;
StrDisp:string;
spPic:integer;
begin
PosPonto:=1;
while (copy(Pikture[terminal], PosPonto, 1) <> '.') do
begin
PosPonto := PosPonto + 1;
if PosPonto = length(Pikture[terminal]) then
Exit;
end;
if PosPonto = length(Pikture[terminal]) then
exit;
spPic := PosPonto - 1 - length(Teclado[terminal]);
StrDisp:='';
while spPic > 0 do
begin
StrDisp := StrDisp + ' ';
spPic:=spPic - 1;
end;
strdisp := strdisp + Teclado[terminal];
sppic := PosPic[terminal];
While sppic > 1 do
begin
Gecho (chr(8));
sppic := sppic - 1;
end;
PosPic[terminal] := posponto;
Gdisplay (strdisp);
Teclado[terminal] := strdisp;
end;
function GTrataTecla:boolean;
//Trata tecla que foi pressionada
var
gPict :string;
stecla : char;
tamanho:integer;
begin
if (WaitKbd[terminal] = false) then
begin
result := false;
exit;
end;
Gpedetecla();
stecla:=dado1;
if (sTecla = Chr(13)) then //se enter
begin
WaitKbd[terminal] := false;
result := true;
exit;
end;
if sTecla = Chr(127) then //
begin
if PosPic[terminal] = 1 then
begin
Teclado[terminal] := chr(127);
WaitKbd[terminal] := false;
result := true;
end
else
begin
repeat
Gecho( chr(8) );
pospic[terminal]:=pospic[terminal]-1;
until pospic[terminal]>1;
result:=false;
end;
exit;
end;
if sTecla=Chr(0) then
begin
result := false;
exit;
end;
if sTecla = Chr(8) then
begin
if PosPic[terminal] > 1 then
begin
gpict := copy (Pikture[terminal], pospic[terminal] - 1, 1);
if (gpict = '/') or (gpict = '.') then
begin
pospic[terminal] := pospic[terminal] - 1;
Gecho( chr(8) );
end;
pospic [terminal] := pospic[terminal] - 1;
Teclado[terminal] := copy (Teclado[terminal], 1, pospic[terminal] - 1);
Gecho(chr(8));
end;
result := false;
exit;
end;
gpict := copy (Pikture[terminal], pospic[terminal], 1);
if gpict = 'X' then
begin
Teclado[terminal] := Teclado[terminal] + sTecla;
pospic [terminal] := pospic [terminal] + 1;
gEcho (stecla);
end
else if gpict = '9' then // Somente aceitar numeros e "." ou "/" ou "-"
begin
if ((sTecla >= '0') and (sTecla <= '9')) or (sTecla = '.')
or (sTecla = '/')or (sTecla = '-') then
begin
if sTecla = '.' then begin
gAjustaPonto ();
end
else
begin
Teclado[terminal] := Teclado[terminal] + sTecla;
pospic [terminal] := pospic [terminal] + 1;
gEcho(stecla);
end;
end;
end
else if gpict = 'A' then // Alfabetico
begin
if (sTecla >= 'A') and (sTecla <= 'Z') then
begin
Teclado[terminal] := Teclado[terminal] + sTecla;
pospic [terminal] := pospic [terminal] + 1;
gEcho(stecla);
end;
end
else if gpict = '*' then // Senha
begin
Teclado[terminal] := Teclado[terminal] + sTecla;
pospic [terminal] := pospic [terminal] + 1;
gEcho ('*');
end
else
begin
result := false;
exit;
end;
tamanho := length(Pikture[terminal]) + 1;
gpict := copy (Pikture[terminal], pospic[terminal], 1);
if tamanho = pospic[terminal] then
begin
waitkbd[terminal] := false;
result := true;
end
else if gpict = '/' then
begin
pospic[terminal] := pospic[terminal] + 1;
gEcho ('/');
result := false;
end
else if gpict = '.' then
begin
sTecla := '.';
pospic[terminal] := pospic[terminal] + 1;
gEcho (stecla);
result := false;
end
else
result := false;
end;
procedure GPrintp(term:integer; dados:string);
begin
pinpos[term] := pinpos[term] + length(dados);
pprinter[term] := pprinter[term] + dados;
end;
procedure GPrints(term:integer; dados:string);
begin
sinpos[term] := sinpos[term] + length(dados);
sprinter[term] := sprinter[term] + dados;
end;
procedure GFlushPrn;
var
sAux:string;
aux:char;
begin
dado1:=chr(1);
while dado1 <> chr(0) do
begin
if pinpos[terminal] <> poutpos[terminal] then
begin
sAux := copy (pprinter[terminal], poutpos[terminal], 1);
aux:=sAux[1];
if Emula then
begin
Form1.VStatus.Text := '';
form1.VEntrada.Text := chr(254)+'00I'+aux;
while form1.VStatus.Text = '' do
application.ProcessMessages;
SAux:= form1.vstatus.Text;
Dado1:=SAux[1];
end
else
dado1:=chr(dll_print(terminal,aux));
if dado1 <>chr(0) then
poutpos[terminal]:=poutpos[terminal]+1;
end
else
begin
pprinter[terminal] := '';
pinpos[terminal] := 1;
poutpos[terminal] := 1;
dado1:= Chr(0);
end;
end;
end;
procedure GFlushCom();
var
sAux:string;
aux:char;
begin
dado1:=chr(1);
while dado1 <> chr(0) do
begin
if sinpos[terminal] <> soutpos[terminal] then
begin
sAux := copy (sprinter[terminal], soutpos[terminal], 1);
aux:=sAux[1];
if Emula then
begin
form1.VStatus.text:='';
form1.VEntrada.Text := chr(254)+'00R'+aux;
while form1.VStatus.Text = '' do
application.ProcessMessages;
SAux:= form1.VStatus.Text;
Dado1:=SAux[1];
end
else
dado1:=chr(Dll_Serial(terminal,aux));
if dado1<>chr(0) then
soutpos[terminal]:=soutpos[terminal]+1;
end
else
begin
sprinter[terminal] := '';
sinpos[terminal] := 1;
soutpos[terminal] := 1;
dado1:= Chr(0);
end;
end;
end;
procedure TFrmAcessaTerminal.AbreClick(Sender: TObject);
begin
if Emulador.Checked then
begin
Emula := true;
QtdeTerms := 1;
Form1.show;
end
else
QtdeTerms := 32;
Ginicia();
Timer1.enabled:=true;//Inicia Timer (Início do Programa)
k:=1;
end;
procedure TFrmAcessaTerminal.FechaClick(Sender: TObject);
begin
timer1.enabled:=false;//Finaliza Timer (Fim Programa)
Form1.Close;
end;
procedure TFrmAcessaTerminal.Timer1Timer(Sender: TObject);
begin
//Imprime no display o dado requerido de acordo com o estado do terminal
//correspondente.
for terminal:=0 to (QtdeTerms - 1) do
begin
GFlushCom;
case estado[terminal] of
1: begin
GClear();
Gdisplay('Codigo do Vendedor: ');
Gget( '99999' );
estado[terminal]:=2;
end;
2: begin
if Gtratatecla() then
begin
Gdisplay(teclado[Terminal] );
vendedor[terminal]:=teclado[Terminal];
estado[terminal]:=3;
end;
end;
3: begin
GClear();
Gdisplay('Codigo do Produto:');
Gget('999999999999999');
estado[terminal]:=4;
end;
4: if Gtratatecla() then
begin
GDisplay(teclado[terminal]);
produto[terminal]:=teclado[Terminal];
estado[terminal]:=5;
end;
5: begin
GClear();
GDisplay('Quantidade:');
GGet('9999');
estado[terminal] := 6;
end;
6: begin
if GTratatecla() then
begin
GDisplay(teclado[Terminal]);
quantidade[Terminal]:=teclado[Terminal];
estado[terminal] := 7;
end;
end;
7: begin
GClear();
GDisplay('Peso:');
GPrintS(terminal,chr(5));
GGet('999999');
estado[terminal]:=8;
end;
8: begin
if GTratatecla() then
begin
GDisplay(teclado[Terminal]);
peso[Terminal]:=teclado[Terminal];
estado[terminal] := 9;
end;
end;
9: begin
GClear();
GDisplay(vendedor[terminal]);
GPosCur(0,10);
GDisplay(produto[terminal]);
GPosCur(0,20);
GDisplay(quantidade[terminal]);
GPosCur(0,30);
GDisplay(peso[terminal]);
GPrintP(terminal,chr(10)+chr(13));
GPrintP(terminal,'Vendedor: '+vendedor[terminal]+chr(10)+chr(13));
GPrintP(terminal,'Produto: '+produto[terminal]+chr(10)+chr(13));
GPrintP(terminal,'Qtde: '+quantidade[terminal]+chr(10)+chr(13));
GPrintP(terminal,'Peso: '+peso[terminal]+chr(10)+chr(13));
GFlushprn();
Gget('9');
estado[terminal]:=10;
end;
10: begin
if GTrataTecla() then
estado[terminal]:=1;
end;
end;
end;
end;
procedure TFrmAcessaTerminal.BtSairClick(Sender: TObject);
begin
//Fecha Programa
if timer1.Enabled = true then
timer1.Enabled := false;
FrmAcessaTerminal.Close;
end;
end.
//
No Maestro,
Lo que necesito es esto:
// En Delphi - Eca... Iiiirrccc - jejejeje
ConfigLpt($378,250);//Configura porta e timeOut
Esto es para un LECTOR DE PRECIOS DE GONDOLA Usando una DLL.
//Declara funciones de la dll
function ConfigLpt(Endereco, Timeout:Word):Boolean; stdcall; external 'WTechLpt.dll';
procedure Dll_PosCur (Terminal, Lin, Col: Byte); stdcall; external 'WTechLpt.dll';
procedure Dll_Clear (Terminal:Byte); stdcall; external 'WTechLpt.dll';
procedure Dll_Echo (Terminal:Byte;Dado:char); stdcall; external 'WTechLpt.dll';
procedure Dll_Display (Terminal:Byte; Dado:string); stdcall; external 'WTechLpt.dll';
function Dll_Get(Terminal:Byte):char; stdcall; external 'WTechLpt.dll';
function Dll_Status(Terminal:Byte):Byte; stdcall; external 'WTechLpt.dll';
function Dll_Print(Terminal:Byte;dado:char):Byte; stdcall; external 'WTechLpt.dll';
function Dll_Serial(Terminal:Byte;dado:char):Byte; stdcall; external 'WTechLpt.dll';
function Dll_Acesso(Cmd:string):Integer;stdcall;external 'WTechLpt.dll';
Como hacer estas DECLARACIONES Antonio?
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341