unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ExtCtrls, StdCtrls, jpeg, ImgList, ComCtrls;
type
MyData =
packed array[1..50000]
of packed record
data: byte;
index: word;
// Zwei byte sind genug für 1..50000
end;
TForm1 =
class(TForm)
MainMenu1: TMainMenu;
OpenLogic1: TMenuItem;
About1: TMenuItem;
Image1: TImage;
Image2: TImage;
Image3: TImage;
Image4: TImage;
Image5: TImage;
Image6: TImage;
Image7: TImage;
Image8: TImage;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
Edit7: TEdit;
Edit8: TEdit;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Image9: TImage;
Shape1: TShape;
ScrollBar1: TScrollBar;
ImageList1: TImageList;
Label9: TLabel;
Label10: TLabel;
Image12: TImage;
Image13: TImage;
Image14: TImage;
Image15: TImage;
Image16: TImage;
Image17: TImage;
Image18: TImage;
ProgressBar1: TProgressBar;
ScrollBar2: TScrollBar;
Label11: TLabel;
About2: TMenuItem;
KeineAktualisierungverfgbar1: TMenuItem;
Label1: TLabel;
Label12: TLabel;
update_check: TTimer;
marker1: TPanel;
dispmarker1: TLabel;
Button1: TButton;
marker2: TPanel;
dispmarker2: TLabel;
GroupBox1: TGroupBox;
dispdmarker: TLabel;
dispfreq: TLabel;
ComboBox1: TComboBox;
Button2: TButton;
Label13: TLabel;
ListBox1: TListBox;
Button3: TButton;
Label14: TLabel;
Memo1: TMemo;
Button5: TButton;
ComboBox2: TComboBox;
procedure draw_raw_data(drawspace:TImage;color:TColor; typ: integer);
procedure prepaire_data;
procedure refresh_all;
procedure FormCreate(Sender: TObject);
procedure About2Click(Sender: TObject);
procedure KeineAktualisierungverfgbar1Click(Sender: TObject);
procedure update_checkTimer(Sender: TObject);
procedure refresh_marker(X:integer;marker:TPanel;display:TLabel);
procedure refresh_times;
procedure marker1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button1Click(Sender: TObject);
procedure marker2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormShow(Sender: TObject);
procedure ComboBox1DropDown(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ComboBox1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure ScrollBar2Change(Sender: TObject);
procedure clear_disp(disp:TImage);
procedure clear_all;
procedure ScrollBar1Change(Sender: TObject);
private
{ Private-Deklarationen }
public
version_t:
string;
version,timems,timebasems,timeleft,timeright,marker1ms,marker2ms:integer;
data:
array[0..7]
of MyData;
Cd:
array[0..7]
of integer;
// Aktuelle Anzahl der Elemente in Data
end;
var
Form1: TForm1;
implementation
uses about, update,D2XXUnit, CfgUnit;
var
DevicePresent : Boolean;
Selected_Device_Serial_Number :
String;
Selected_Device_Description :
String;
Store_Buffer :
Array[0..512000]
of byte;
//512kb Speicher.
Store_Buffer_Count:integer;
gesamt_einheit:integer;
ein_pixel,buffer_size,start,stop:integer;
main_color:tcolor;
{$R *.dfm}
procedure TForm1.refresh_times;
begin
timeleft := ((timems
div ScrollBar1.Max) * ScrollBar1.Position) - timebasems;
timeright := ((timems
div ScrollBar1.Max) * ScrollBar1.Position);
Label9.Caption := inttostr(timeleft)+'
ms';
Label10.Caption := inttostr(timeright)+'
ms';
end;
procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
start := ScrollBar1.Position;
Label9.Caption := inttostr(start);
stop := ScrollBar1.Position + (gesamt_einheit
div ScrollBar2.Position);
Label10.Caption := inttostr(stop);
clear_all;
refresh_all;
end;
procedure TForm1.ScrollBar2Change(Sender: TObject);
begin
ScrollBar1.Max := (gesamt_einheit);
Label11.Caption := inttostr(gesamt_einheit
div ScrollBar2.Position);
ein_pixel := (gesamt_einheit
div ScrollBar2.Position)
div Image9.Width;
clear_all;
refresh_all;
end;
procedure TForm1.refresh_marker(X:integer;marker:TPanel;display:TLabel);
var mslen:integer;
begin
if ((marker.Left + X) > (Image9.Left - 1))
and ((marker.Left + X) < ((Image9.Left + Image9.Width) +1))
then begin
mslen := (timebasems * timems
div (Image9.width));
display.Caption := inttostr( ( ((marker.Left - Image9.Left) * mslen)
div 10000) + timeleft + 1)+'
ms';
marker.Left := marker.Left + X;
display.Left := display.Left + X;
if marker.
Name = '
marker1'
then marker1ms := ( ((marker.Left - Image9.Left) * mslen)
div 10000) + timeleft + 1;
if marker.
Name = '
marker2'
then marker2ms := ( ((marker.Left - Image9.Left) * mslen)
div 10000) + timeleft + 1;
dispdmarker.Caption := '
Delta ms: '+inttostr(marker2ms-marker1ms)+'
ms';
dispfreq.Caption := '
Freq. Hz: '+ inttostr(1000
div ((marker2ms-marker1ms)))+'
Hz';
end;
end;
procedure draw_up(pointer:TImage;color:TColor;x:integer);
begin
with pointer.Canvas
do begin
// Was ist hier pen.mode?
Pen.Color := color;
Pen.Width := 1;
MoveTo(x,25);
LineTo(x,5);
end;
end;
procedure draw_down(pointer:TImage;color:TColor;x:integer);
begin
with pointer.Canvas
do begin
Pen.Color := color;
Pen.Mode := pmMerge;
// bei draw_up nicht?
Pen.Width := 1;
MoveTo(x,5);
LineTo(x,25);
end;
end;
procedure draw_line(pointer:TImage;color:TColor;x1,x2,y:integer);
begin
with pointer.Canvas
do begin
Pen.Color := color;
Pen.Width := 1;
MoveTo(x1,y);
LineTo(x2,y);
end;
end;
procedure TForm1.About2Click(Sender: TObject);
begin
Form2.ShowModal;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
dispmarker1.visible :=
not dispmarker1.visible;
dispmarker2.Visible := dispmarker1.visible;
marker1.Visible := dispmarker1.visible;
marker2.Visible := dispmarker1.visible;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
If Open_USB_Device_By_Serial_Number(Selected_Device_Serial_Number) = FT_OK
then begin
FT_Current_Parity := 1;
FT_Current_StopBits := 0;
FT_Current_DataBits := 8;
Set_USB_Device_DataCharacteristics;
FT_Current_Baud := 3000000;
Set_USB_Device_BaudRate;
Label13.Caption := '
Status: Verbunden mit: ' + Selected_Device_Serial_Number;
end
else begin
Label13.Caption := '
Status: Fehler beim verbinden mit: ' + Selected_Device_Serial_Number;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
ProgressBar1.Max := gesamt_einheit;
ProgressBar1.Position := 0;
repeat Read_USB_Device_Buffer(buffer_size);
Move(FT_In_Buffer[0], Store_Buffer[Store_Buffer_Count], Length(FT_In_Buffer));
Inc(Store_Buffer_Count, buffer_size);
ProgressBar1.Position := ProgressBar1.Position + buffer_size;
Label14.Caption := '
Saved: '+inttostr(ProgressBar1.Position);
Application.ProcessMessages;
until ProgressBar1.Position = gesamt_einheit;
end;
procedure TForm1.refresh_all;
begin
draw_raw_data(Image9,main_color,1);
draw_raw_data(Image12,main_color,2);
draw_raw_data(Image13,main_color,3);
draw_raw_data(Image14,main_color,4);
draw_raw_data(Image15,main_color,5);
draw_raw_data(Image16,main_color,6);
draw_raw_data(Image17,main_color,7);
draw_raw_data(Image18,main_color,8);
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
clear_all;
prepaire_data;
refresh_all;
end;
procedure TForm1.ComboBox1Click(Sender: TObject);
begin
Selected_Device_Serial_Number := ListBox1.Items.Strings[ComboBox1.ItemIndex];
//Showmessage(Selected_Device_Serial_Number);
end;
procedure TForm1.ComboBox1DropDown(Sender: TObject);
var S:
String; DeviceIndex : DWord; I : Integer; LV : TListItem;
begin
ComboBox1.Items.clear;
//Auswahl löschen
ListBox1.Clear;
//Geräte ID's löschen
GetFTDeviceCount;
S := IntToStr(FT_Device_Count);
DeviceIndex := 0;
If FT_Device_Count > 0
then
Button2.Enabled := true;
For I := 1
to FT_Device_Count
do
Begin
GetFTDeviceDescription ( DeviceIndex );
ComboBox1.Items.Add(FT_Device_String);
GetFTDeviceSerialNo( DeviceIndex );
ListBox1.Items.Add(FT_Device_String);
DeviceIndex := DeviceIndex + 1;
End;
end;
procedure TForm1.prepaire_data;
var
a,h,alter_wert,counter,i:integer;
vorheriges_x,aktuelle_flanke:integer;
linie_zeichnen:boolean;
temp_data,old_data:
Array[0..7]
of byte;
begin
counter := 1;
vorheriges_x := 0;
aktuelle_flanke := 0;
for a := 0
to 7
do
begin cd[a] := 0;
old_data[a] := 0;
end;
for i := 1
to gesamt_einheit
do
begin
h := store_Buffer[i];
for a := 0
to 7
do
begin
temp_data[a] := h
mod 2;
temp_wert := h
div 2;
if temp_data[a] <> old_data[a]
then begin inc(cd[a]);
data[a][cd[a]].data := temp_data[a];
data[a][cd[a]].
index] := i;
end;
end;
Move(temp_data[0], old_data[0], Length(temp_data));
//Array kopieren
end;
for a := 0
to 7
do
begin
if data[a][cd[a]].
index <> gesamt_einheit
then begin inc (cd[a]);
data[a][cd[a]].
index := gesamt_einheit;
end;
// damit alle 8 Graphiken bei gesamtindex enden
Form1.Memo1.Lines.Add('
Feld: '+inttostr(a));
for i:= 1
to Cd[a]
do
Form1.Memo1.Lines.Add(inttostr(data[a][i].data)+'
: '+(inttostr(data[a][i].
index));
end;
Form1.Memo1.Lines.Add('
|-| ');
end;
procedure TForm1.draw_raw_data(drawspace:TImage;color:TColor; typ: integer);
const y:
array[0..1]
of integer = (5,25);
var
counter:integer;
begin
counter := 1;
for i := 1
to Cd[typ]-1
do
begin
if i<>1
then draw_up(drawspace,color,((data[typ][counter+1] - start)
div ein_pixel));
// ich nehme an, zwischen drawup und drawdown ist in Wirklichkeit kein Unterschied, sonst müsste man da unterscheiden
draw_line(drawspace,color,(data[typ][i].
index - start)
div ein_pixel,(data[typ][i+1].
index - start)
div ein_pixel,y[data[typ][i].data]);
end;
end;
procedure TForm1.clear_disp(disp:TImage);
begin
with disp.canvas
do begin
brush.Color:=$00575048;
brush.Style:=bsSolid;
rectangle(0,-1,disp.Width+2,disp.Height+2);
end;
end;
procedure TForm1.clear_all;
begin
clear_disp(Form1.Image9);
clear_disp(Form1.Image12);
clear_disp(Form1.Image13);
clear_disp(Form1.Image14);
clear_disp(Form1.Image15);
clear_disp(Form1.Image16);
clear_disp(Form1.Image17);
clear_disp(Form1.Image18);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
version_t := '
1.0.0.21';
form1.DoubleBuffered := true;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
FT_Enable_Error_Report := true;
// Error reporting = on
gesamt_einheit := 50000;
//Anzahl Samples
buffer_size := 1000;
//Anzahl Samples pro übertragung
start := 0;
stop := gesamt_einheit;
ein_pixel := gesamt_einheit
div Image9.Width;
main_color := clWhite;
//DevicePresent
end;
procedure TForm1.KeineAktualisierungverfgbar1Click(Sender: TObject);
begin
Form3.Showmodal;
end;
procedure TForm1.marker1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
refresh_marker(X,marker1,dispmarker1);
end;
procedure TForm1.marker2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
refresh_marker(X,marker2,dispmarker2);
end;
procedure TForm1.update_checkTimer(Sender: TObject);
begin
update_check.Enabled := false;
if paramstr(1) = '
update'
then begin
deletefile(extractfilepath(paramstr(0))+'
old.exe');
showmessage('
Herzlichen Glückwunsch... Update erfolgreich! Version: ' + version_t);
end;
end;
end.