Программное обеспечение для работы с многоканальным осциллографом в среде Windows

Приложение 1.

unit uMem;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ComCtrls, ExtCtrls, consts_,zlportio, Spin, Menus;

Const

CS_RD : byte = 0;  // Reading data from ADC

Conv  : byte = 1;  // Starting ADC convrsion ~1.5 microsec

CLK   : byte = 2;  // CLK to latch ATT, MUX, CH data in 74ls273

None  : byte = 11; // nothing

Bi    : byte = 32; // enable bidirectional feature of lpt

type

TfScanData = class(TForm)

Button1: TButton;

eRam: TLabeledEdit;

eFreeRam: TLabeledEdit;

pbMemLoad: TProgressBar;

laStatus: TLabel;

Button2: TButton;

Button3: TButton;

Label1: TLabel;

pChannels: TPanel;

Button4: TButton;

SpinEdit1: TSpinEdit;

SpinEdit2: TSpinEdit;

Label2: TLabel;

Label3: TLabel;

MainMenu1: TMainMenu;

N11: TMenuItem;

N21: TMenuItem;

N111: TMenuItem;

Site1: TMenuItem;

Exit1: TMenuItem;

About1: TMenuItem;

Label4: TLabel;

Button5: TButton;

N1: TMenuItem;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Button4Click(Sender: TObject);

private

Channel : array[0..7] of TPaintBox;

public

LPTBase : Word;

LPTStatus : Word;

LPTControl : Word; 

msADCData : TMemoryStream;

ThreadRun : boolean;

NumScanChannels : byte; //Qnty of scanning channels

NumShowChannels : byte; //Qnty of realtime showing channels

FrameSize : Word; //Qnty of ADC repeated reads (time scale speed)

ADCData : TADCData; // contents inself ATT, Channel, MUX

{   bits 765 432 10

000 000 00

||| ||| ||

продолжение приложения 1.

||| ||| ----- ATT

||| --------- MUX

------------- CH

}

procedure ThreadDone(Sender: TObject);

end;

TADCThread = class(TThread)

protected

lptbase, lptcontrol, lptstatus : Word;

procedure ReadADC;

procedure Execute; override;

public

constructor Create;

end;

var

fScanData: TfScanData;

implementation

{$R *.dfm}

procedure Delay(msecs : Longint);

var

FirstTick : longint;

begin

FirstTick:=GetTickCount;

repeat

Application.ProcessMessages;

until GetTickCount-FirstTick >= msecs;

end;

constructor TADCThread.Create;

var

lpMemoryStatus : TMemoryStatus;

begin

lptbase:=fScanData.LPTBase;

lptcontrol:=fScanData.LPTControl;

lptstatus:=fScanData.LPTStatus;

fScanData.msADCData:=TMemoryStream.Create;

lpMemoryStatus.dwLength := SizeOf(lpMemoryStatus);

GlobalMemoryStatus(lpMemoryStatus);

fScanData.msADCData.SetSize(lpMemoryStatus.dwAvailPhys);

FreeOnTerminate := True;

inherited Create(False);

end;

Procedure TADCThread.ReadADC;

var

buffer : array[0..63] of word;

reads,ch:Cardinal;

tmpY, tmpX : integer;

lsb, msb : byte;

begin

for reads:=1 to fScanData.FrameSize do

begin

for ch:=0 to fScanData.NumScanChannels-1 do

begin

portwriteb(lptcontrol,None);

продолжение приложения 1.

portwriteb(lptcontrol,CLK);

portwriteb(lptbase,fScanData.ADCData[ch]);

portwriteb(lptcontrol,None);

portwriteb(lptcontrol,None);

portwriteb(lptcontrol,Conv);

portwriteb(lptcontrol,None);

portwriteb(lptcontrol,None);

portwriteb(lptcontrol,CS_RD+Bi);

lsb:=portreadb(lptbase);

msb:=portreadb(lptstatus);

msb:=msb shr 3;

if (msb and 8)=0 then

begin

msb:=msb and 247;

buffer[ch]:=2048+lsb+msb*256;

end

else

begin

msb:=msb and 247;

buffer[ch]:=lsb+msb*256;

end;

end;

fScanData.msADCData.Write(buffer,fScanData.NumScanChannels*2);

end;

for ch:=0 to fScanData.NumShowChannels-1 do

begin

fScanData.Channel[ch].Canvas.Pen.Color:=$FFFFFF;

tmpY:=fScanData.Channel[ch].Canvas.PenPos.Y;

