Einzelnen Beitrag anzeigen

tkone

Registriert seit: 2. Okt 2009
Ort: Sachsen
63 Beiträge
 
Delphi 7 Professional
 
#7

AW: Ansteuerung eines Controllers (umscheiben VB --> delphi7)

  Alt 31. Aug 2010, 18:25
juhu, es funktioniert.
wichtig ist die richtigen datentypen zu verwenden.
jetzt kann ich weitere funkionen implementieren.

Delphi-Quellcode:
unit Controller;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

function OPENCOM (OpenString: ansistring): longint; stdcall; external 'RSCOM.dll';
procedure TIMEOUTS (b: longint); stdcall; external 'RSCOM.dll';
procedure BUFFERSIZE (b: longint); stdcall; external 'RSCOM.dll';
procedure CLOSECOM (); stdcall; external 'RSCOM.dll';
procedure SENDBYTE (Dat: longint); stdcall; external 'RSCOM.dll';
function READBYTE (): longint; stdcall; external 'RSCOM.dll';
procedure SENDSTRING (Dat: ansistring); stdcall; external 'RSCOM.dll';
function READSTRING (): ansiString; stdcall; external 'RSCOM.dll';
procedure CLEARBUFFER (); stdcall; external 'RSCOM.dll';
function INBUFFER (): longint; stdcall; external 'RSCOM.dll';
function OUTBUFFER (): longint; stdcall; external 'RSCOM.dll';
procedure DTR (b: longint); stdcall; external 'RSCOM.dll';
procedure RTS (b: longint); stdcall; external 'RSCOM.dll';
procedure TXD (b: longint); stdcall; external 'RSCOM.dll';
function CTS (): longint; stdcall; external 'RSCOM.dll';
function DSR (): longint; stdcall; external 'RSCOM.dll';
function RI (): longint; stdcall; external 'RSCOM.dll';
function DCD (): longint; stdcall; external 'RSCOM.dll';
function INPUTS (): longint; stdcall; external 'RSCOM.dll';
procedure TIMEINIT (); stdcall; external 'RSCOM.dll';
function TIMEREAD (): Double; stdcall; external 'RSCOM.dll';
procedure DELAY (ms: Double); stdcall; external 'RSCOM.dll';
procedure REALTIME (); stdcall; external 'RSCOM.dll';
procedure NORMALTIME (); stdcall; external 'RSCOM.dll';

function ShellExecuteA (hwnd: Longint; lpOperation: String; lpFile: String;
         lpParameters: String; lpDirectory: String; nShowCmd: Longint): Longint;
         stdcall; external 'shell32.dll';

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Label2: TLabel;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    ScrollBar1: TScrollBar;
    Label3: TLabel;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Timer1: TTimer;

    procedure Button6Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);

  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  Adr, Delaytime: longint;

implementation

{$R *.dfm}

procedure TForm1.Button6Click(Sender: TObject);
begin
  SENDBYTE (Adr);
  SENDBYTE (9);
  SENDBYTE (Delaytime);
end;

procedure TForm1.FormCreate(Sender: TObject);
var i: longint;
begin
Randomize;
i:= OPENCOM('COM1:9600,N,8,1');
If i = 0 Then
  begin
  i:= OPENCOM('COM2:9600,N,8,1');
  if i = 0 then
    begin
    i:= OPENCOM('COM3:9600,N,8,1');
    if i = 0 then
      begin
      i:= OPENCOM('COM4:9600,N,8,1');
      if i = 0 then
      showmessage('Kein Gerät erkannt')
      else DTR (4);
      end
    else DTR (3);
    end
  else DTR (2);
  end
else DTR (1);

TIMEINIT;
TIMEOUTS (300);
Delaytime:= 10;
Adr:= 0;
Timer1.Enabled:= False;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
If Adr = 0 then Adr:= 1;
If Adr = 1 then Adr:= 0;
If Adr = 2 then Adr:= 12;
If Adr = 12 then Adr:= 2;
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
If Adr = 0 then Adr:= 2;
If Adr = 1 then Adr:= 12;
If Adr = 2 then Adr:= 1;
If Adr = 12 then Adr:= 1;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CLOSECOM;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i: longint;
begin
CLOSECOM;
i:= OPENCOM('COM1:9600,N,8,1');
If i = 0 Then
  showmessage('COM Interface Error');
TIMEOUTS (300);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
i: longint;
begin
CLOSECOM;
i:= OPENCOM('COM2:9600,N,8,1');
If i = 0 Then
  showmessage('COM Interface Error');
TIMEOUTS (300);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
i: longint;
begin
CLOSECOM;
i:= OPENCOM('COM3:9600,N,8,1');
If i = 0 Then
  showmessage('COM Interface Error');
TIMEOUTS (300);
end;

procedure TForm1.Button5Click(Sender: TObject);
var
i: longint;
begin
CLOSECOM;
i:= OPENCOM('COM4:9600,N,8,1');
If i = 0 Then
  showmessage('COM Interface Error');
TIMEOUTS (300);
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
Timer1.Enabled:= True;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
Timer1.Enabled:= False;
end;

procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
Delaytime:= scrollbar1.Position;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var n, d : longint;

begin
For n:=1 To 8 do
  begin
  SENDBYTE (1);
  SENDBYTE (n);
  d:= Random (254) +1;
  SENDBYTE (d);
  end;
Timer1.Interval:= scrollbar1.position;
end;

End.
  Mit Zitat antworten Zitat