tmpX:=fScanData.Channel[ch].Canvas.PenPos.X;

fScanData.Channel[ch].Canvas.MoveTo(tmpX+1,0);

fScanData.Channel[ch].Canvas.LineTo(tmpX+1,60);

fScanData.Channel[ch].Canvas.Pen.Color:=0;

fScanData.Channel[ch].Canvas.MoveTo(tmpX,tmpY);

fScanData.Channel[ch].Canvas.LineTo(tmpX+1,59-(buffer[ch] div 70));

if tmpX>=600 then fScanData.Channel[ch].Canvas.MoveTo(0,59-(buffer[ch] div 70));

end;

end;

procedure TADCThread.Execute;

Var

i,t:Cardinal;

lpMemoryStatus : TMemoryStatus;

begin

Priority:=tpHighest;

lpMemoryStatus.dwLength := SizeOf(lpMemoryStatus);

GlobalMemoryStatus(lpMemoryStatus);

t:=GetTickCount;

while (fScanData.ThreadRun) and (lpMemoryStatus.dwAvailPhys>2000000) do

begin

Synchronize(ReadADC);

GlobalMemoryStatus(lpMemoryStatus);

fScanData.pbMemLoad.Position:=100-lpMemoryStatus.dwMemoryLoad;

end;

portwriteb(lptcontrol,None);

fScanData.label1.Caption:=inttostr(GetTickCount-t);

end;

procedure TfScanData.ThreadDone(Sender: TObject);

begin

продолжение приложения 1.

if MessageDlg('Save scanned data to disk?',mtConfirmation,[mbYes,mbNo],0)=mrYes

then

begin

msADCData.SetSize(msADCData.Position);

msADCData.SaveToFile('ScanData\last.dat');

ShowMessage('Ok, done!');

end;

msADCData.Free;

end;

procedure TfScanData.Button1Click(Sender: TObject);

var

lpMemoryStatus : TMemoryStatus;

begin

lpMemoryStatus.dwLength := SizeOf(lpMemoryStatus);

GlobalMemoryStatus(lpMemoryStatus);

with lpMemoryStatus do begin

eRAM.Text := Format('%0.0f Mb', [dwTotalPhys div 1024 / 1024]);

eFreeRAM.Text := Format('%0.0f Mb', [dwAvailPhys div 1024 / 1024]);

pbMemLoad.Position:=100-dwMemoryLoad;

laStatus.Caption:=inttostr(100-dwMemoryLoad)+'% FreeMem = '+Format('%0.0f sec', [dwAvailPhys / 300000]);

end;

end;

procedure TfScanData.Button2Click(Sender: TObject);

begin

//  NumScanChannels:=63;

//  NumShowChannels:=8;

Button4Click(self);

FrameSize:=100;

ThreadRun:=true;

with TADCThread.Create do OnTerminate:=ThreadDone;

end;

procedure TfScanData.Button3Click(Sender: TObject);

begin

ThreadRun:=false;

end;

procedure TfScanData.FormCreate(Sender: TObject);

Var

i : integer;

tmp : byte;

begin

For i:=0 to 7 do

begin

Channel[i]:=TPaintBox.Create(pChannels);

Channel[i].Parent:=pChannels;

Channel[i].BoundsRect:=Rect(10,10+i*60+i*2,610,70+i*60+i*2);

Channel[i].Canvas.Brush.Color:=clWhite;

Channel[i].Canvas.Pen.Color:=$FFFFFF;

Channel[i].Canvas.FillRect(Channel[i].ClientRect);

Channel[i].Update;

end;

LPTBase:=$378;

LPTStatus:=LPTBase+1;

LPTControl:=LPTBase+2;

продолжение приложения 1.

if ZLIOStarted then

begin

zliosetiopm(True);

portwriteb(LPTBase,ATT15);

portwriteb(LPTControl,None);

tmp:=portreadb(LPTBase+$402);

tmp:=tmp OR 32;

tmp:=tmp AND 63;

portwriteb(LPTBase+$402,tmp);

end

else

ShowMessage('Couldn''t start LPTPort driver. Something wrong!');

end;

procedure TfScanData.Button4Click(Sender: TObject);

var

d : file of TADCData;

t : textfile;

st : string;

begin

assignfile(d,'Tmp\scan.dat');

reset(d);

assignfile(t,'Tmp\scan.log');

reset(t);

read(d,ADCData);

readln(t,st);

NumShowChannels:=strtoint(st);

readln(t,st);

NumScanChannels:=strtoint(st);

closefile(d);

closefile(t);

end;

end.